Artifact
6a4cc3871f02db9f56c510a251fa24645b3dcc86:
0000: 23 21 2f 75 73 72 2f 6c 6f 63 61 6c 2f 62 69 6e #!/usr/local/bin
0010: 2f 63 73 69 20 2d 71 20 0a 0a 3b 3b 20 43 6f 70 /csi -q ..;; Cop
0020: 79 72 69 67 68 74 20 32 30 30 37 2d 32 30 30 38 yright 2007-2008
0030: 2c 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e , Matthew Wellan
0040: 64 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 d..;; .;; This
0050: 70 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 program is made
0060: 61 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 available under
0070: 74 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 the GNU GPL vers
0080: 69 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 ion 2.0 or.;; g
0090: 72 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 reater. See the
00a0: 61 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c accompanying fil
00b0: 65 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 e COPYING for de
00c0: 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 tails..;; .;; T
00d0: 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 his program is d
00e0: 69 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f istributed WITHO
00f0: 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b UT ANY WARRANTY;
0100: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 without even th
0110: 65 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 e.;; implied wa
0120: 72 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 rranty of MERCHA
0130: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
0140: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
0150: 43 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 CULAR.;; PURPOS
0160: 45 2e 0a 0a 28 75 73 65 20 74 65 73 74 20 6d 64 E...(use test md
0170: 35 29 0a 0a 28 72 65 71 75 69 72 65 2d 65 78 74 5)..(require-ext
0180: 65 6e 73 69 6f 6e 20 73 71 6c 69 74 65 33 29 0a ension sqlite3).
0190: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
01a0: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
01b0: 29 29 0a 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 ))..(require-lib
01c0: 72 61 72 79 20 64 62 69 29 0a 0a 28 6c 6f 61 64 rary dbi)..(load
01d0: 20 22 2e 2f 72 65 71 75 69 72 65 6d 65 6e 74 73 "./requirements
01e0: 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f .scm").(load "./
01f0: 63 6f 6f 6b 69 65 2e 73 6f 22 29 0a 28 6c 6f 61 cookie.so").(loa
0200: 64 20 22 2e 2f 6d 69 73 63 2d 73 74 6d 6c 2e 73 d "./misc-stml.s
0210: 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 66 6f cm").(load "./fo
0220: 72 6d 64 61 74 2e 73 63 6d 22 29 0a 28 6c 6f 61 rmdat.scm").(loa
0230: 64 20 22 2e 2f 73 74 6d 6c 2e 73 63 6d 22 29 0a d "./stml.scm").
0240: 28 6c 6f 61 64 20 22 2e 2f 73 65 73 73 69 6f 6e (load "./session
0250: 2e 73 63 6d 22 29 0a 3b 28 6c 6f 61 64 20 22 2e .scm").;(load ".
0260: 2f 73 71 6c 74 62 6c 2e 73 63 6d 22 29 0a 28 6c /sqltbl.scm").(l
0270: 6f 61 64 20 22 2e 2f 68 74 6d 6c 2d 66 69 6c 74 oad "./html-filt
0280: 65 72 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 er.scm").(load "
0290: 2e 2f 6b 65 79 73 74 6f 72 65 2e 73 63 6d 22 29 ./keystore.scm")
02a0: 0a 0a 3b 3b 20 54 65 73 74 20 74 68 65 20 70 72 ..;; Test the pr
02b0: 69 6d 69 74 69 76 65 20 64 62 69 20 69 6e 74 65 imitive dbi inte
02c0: 72 66 61 63 65 0a 0a 28 73 79 73 74 65 6d 20 22 rface..(system "
02d0: 72 6d 20 2d 66 20 74 65 73 74 73 2f 74 65 73 74 rm -f tests/test
02e0: 2e 64 62 22 29 0a 28 64 65 66 69 6e 65 20 64 62 .db").(define db
02f0: 20 28 64 62 69 3a 6f 70 65 6e 20 27 73 71 6c 69 (dbi:open 'sqli
0300: 74 65 33 20 27 28 28 64 62 6e 61 6d 65 20 2e 20 te3 '((dbname .
0310: 22 74 65 73 74 73 2f 74 65 73 74 2e 64 62 22 29 "tests/test.db")
0320: 29 29 29 0a 28 64 62 69 3a 65 78 65 63 20 64 62 ))).(dbi:exec db
0330: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 66 "CREATE TABLE f
0340: 6f 6f 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 oo(id INTEGER PR
0350: 49 4d 41 52 59 20 4b 45 59 2c 6e 61 6d 65 20 54 IMARY KEY,name T
0360: 45 58 54 29 3b 22 29 0a 28 64 62 69 3a 65 78 65 EXT);").(dbi:exe
0370: 63 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 c db "INSERT INT
0380: 4f 20 66 6f 6f 28 6e 61 6d 65 29 20 56 41 4c 55 O foo(name) VALU
0390: 45 53 28 3f 29 3b 22 20 22 4d 61 74 74 22 29 0a ES(?);" "Matt").
03a0: 28 64 62 69 3a 66 6f 72 2d 65 61 63 68 2d 72 6f (dbi:for-each-ro
03b0: 77 20 0a 20 28 6c 61 6d 62 64 61 20 28 74 75 70 w . (lambda (tup
03c0: 6c 65 29 0a 20 20 20 28 70 72 69 6e 74 20 28 76 le). (print (v
03d0: 65 63 74 6f 72 2d 72 65 66 20 74 75 70 6c 65 20 ector-ref tuple
03e0: 30 29 20 22 20 22 20 28 76 65 63 74 6f 72 2d 72 0) " " (vector-r
03f0: 65 66 20 74 75 70 6c 65 20 31 29 29 29 0a 20 64 ef tuple 1))). d
0400: 62 20 22 53 45 4c 45 43 54 20 2a 20 46 52 4f 4d b "SELECT * FROM
0410: 20 66 6f 6f 3b 22 29 0a 28 74 65 73 74 20 22 64 foo;").(test "d
0420: 62 69 3a 67 65 74 2d 6f 6e 65 22 20 22 4d 61 74 bi:get-one" "Mat
0430: 74 22 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 20 t" (dbi:get-one
0440: 64 62 20 22 53 45 4c 45 43 54 20 6e 61 6d 65 20 db "SELECT name
0450: 46 52 4f 4d 20 66 6f 6f 20 57 48 45 52 45 20 6e FROM foo WHERE n
0460: 61 6d 65 3d 27 4d 61 74 74 27 3b 22 29 29 0a 0a ame='Matt';"))..
0470: 3b 3b 20 6b 65 79 73 74 6f 72 65 0a 28 64 62 69 ;; keystore.(dbi
0480: 3a 65 78 65 63 20 64 62 20 22 43 52 45 41 54 45 :exec db "CREATE
0490: 20 54 41 42 4c 45 20 6d 65 74 61 64 61 74 61 20 TABLE metadata
04a0: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
04b0: 41 52 59 20 4b 45 59 2c 6b 65 79 20 54 45 58 54 ARY KEY,key TEXT
04c0: 2c 76 61 6c 75 65 20 54 45 58 54 29 3b 22 29 0a ,value TEXT);").
04d0: 0a 28 6b 65 79 73 74 6f 72 65 3a 73 65 74 21 20 .(keystore:set!
04e0: 64 62 20 22 53 43 48 45 4d 41 2d 56 45 52 53 49 db "SCHEMA-VERSI
04f0: 4f 4e 22 20 31 2e 32 29 0a 28 74 65 73 74 20 22 ON" 1.2).(test "
0500: 4b 65 79 73 74 6f 72 65 20 67 65 74 22 20 22 31 Keystore get" "1
0510: 2e 32 22 20 20 28 6b 65 79 73 74 6f 72 65 3a 67 .2" (keystore:g
0520: 65 74 20 20 64 62 20 22 53 43 48 45 4d 41 2d 56 et db "SCHEMA-V
0530: 45 52 53 49 4f 4e 22 29 29 0a 28 6b 65 79 73 74 ERSION")).(keyst
0540: 6f 72 65 3a 64 65 6c 21 20 64 62 20 22 53 43 48 ore:del! db "SCH
0550: 45 4d 41 2d 56 45 52 53 49 4f 4e 22 29 20 0a 28 EMA-VERSION") .(
0560: 74 65 73 74 20 22 4b 65 79 73 74 6f 72 65 20 67 test "Keystore g
0570: 65 74 20 64 65 6c 65 74 65 64 22 20 23 66 20 28 et deleted" #f (
0580: 6b 65 79 73 74 6f 72 65 3a 67 65 74 20 64 62 20 keystore:get db
0590: 22 53 43 48 45 4d 41 2d 56 45 52 53 49 4f 4e 22 "SCHEMA-VERSION"
05a0: 29 29 0a 0a 28 73 79 73 74 65 6d 20 22 72 6d 20 ))..(system "rm
05b0: 2d 66 20 74 65 73 74 73 2f 74 65 73 74 2e 64 62 -f tests/test.db
05c0: 22 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 ")..;; create a
05d0: 73 65 73 73 69 6f 6e 20 74 6f 20 77 6f 72 6b 20 session to work
05e0: 77 69 74 68 22 29 0a 28 73 65 74 65 6e 76 20 22 with").(setenv "
05f0: 52 45 51 55 45 53 54 5f 55 52 49 22 20 22 2f 73 REQUEST_URI" "/s
0600: 74 6d 6c 72 75 6e 3f 61 63 74 69 6f 6e 3d 74 65 tmlrun?action=te
0610: 73 74 2e 74 65 73 74 22 29 0a 28 73 65 74 65 6e st.test").(seten
0620: 76 20 22 53 43 52 49 50 54 5f 4e 41 4d 45 22 20 v "SCRIPT_NAME"
0630: 22 2f 63 67 69 2d 62 69 6e 2f 73 74 6d 6c 72 75 "/cgi-bin/stmlru
0640: 6e 22 29 0a 28 73 65 74 65 6e 76 20 22 50 41 54 n").(setenv "PAT
0650: 48 5f 49 4e 46 4f 22 20 22 2f 74 65 73 74 22 29 H_INFO" "/test")
0660: 0a 28 73 65 74 65 6e 76 20 22 51 55 45 52 59 5f .(setenv "QUERY_
0670: 53 54 52 49 4e 47 22 20 22 61 63 74 69 6f 6e 3d STRING" "action=
0680: 74 65 73 74 2e 74 65 73 74 22 29 0a 28 73 65 74 test.test").(set
0690: 65 6e 76 20 22 53 45 52 56 45 52 5f 4e 41 4d 45 env "SERVER_NAME
06a0: 22 20 22 6c 6f 63 61 6c 68 6f 73 74 22 29 0a 28 " "localhost").(
06b0: 73 65 74 65 6e 76 20 22 52 45 51 55 45 53 54 5f setenv "REQUEST_
06c0: 4d 45 54 48 4f 44 22 20 22 47 45 54 22 29 0a 0a METHOD" "GET")..
06d0: 28 6c 6f 61 64 20 22 2e 2f 73 65 74 75 70 2e 73 (load "./setup.s
06e0: 63 6d 22 29 0a 0a 28 73 3a 76 61 6c 69 64 61 74 cm")..(s:validat
06f0: 65 2d 69 6e 70 75 74 73 29 0a 0a 3b 3b 20 74 65 e-inputs)..;; te
0700: 73 74 20 73 65 73 73 69 6f 6e 20 76 61 72 69 61 st session varia
0710: 62 6c 65 73 0a 0a 28 73 65 73 73 69 6f 6e 3a 67 bles..(session:g
0720: 65 74 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f et-vars s:sessio
0730: 6e 29 0a 28 64 65 66 69 6e 65 20 6e 61 64 61 20 n).(define nada
0740: 22 61 6e 64 6e 6e 64 68 68 73 68 61 61 73 22 29 "andnndhhshaas")
0750: 0a 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d .(s:session-var-
0760: 73 65 74 21 20 22 6e 69 63 6b 22 20 6e 61 64 61 set! "nick" nada
0770: 29 0a 28 74 65 73 74 20 22 53 65 73 73 69 6f 6e ).(test "Session
0780: 20 76 61 72 20 73 65 74 2f 67 65 74 22 20 6e 61 var set/get" na
0790: 64 61 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d 76 da (s:session-v
07a0: 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 0a ar-get "nick")).
07b0: 28 70 72 69 6e 74 20 22 67 6f 74 20 68 65 72 65 (print "got here
07c0: 22 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 ").(session:save
07d0: 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 -vars s:session)
07e0: 0a 28 73 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 .(session:get-va
07f0: 72 73 20 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 rs s:session).(
0800: 74 65 73 74 20 22 53 65 73 73 69 6f 6e 20 76 61 test "Session va
0810: 72 20 73 65 74 2f 67 65 74 20 61 66 74 65 72 20 r set/get after
0820: 73 61 76 65 2f 67 65 74 22 20 6e 61 64 61 20 28 save/get" nada (
0830: 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 s:session-var-ge
0840: 74 20 22 6e 69 63 6b 22 29 29 0a 28 73 65 73 73 t "nick")).(sess
0850: 69 6f 6e 3a 64 65 6c 21 20 73 3a 73 65 73 73 69 ion:del! s:sessi
0860: 6f 6e 20 22 2a 73 65 73 73 69 6f 6e 76 61 72 73 on "*sessionvars
0870: 2a 22 20 22 6e 69 63 6b 22 29 0a 28 74 65 73 74 *" "nick").(test
0880: 20 22 53 65 73 73 69 6f 6e 20 76 61 72 20 64 65 "Session var de
0890: 6c 22 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l"
08a0: 20 20 20 20 20 20 23 66 20 20 20 28 73 3a 73 65 #f (s:se
08b0: 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 22 6e ssion-var-get "n
08c0: 69 63 6b 22 29 29 0a 28 73 65 73 73 69 6f 6e 3a ick")).(session:
08d0: 73 61 76 65 2d 76 61 72 73 20 73 3a 73 65 73 73 save-vars s:sess
08e0: 69 6f 6e 29 0a 28 73 65 73 73 69 6f 6e 3a 67 65 ion).(session:ge
08f0: 74 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e t-vars s:session
0900: 29 0a 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 ).(s:session-var
0910: 2d 73 65 74 21 20 22 6e 69 63 6b 22 20 6e 61 64 -set! "nick" nad
0920: 61 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 a).(session:save
0930: 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 -vars s:session)
0940: 0a 0a 3b 3b 20 28 74 65 73 74 20 22 53 65 73 73 ..;; (test "Sess
0950: 69 6f 6e 20 76 61 72 20 64 65 6c 22 20 20 20 20 ion var del"
0960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0970: 23 66 20 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d #f (s:session-
0980: 76 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 var-get "nick"))
0990: 0a 0a 3b 3b 20 74 65 73 74 20 70 65 72 73 6f 6e ..;; test person
09a0: 0a 0a 28 6c 6f 61 64 20 22 2e 2f 74 65 73 74 73 ..(load "./tests
09b0: 2f 6d 6f 64 65 6c 73 2f 74 65 73 74 2e 73 63 6d /models/test.scm
09c0: 22 29 0a 0a 28 70 72 69 6e 74 20 22 53 65 73 73 ")..(print "Sess
09d0: 69 6f 6e 20 6b 65 79 20 69 73 20 22 20 28 73 64 ion key is " (sd
09e0: 61 74 2d 67 65 74 2d 73 65 73 73 69 6f 6e 2d 6b at-get-session-k
09f0: 65 79 20 73 3a 73 65 73 73 69 6f 6e 29 29 0a 0a ey s:session))..
0a00: 28 74 65 73 74 20 22 44 65 6c 65 74 65 20 73 65 (test "Delete se
0a10: 73 73 69 6f 6e 22 20 23 74 20 28 73 3a 64 65 6c ssion" #t (s:del
0a20: 65 74 65 2d 73 65 73 73 69 6f 6e 29 29 0a 0a 28 ete-session))..(
0a30: 6c 65 74 20 28 28 66 68 20 28 6f 70 65 6e 2d 69 let ((fh (open-i
0a40: 6e 70 75 74 2d 70 69 70 65 20 22 6c 73 20 2e 2f nput-pipe "ls ./
0a50: 74 65 73 74 73 2f 70 61 67 65 73 2f 2a 2f 63 6f tests/pages/*/co
0a60: 6e 74 72 6f 6c 2e 73 63 6d 22 29 29 29 0a 20 20 ntrol.scm"))).
0a70: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 20 28 72 (let loop ((l (r
0a80: 65 61 64 2d 6c 69 6e 65 20 66 68 29 29 29 0a 20 ead-line fh))).
0a90: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 (if (not (eof
0aa0: 2d 6f 62 6a 65 63 74 3f 20 6c 29 29 0a 20 20 20 -object? l)).
0ab0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
0ac0: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 ;; (print
0ad0: 22 6c 6f 61 64 69 6e 67 20 22 20 6c 29 0a 20 20 "loading " l).
0ae0: 20 20 20 20 20 20 20 20 28 6c 6f 61 64 20 6c 29 (load l)
0af0: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 . (loop
0b00: 20 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 29 (read-line fh))
0b10: 29 29 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e 70 ))). (close-inp
0b20: 75 74 2d 70 6f 72 74 20 66 68 29 29 0a 0a 3b 3b ut-port fh))..;;
0b30: 20 53 68 6f 75 6c 64 20 68 61 76 65 20 70 6f 6c Should have pol
0b40: 6c 3a 70 6f 6c 6c 20 64 65 66 69 6e 65 64 20 6e l:poll defined n
0b50: 6f 77 2e 0a 28 74 65 73 74 20 22 4d 61 6b 65 20 ow..(test "Make
0b60: 61 20 72 61 6e 64 6f 6d 20 73 74 72 69 6e 67 22 a random string"
0b70: 20 32 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 2 (string-lengt
0b80: 68 20 28 73 65 73 73 69 6f 6e 3a 6d 61 6b 65 2d h (session:make-
0b90: 72 61 6e 64 2d 73 74 72 69 6e 67 20 32 29 29 29 rand-string 2)))
0ba0: 0a 28 74 65 73 74 20 22 43 72 65 61 74 65 20 61 .(test "Create a
0bb0: 20 65 6e 63 72 79 70 74 65 64 20 70 61 73 73 77 encrypted passw
0bc0: 6f 72 64 22 20 22 61 62 51 39 4b 59 2e 4b 66 72 ord" "abQ9KY.Kfr
0bd0: 59 72 63 22 20 28 73 3a 63 72 79 70 74 2d 70 61 Yrc" (s:crypt-pa
0be0: 73 73 77 64 20 22 66 6f 6f 22 20 22 61 62 22 29 sswd "foo" "ab")
0bf0: 29 0a 0a 28 74 65 73 74 20 22 73 3a 61 6e 79 2d )..(test "s:any-
0c00: 3e 73 74 72 69 6e 67 20 6f 6e 20 61 20 68 61 73 >string on a has
0c10: 68 2d 74 61 62 6c 65 22 20 22 23 3c 68 61 73 68 h-table" "#<hash
0c20: 2d 74 61 62 6c 65 3e 22 20 28 73 3a 61 6e 79 2d -table>" (s:any-
0c30: 3e 73 74 72 69 6e 67 20 28 6d 61 6b 65 2d 68 61 >string (make-ha
0c40: 73 68 2d 74 61 62 6c 65 29 29 29 0a 0a 28 64 65 sh-table)))..(de
0c50: 66 69 6e 65 20 73 65 6c 65 63 74 2d 6c 69 73 74 fine select-list
0c60: 0a 20 20 27 28 28 61 20 62 20 63 29 28 64 20 28 . '((a b c)(d (
0c70: 65 20 66 20 67 29 28 68 20 69 20 6a 20 23 74 29 e f g)(h i j #t)
0c80: 29 29 29 0a 28 64 65 66 69 6e 65 20 72 65 73 75 ))).(define resu
0c90: 6c 74 20 27 28 22 3c 53 45 4c 45 43 54 20 6e 61 lt '("<SELECT na
0ca0: 6d 65 3d 5c 22 65 66 67 5c 22 3e 22 20 0a 09 09 me=\"efg\">" ...
0cb0: 20 28 28 28 22 3c 4f 50 54 49 4f 4e 20 6c 61 62 ((("<OPTION lab
0cc0: 65 6c 3d 5c 22 61 5c 22 20 76 61 6c 75 65 3d 5c el=\"a\" value=\
0cd0: 22 62 5c 22 3e 63 3c 2f 4f 50 54 49 4f 4e 3e 22 "b\">c</OPTION>"
0ce0: 29 20 0a 09 09 20 20 20 28 22 3c 4f 50 54 47 52 ) ... ("<OPTGR
0cf0: 4f 55 50 20 6c 61 62 65 6c 3d 64 22 20 0a 09 09 OUP label=d" ...
0d00: 20 20 20 20 28 22 3c 4f 50 54 49 4f 4e 20 6c 61 ("<OPTION la
0d10: 62 65 6c 3d 5c 22 65 5c 22 20 76 61 6c 75 65 3d bel=\"e\" value=
0d20: 5c 22 66 5c 22 3e 67 3c 2f 4f 50 54 49 4f 4e 3e \"f\">g</OPTION>
0d30: 22 29 0a 09 09 20 20 20 20 28 22 3c 4f 50 54 49 ")... ("<OPTI
0d40: 4f 4e 20 20 73 65 6c 65 63 74 65 64 20 6c 61 62 ON selected lab
0d50: 65 6c 3d 5c 22 68 5c 22 20 76 61 6c 75 65 3d 5c el=\"h\" value=\
0d60: 22 69 5c 22 3e 6a 3c 2f 4f 50 54 49 4f 4e 3e 22 "i\">j</OPTION>"
0d70: 29 20 0a 09 09 20 20 20 20 22 3c 2f 4f 50 54 47 ) ... "</OPTG
0d80: 52 4f 55 50 3e 22 29 29 29 0a 09 09 20 22 3c 2f ROUP>")))... "</
0d90: 53 45 4c 45 43 54 3e 22 29 29 0a 0a 28 74 65 73 SELECT>"))..(tes
0da0: 74 20 22 53 65 6c 65 63 74 20 6c 69 73 74 22 20 t "Select list"
0db0: 72 65 73 75 6c 74 20 28 73 3a 73 65 6c 65 63 74 result (s:select
0dc0: 20 73 65 6c 65 63 74 2d 6c 69 73 74 20 27 6e 61 select-list 'na
0dd0: 6d 65 20 22 65 66 67 22 29 29 0a 0a 3b 3b 20 54 me "efg"))..;; T
0de0: 65 73 74 20 6d 6f 64 75 6c 65 73 0a 0a 28 74 65 est modules..(te
0df0: 73 74 20 22 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 st "misc:non-zer
0e00: 6f 2d 73 74 72 69 6e 67 20 5c 22 5c 22 22 20 23 o-string \"\"" #
0e10: 66 20 28 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f f (misc:non-zero
0e20: 2d 73 74 72 69 6e 67 20 22 22 29 29 0a 28 74 65 -string "")).(te
0e30: 73 74 20 22 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 st "misc:non-zer
0e40: 6f 2d 73 74 72 69 6e 67 20 23 66 22 20 23 66 20 o-string #f" #f
0e50: 28 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 (misc:non-zero-s
0e60: 74 72 69 6e 67 20 23 66 29 29 0a 28 74 65 73 74 tring #f)).(test
0e70: 20 22 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d "misc:non-zero-
0e80: 73 74 72 69 6e 67 20 27 62 6c 61 68 22 20 23 66 string 'blah" #f
0e90: 20 28 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d (misc:non-zero-
0ea0: 73 74 72 69 6e 67 20 27 62 6c 61 68 29 29 0a 0a string 'blah))..
0eb0: 3b 3b 20 66 6f 72 6d 73 0a 28 64 65 66 69 6e 65 ;; forms.(define
0ec0: 20 66 6f 72 6d 20 23 66 29 0a 28 74 65 73 74 20 form #f).(test
0ed0: 22 6d 61 6b 65 20 3c 66 6f 72 6d 64 61 74 3e 22 "make <formdat>"
0ee0: 20 23 74 20 28 6c 65 74 20 28 28 66 20 28 6d 61 #t (let ((f (ma
0ef0: 6b 65 2d 66 6f 72 6d 64 61 74 3a 66 6f 72 6d 64 ke-formdat:formd
0f00: 61 74 29 29 29 0a 09 09 09 20 20 20 20 28 73 65 at))).... (se
0f10: 74 21 20 66 6f 72 6d 20 66 29 0a 09 09 09 20 20 t! form f)....
0f20: 20 20 23 74 29 29 0a 28 74 65 73 74 20 22 66 6f #t)).(test "fo
0f30: 72 6d 64 61 74 3a 20 73 65 74 21 2f 67 65 74 22 rmdat: set!/get"
0f40: 20 22 59 65 70 21 22 20 28 62 65 67 69 6e 0a 09 "Yep!" (begin..
0f50: 09 09 09 20 20 20 28 66 6f 72 6d 64 61 74 3a 73 ... (formdat:s
0f60: 65 74 21 20 66 6f 72 6d 20 22 62 6c 61 68 22 20 et! form "blah"
0f70: 22 59 65 70 21 22 29 0a 09 09 09 09 20 20 20 28 "Yep!")..... (
0f80: 66 6f 72 6d 64 61 74 3a 67 65 74 20 20 66 6f 72 formdat:get for
0f90: 6d 20 22 62 6c 61 68 22 29 29 29 0a 0a 28 74 65 m "blah")))..(te
0fa0: 73 74 20 22 73 3a 73 74 72 69 6e 67 2d 3e 70 67 st "s:string->pg
0fb0: 69 6e 74 22 20 20 20 31 32 33 20 28 73 3a 61 6e int" 123 (s:an
0fc0: 79 2d 3e 70 67 69 6e 74 20 22 31 32 33 22 29 29 y->pgint "123"))
0fd0: 0a 28 74 65 73 74 20 22 73 3a 69 6c 6c 65 67 61 .(test "s:illega
0fe0: 6c 2d 70 67 69 6e 74 20 28 6c 65 67 61 6c 29 22 l-pgint (legal)"
0ff0: 20 20 20 20 20 20 20 20 23 66 20 28 73 3a 69 6c #f (s:il
1000: 6c 65 67 61 6c 2d 70 67 69 6e 74 20 31 30 31 31 legal-pgint 1011
1010: 29 29 0a 28 74 65 73 74 20 22 73 3a 69 6c 6c 65 )).(test "s:ille
1020: 67 61 6c 2d 70 67 69 6e 74 20 28 69 6c 6c 65 67 gal-pgint (illeg
1030: 61 6c 20 62 69 67 29 22 20 20 20 31 20 28 73 3a al big)" 1 (s:
1040: 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 20 39 illegal-pgint 9
1050: 39 39 39 39 39 39 39 39 39 29 29 0a 28 74 65 73 999999999)).(tes
1060: 74 20 22 73 3a 69 6c 6c 65 67 61 6c 70 67 69 6e t "s:illegalpgin
1070: 74 20 28 69 6c 6c 65 67 61 6c 20 73 6d 61 6c 6c t (illegal small
1080: 29 22 20 2d 31 20 28 73 3a 69 6c 6c 65 67 61 6c )" -1 (s:illegal
1090: 2d 70 67 69 6e 74 20 2d 39 39 39 39 39 39 39 39 -pgint -99999999
10a0: 39 39 29 29 0a 0a 3b 3b 20 54 68 65 20 74 77 69 99))..;; The twi
10b0: 6b 69 20 6d 6f 64 75 6c 65 0a 0a 3b 3b 20 63 6c ki module..;; cl
10c0: 65 61 6e 20 75 70 0a 28 73 79 73 74 65 6d 20 22 ean up.(system "
10d0: 72 6d 20 2d 72 66 20 74 77 69 6b 69 73 2f 2a 22 rm -rf twikis/*"
10e0: 29 0a 28 6c 6f 61 64 20 22 6d 6f 64 75 6c 65 73 ).(load "modules
10f0: 2f 74 77 69 6b 69 2f 74 77 69 6b 69 2d 6d 6f 64 /twiki/twiki-mod
1100: 2e 73 63 6d 22 29 0a 28 64 65 66 69 6e 65 20 6b .scm").(define k
1110: 65 79 73 20 28 6c 69 73 74 20 22 62 6c 61 68 22 eys (list "blah"
1120: 20 31 20 27 6e 61 64 61 29 29 0a 28 74 65 73 74 1 'nada)).(test
1130: 20 22 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b 65 "twiki:keys->ke
1140: 79 22 20 20 22 62 6c 61 68 20 31 20 6e 61 64 61 y" "blah 1 nada
1150: 22 20 28 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b " (twiki:keys->k
1160: 65 79 20 6b 65 79 73 29 29 0a 28 64 65 66 69 6e ey keys)).(defin
1170: 65 20 6b 65 79 20 28 74 77 69 6b 69 3a 6b 65 79 e key (twiki:key
1180: 73 2d 3e 6b 65 79 20 6b 65 79 73 29 29 0a 0a 28 s->key keys))..(
1190: 64 65 66 69 6e 65 20 2a 74 64 62 2a 20 23 66 29 define *tdb* #f)
11a0: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 6f 70 .(test "twiki:op
11b0: 65 6e 2d 64 62 22 20 20 20 23 74 20 28 6c 65 74 en-db" #t (let
11c0: 20 28 28 64 62 20 28 74 77 69 6b 69 3a 6f 70 65 ((db (twiki:ope
11d0: 6e 2d 64 62 20 6b 65 79 29 29 29 0a 09 09 09 20 n-db key)))....
11e0: 20 20 20 20 28 73 65 74 21 20 2a 74 64 62 2a 20 (set! *tdb*
11f0: 64 62 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 db).... (if
1200: 2a 74 64 62 2a 20 23 74 20 23 66 29 29 29 0a 28 *tdb* #t #f))).(
1210: 64 65 66 69 6e 65 20 77 69 6b 69 20 28 6d 61 6b define wiki (mak
1220: 65 2d 74 77 69 6b 69 3a 77 69 6b 69 29 29 0a 28 e-twiki:wiki)).(
1230: 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 77 twiki:wiki-set-w
1240: 69 64 21 20 77 69 6b 69 20 31 29 0a 28 74 77 69 id! wiki 1).(twi
1250: 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 6e 61 6d 65 ki:wiki-set-name
1260: 21 20 77 69 6b 69 20 22 6d 61 69 6e 22 29 0a 28 ! wiki "main").(
1270: 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 70 twiki:wiki-set-p
1280: 65 72 6d 73 21 20 77 69 6b 69 20 27 28 72 20 77 erms! wiki '(r w
1290: 29 29 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 ))..(test "twiki
12a0: 3a 64 61 74 2d 3e 68 74 6d 6c 22 20 27 28 22 48 :dat->html" '("H
12b0: 65 6c 6c 6f 22 20 22 3c 42 52 3e 22 29 20 28 74 ello" "<BR>") (t
12c0: 77 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 20 22 wiki:dat->html "
12d0: 48 65 6c 6c 6f 22 20 77 69 6b 69 29 29 0a 28 74 Hello" wiki)).(t
12e0: 65 73 74 20 22 74 77 69 6b 69 3a 6b 65 79 73 2d est "twiki:keys-
12f0: 3e 66 6e 61 6d 65 22 20 27 28 22 74 77 69 6b 69 >fname" '("twiki
1300: 73 2f 59 6d 78 68 61 2f 43 41 78 49 47 2f 35 68 s/Ymxha/CAxIG/5h
1310: 5a 47 45 22 20 22 59 6d 78 68 61 43 41 78 49 47 ZGE" "YmxhaCAxIG
1320: 35 68 5a 47 45 5f 22 29 20 3b 3b 20 28 22 74 77 5hZGE_") ;; ("tw
1330: 69 6b 69 73 2f 64 39 39 61 32 64 65 39 2f 36 38 ikis/d99a2de9/68
1340: 30 38 34 39 33 62 2f 32 33 37 37 30 66 37 30 22 08493b/23770f70"
1350: 20 22 64 39 39 61 32 64 65 39 36 38 30 38 34 39 "d99a2de9680849
1360: 33 62 32 33 37 37 30 66 37 30 63 37 36 64 66 66 3b23770f70c76dff
1370: 65 34 22 29 0a 20 20 20 20 20 20 28 74 77 69 6b e4"). (twik
1380: 69 3a 6b 65 79 2d 3e 66 6e 61 6d 65 20 6b 65 79 i:key->fname key
1390: 29 29 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 ))..(test "twiki
13a0: 3a 6e 61 6d 65 2d 3e 77 69 64 22 20 20 20 20 20 :name->wid"
13b0: 31 20 20 20 20 20 28 74 77 69 6b 69 3a 6e 61 6d 1 (twiki:nam
13c0: 65 2d 3e 77 69 64 20 2a 74 64 62 2a 20 22 6d 61 e->wid *tdb* "ma
13d0: 69 6e 22 29 29 0a 28 74 65 73 74 20 22 74 77 69 in")).(test "twi
13e0: 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d ki:get-tiddlers-
13f0: 62 79 2d 6e 75 6d 22 20 27 28 29 20 28 74 77 69 by-num" '() (twi
1400: 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d ki:get-tiddlers-
1410: 62 79 2d 6e 75 6d 20 20 2a 74 64 62 2a 20 30 20 by-num *tdb* 0
1420: 28 6c 69 73 74 20 31 20 32 20 33 29 29 29 0a 28 (list 1 2 3))).(
1430: 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d test "twiki:get-
1440: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 tiddlers-by-name
1450: 22 20 27 28 29 20 28 74 77 69 6b 69 3a 67 65 74 " '() (twiki:get
1460: 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d -tiddlers-by-nam
1470: 65 20 2a 74 64 62 2a 20 30 20 22 4d 61 69 6e 4d e *tdb* 0 "MainM
1480: 65 6e 75 22 29 29 0a 28 74 65 73 74 20 22 74 77 enu")).(test "tw
1490: 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 iki:get-tiddlers
14a0: 22 20 20 27 28 29 20 20 28 74 77 69 6b 69 3a 67 " '() (twiki:g
14b0: 65 74 2d 74 69 64 64 6c 65 72 73 20 2a 74 64 62 et-tiddlers *tdb
14c0: 2a 20 30 20 28 6c 69 73 74 20 22 4d 61 69 6e 4d * 0 (list "MainM
14d0: 65 6e 75 22 29 29 29 0a 28 74 65 73 74 20 22 74 enu"))).(test "t
14e0: 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 wiki:get-tiddler
14f0: 73 22 20 20 27 28 29 20 20 28 74 77 69 6b 69 3a s" '() (twiki:
1500: 67 65 74 2d 74 69 64 64 6c 65 72 73 20 2a 74 64 get-tiddlers *td
1510: 62 2a 20 30 20 28 6c 69 73 74 20 22 4d 61 69 6e b* 0 (list "Main
1520: 4d 65 6e 75 22 20 22 41 6e 6f 74 68 65 72 4f 6e Menu" "AnotherOn
1530: 65 22 29 29 29 0a 28 74 65 73 74 20 22 74 77 69 e"))).(test "twi
1540: 6b 69 3a 77 69 6b 69 22 20 22 3c 54 41 42 4c 45 ki:wiki" "<TABLE
1550: 3e 22 20 20 20 20 20 28 63 61 72 20 28 74 77 69 >" (car (twi
1560: 6b 69 3a 77 69 6b 69 20 22 6d 61 69 6e 22 20 28 ki:wiki "main" (
1570: 6c 69 73 74 20 22 62 6c 61 68 22 20 31 20 27 6e list "blah" 1 'n
1580: 61 64 61 29 29 29 29 0a 28 74 65 73 74 20 22 74 ada)))).(test "t
1590: 77 69 6b 69 3a 76 69 65 77 22 20 20 22 3c 44 49 wiki:view" "<DI
15a0: 56 20 63 6c 61 73 73 3d 5c 22 6e 6f 64 65 5c 22 V class=\"node\"
15b0: 3e 22 20 28 63 61 72 20 28 74 77 69 6b 69 3a 76 >" (car (twiki:v
15c0: 69 65 77 20 22 22 20 22 22 20 30 20 28 74 77 69 iew "" "" 0 (twi
15d0: 6b 69 3a 74 69 64 64 6c 65 72 2d 6d 61 6b 65 29 ki:tiddler-make)
15e0: 20 77 69 6b 69 29 29 29 0a 0a 28 74 65 73 74 20 wiki)))..(test
15f0: 22 73 3a 74 64 22 20 20 20 20 20 20 20 20 20 20 "s:td"
1600: 20 20 20 20 27 28 22 3c 54 44 3e 22 20 28 28 29 '("<TD>" (()
1610: 29 20 22 3c 2f 54 44 3e 22 29 20 28 73 3a 74 64 ) "</TD>") (s:td
1620: 20 27 28 29 29 29 0a 3b 3b 20 28 74 65 73 74 20 '())).;; (test
1630: 22 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c "twiki:get-tiddl
1640: 65 72 73 2d 62 79 2d 6e 61 6d 65 22 20 27 28 29 ers-by-name" '()
1650: 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 (twiki:get-tidd
1660: 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 20 31 20 22 lers-by-name 1 "
1670: 66 72 65 64 22 29 29 0a 28 74 65 73 74 20 22 74 fred")).(test "t
1680: 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 6e 61 6d wiki:tiddler-nam
1690: 65 2d 3e 69 64 22 20 31 20 28 74 77 69 6b 69 3a e->id" 1 (twiki:
16a0: 74 69 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e 69 64 tiddler-name->id
16b0: 20 2a 74 64 62 2a 20 22 4d 61 69 6e 4d 65 6e 75 *tdb* "MainMenu
16c0: 22 29 29 0a 28 74 65 73 74 20 22 73 3a 73 65 74 ")).(test "s:set
16d0: 21 20 61 20 76 61 72 20 74 6f 20 23 66 22 20 20 ! a var to #f"
16e0: 20 20 20 22 22 0a 20 20 20 20 20 20 28 62 65 67 "". (beg
16f0: 69 6e 20 28 73 3a 73 65 74 21 20 22 42 4c 41 48 in (s:set! "BLAH
1700: 22 20 23 66 29 0a 09 20 20 20 20 20 28 73 3a 67 " #f).. (s:g
1710: 65 74 20 22 42 4c 41 48 22 29 29 29 20 3b 3b 20 et "BLAH"))) ;;
1720: 64 6f 6e 27 74 20 6b 6e 6f 77 20 69 66 20 74 68 don't know if th
1730: 69 73 20 6f 6e 65 20 6d 61 6b 65 73 20 73 65 6e is one makes sen
1740: 73 65 2e 20 53 65 74 74 69 6e 67 20 74 6f 20 23 se. Setting to #
1750: 66 20 73 68 6f 75 6c 64 20 72 65 61 6c 6c 79 20 f should really
1760: 64 65 6c 65 74 65 20 74 68 65 20 76 61 6c 75 65 delete the value
1770: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 .(test "twiki:sa
1780: 76 65 2d 64 61 74 22 20 20 20 20 20 20 20 20 20 ve-dat"
1790: 20 20 32 20 20 20 20 20 20 20 20 28 74 77 69 6b 2 (twik
17a0: 69 3a 73 61 76 65 2d 64 61 74 20 2a 74 64 62 2a i:save-dat *tdb*
17b0: 20 22 64 61 74 22 20 30 29 29 0a 28 74 65 73 74 "dat" 0)).(test
17c0: 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 22 "twiki:get-dat"
17d0: 20 20 20 20 20 20 20 20 20 20 20 20 22 64 61 74 "dat
17e0: 22 20 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d " (twiki:get-
17f0: 64 61 74 20 2a 74 64 62 2a 20 32 29 29 0a 28 74 dat *tdb* 2)).(t
1800: 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 est "twiki:get-d
1810: 61 74 22 20 20 20 20 20 20 20 20 20 20 20 20 23 at" #
1820: 66 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a 67 f (twiki:g
1830: 65 74 2d 64 61 74 20 2a 74 64 62 2a 20 35 29 29 et-dat *tdb* 5))
1840: 0a 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 .;; (test "twiki
1850: 3a 67 65 74 2d 64 61 74 22 20 20 20 20 20 20 23 :get-dat" #
1860: 66 20 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d f (twiki:get-
1870: 64 61 74 20 2a 74 64 62 2a 20 23 66 29 29 0a 28 dat *tdb* #f)).(
1880: 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 test "twiki:save
1890: 2d 74 69 64 64 6c 65 72 22 20 20 20 20 20 20 20 -tiddler"
18a0: 23 74 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a #t (twiki:
18b0: 73 61 76 65 2d 74 69 64 64 6c 65 72 20 2a 74 64 save-tiddler *td
18c0: 62 2a 20 22 68 65 61 64 69 6e 67 22 20 22 62 6f b* "heading" "bo
18d0: 64 79 22 20 22 74 61 67 73 22 20 6b 65 79 20 30 dy" "tags" key 0
18e0: 29 29 0a 3b 3b 20 28 74 65 73 74 20 22 74 77 69 )).;; (test "twi
18f0: 6b 69 3a 73 61 76 65 2d 63 75 72 72 2d 74 69 64 ki:save-curr-tid
1900: 64 6c 65 72 22 20 20 23 66 20 20 20 20 20 20 20 dler" #f
1910: 28 74 77 69 6b 69 3a 73 61 76 65 2d 63 75 72 72 (twiki:save-curr
1920: 2d 74 69 64 64 6c 65 72 20 2a 74 64 62 2a 20 31 -tiddler *tdb* 1
1930: 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )).(test "twiki:
1940: 65 64 69 74 2d 74 77 69 64 64 6c 65 72 22 20 20 edit-twiddler"
1950: 20 20 20 20 23 74 20 20 20 20 20 20 20 28 6c 69 #t (li
1960: 73 74 3f 20 28 74 77 69 6b 69 3a 65 64 69 74 2d st? (twiki:edit-
1970: 74 69 64 64 6c 65 72 20 2a 74 64 62 2a 20 6b 65 tiddler *tdb* ke
1980: 79 20 30 20 30 29 29 29 0a 28 74 65 73 74 20 22 y 0 0))).(test "
1990: 74 77 69 6b 69 3a 6d 61 69 6e 74 5f 61 72 65 61 twiki:maint_area
19a0: 22 20 20 20 20 20 20 20 20 20 22 3c 44 49 56 3e " "<DIV>
19b0: 22 20 20 28 63 61 72 20 28 74 77 69 6b 69 3a 6d " (car (twiki:m
19c0: 61 69 6e 74 5f 61 72 65 61 20 2a 74 64 62 2a 20 aint_area *tdb*
19d0: 31 20 6b 65 79 20 77 69 6b 69 29 29 29 0a 28 74 1 key wiki))).(t
19e0: 65 73 74 20 22 74 77 69 6b 69 3a 70 69 63 5f 6d est "twiki:pic_m
19f0: 67 6d 74 22 20 20 20 20 20 20 20 20 20 20 20 22 gmt" "
1a00: 3c 44 49 56 3e 22 20 20 28 63 61 72 20 28 74 77 <DIV>" (car (tw
1a10: 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 20 2a 74 64 iki:pic_mgmt *td
1a20: 62 2a 20 31 20 6b 65 79 29 29 29 0a 0a 3b 3b 20 b* 1 key)))..;;
1a30: 67 65 74 20 61 20 62 6c 6f 62 20 6a 70 67 20 74 get a blob jpg t
1a40: 6f 20 70 72 6f 63 65 73 73 0a 28 64 65 66 69 6e o process.(defin
1a50: 65 20 69 6e 70 32 20 28 6f 70 65 6e 2d 69 6e 70 e inp2 (open-inp
1a60: 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 6b ut-file "tests/k
1a70: 69 61 74 6f 61 2e 70 6e 67 22 29 29 0a 28 64 65 iatoa.png")).(de
1a80: 66 69 6e 65 20 64 61 74 20 20 28 73 74 72 69 6e fine dat (strin
1a90: 67 2d 3e 62 6c 6f 62 20 28 72 65 61 64 2d 73 74 g->blob (read-st
1aa0: 72 69 6e 67 20 23 66 20 69 6e 70 32 29 29 29 0a ring #f inp2))).
1ab0: 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 (close-input-por
1ac0: 74 20 69 6e 70 32 29 0a 0a 0a 28 74 65 73 74 20 t inp2)...(test
1ad0: 22 74 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 22 "twiki:save-pic"
1ae0: 20 20 20 20 20 20 20 20 20 20 20 23 74 20 20 20 #t
1af0: 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d (twiki:save-
1b00: 70 69 63 20 2a 74 64 62 2a 20 28 6c 69 73 74 20 pic *tdb* (list
1b10: 22 6d 79 70 69 63 2e 6a 70 67 22 20 22 69 6d 61 "mypic.jpg" "ima
1b20: 67 65 2f 6a 70 65 67 22 20 64 61 74 29 20 30 29 ge/jpeg" dat) 0)
1b30: 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 3e 62 6c ) ;; (string->bl
1b40: 6f 62 20 22 74 65 73 74 69 6e 67 20 65 68 21 22 ob "testing eh!"
1b50: 29 29 29 29 20 0a 3b 3b 20 28 74 65 73 74 20 22 )))) .;; (test "
1b60: 74 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 twiki:save-pic-f
1b70: 72 6f 6d 2d 66 6f 72 6d 22 20 23 66 20 20 20 20 rom-form" #f
1b80: 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 70 (twiki:save-p
1b90: 69 63 2d 66 72 6f 6d 2d 66 6f 72 6d 20 2a 74 64 ic-from-form *td
1ba0: 62 2a 20 31 29 29 0a 0a 3b 3b 20 6d 6f 72 65 20 b* 1))..;; more
1bb0: 74 65 73 74 73 20 6f 6e 20 64 61 74 73 0a 0a 28 tests on dats..(
1bc0: 64 65 66 69 6e 65 20 64 61 74 20 23 66 29 0a 28 define dat #f).(
1bd0: 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 65 6e 2d let ((inp (open-
1be0: 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 input-file "test
1bf0: 73 2f 6b 69 61 74 6f 61 2e 70 6e 67 22 29 29 29 s/kiatoa.png")))
1c00: 0a 20 20 28 73 65 74 21 20 64 61 74 20 28 72 65 . (set! dat (re
1c10: 61 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 ad-string #f inp
1c20: 29 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 )). (close-inpu
1c30: 74 2d 70 6f 72 74 20 69 6e 70 29 29 0a 28 75 73 t-port inp)).(us
1c40: 65 20 6d 64 35 29 0a 28 64 65 66 69 6e 65 20 64 e md5).(define d
1c50: 61 74 2d 6d 64 35 20 28 6d 64 35 3a 64 69 67 65 at-md5 (md5:dige
1c60: 73 74 20 64 61 74 29 29 0a 28 74 65 73 74 20 22 st dat)).(test "
1c70: 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 20 28 twiki:save-dat (
1c80: 62 69 6e 61 72 79 29 22 20 34 20 20 20 20 20 20 binary)" 4
1c90: 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 (twiki:save-da
1ca0: 74 20 2a 74 64 62 2a 20 64 61 74 20 31 29 29 0a t *tdb* dat 1)).
1cb0: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 (test "twiki:get
1cc0: 2d 64 61 74 20 28 62 69 6e 61 72 79 29 22 20 20 -dat (binary)"
1cd0: 64 61 74 2d 6d 64 35 20 20 28 6c 65 74 20 28 28 dat-md5 (let ((
1ce0: 64 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 d (twiki:get-dat
1cf0: 20 2a 74 64 62 2a 20 34 29 29 29 0a 09 09 09 09 *tdb* 4))).....
1d00: 09 20 20 20 28 6d 64 35 3a 64 69 67 65 73 74 20 . (md5:digest
1d10: 64 29 29 29 0a 3b 3b 20 66 6f 72 6d 73 0a 3b 3b d))).;; forms.;;
1d20: 20 28 64 65 66 69 6e 65 20 69 6e 70 20 28 6f 70 (define inp (op
1d30: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 en-input-file "t
1d40: 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 6f 73 ests/example.pos
1d50: 74 2e 69 6e 22 29 29 0a 3b 3b 20 28 64 65 66 69 t.in")).;; (defi
1d60: 6e 65 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 ne dat (read-str
1d70: 69 6e 67 20 23 66 20 69 6e 70 29 29 0a 3b 3b 20 ing #f inp)).;;
1d80: 28 64 65 66 69 6e 65 20 64 61 74 73 74 72 20 28 (define datstr (
1d90: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
1da0: 67 20 64 61 74 29 29 0a 0a 3b 3b 20 62 69 6e 61 g dat))..;; bina
1db0: 72 79 20 69 6e 70 75 74 73 0a 28 64 65 66 69 6e ry inputs.(defin
1dc0: 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 e inp (open-inpu
1dd0: 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 78 t-file "tests/ex
1de0: 61 6d 70 6c 65 2e 70 6f 73 74 2e 62 69 6e 61 72 ample.post.binar
1df0: 79 2e 69 6e 22 29 29 0a 28 64 65 66 69 6e 65 20 y.in")).(define
1e00: 64 61 74 20 23 66 29 0a 0a 28 74 65 73 74 20 22 dat #f)..(test "
1e10: 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c formdat:load-all
1e20: 2d 70 6f 72 74 20 6d 75 6c 74 69 70 61 72 74 22 -port multipart"
1e30: 20 23 74 20 28 6c 65 74 20 28 28 69 64 61 74 20 #t (let ((idat
1e40: 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c (formdat:load-al
1e50: 6c 2d 70 6f 72 74 20 69 6e 70 29 29 29 0a 09 09 l-port inp)))...
1e60: 09 09 20 20 20 28 73 65 74 21 20 64 61 74 20 69 .. (set! dat i
1e70: 64 61 74 29 0a 09 09 09 09 20 20 20 23 74 29 29 dat)..... #t))
1e80: 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 3a .(test "formdat:
1e90: 6b 65 79 73 22 20 27 28 70 69 63 74 75 72 65 2d keys" '(picture-
1ea0: 6e 61 6d 65 20 69 6e 70 75 74 2d 70 69 63 74 75 name input-pictu
1eb0: 72 65 20 22 22 20 73 75 62 6d 69 74 2d 70 69 63 re "" submit-pic
1ec0: 74 75 72 65 29 20 28 66 6f 72 6d 64 61 74 3a 6b ture) (formdat:k
1ed0: 65 79 73 20 64 61 74 29 29 0a 0a 28 64 65 66 69 eys dat))..(defi
1ee0: 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 ne inp (open-inp
1ef0: 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 ut-file "tests/e
1f00: 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 xample.post.in")
1f10: 29 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 ).(test "formdat
1f20: 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 73 :load-all-port s
1f30: 69 6e 67 6c 65 20 70 61 72 74 22 20 23 74 20 28 ingle part" #t (
1f40: 6c 65 74 20 28 28 69 64 61 74 20 28 66 6f 72 6d let ((idat (form
1f50: 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 dat:load-all-por
1f60: 74 20 69 6e 70 29 29 29 0a 09 09 09 09 20 20 20 t inp))).....
1f70: 28 73 65 74 21 20 64 61 74 20 69 64 61 74 29 0a (set! dat idat).
1f80: 09 09 09 09 20 20 20 23 74 29 29 0a 28 74 65 73 .... #t)).(tes
1f90: 74 20 22 66 6f 72 6d 64 61 74 3a 6b 65 79 73 22 t "formdat:keys"
1fa0: 20 27 28 65 6d 61 69 6c 2d 61 64 64 72 65 73 73 '(email-address
1fb0: 20 66 6f 72 6d 2d 6e 61 6d 65 20 70 61 73 73 77 form-name passw
1fc0: 6f 72 64 29 20 28 66 6f 72 6d 64 61 74 3a 6b 65 ord) (formdat:ke
1fd0: 79 73 20 64 61 74 29 29 0a 0a 28 63 6c 6f 73 65 ys dat))..(close
1fe0: 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 -input-port inp)
1ff0: 0a .