Artifact
4d4eb9d3180d28e1dfaa573688dbb038b4c1511c:
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 20 64 62 69 29 0a 0a 28 6c 6f 61 64 20 22 2e 5 dbi)..(load ".
0180: 2f 72 65 71 75 69 72 65 6d 65 6e 74 73 2e 73 63 /requirements.sc
0190: 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 6d 69 73 m").(load "./mis
01a0: 63 2d 73 74 6d 6c 2e 73 63 6d 22 29 0a 28 6c 6f c-stml.scm").(lo
01b0: 61 64 20 22 2e 2f 66 6f 72 6d 64 61 74 2e 73 63 ad "./formdat.sc
01c0: 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 73 74 6d m").(load "./stm
01d0: 6c 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e l.scm").(load ".
01e0: 2f 73 65 73 73 69 6f 6e 2e 73 63 6d 22 29 0a 28 /session.scm").(
01f0: 6c 6f 61 64 20 22 2e 2f 73 71 6c 74 62 6c 2e 73 load "./sqltbl.s
0200: 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 68 74 cm").(load "./ht
0210: 6d 6c 2d 66 69 6c 74 65 72 2e 73 63 6d 22 29 0a ml-filter.scm").
0220: 28 6c 6f 61 64 20 22 2e 2f 6b 65 79 73 74 6f 72 (load "./keystor
0230: 65 2e 73 63 6d 22 29 0a 0a 3b 3b 20 54 65 73 74 e.scm")..;; Test
0240: 20 74 68 65 20 70 72 69 6d 69 74 69 76 65 20 64 the primitive d
0250: 62 69 20 69 6e 74 65 72 66 61 63 65 0a 0a 28 73 bi interface..(s
0260: 79 73 74 65 6d 20 22 72 6d 20 2d 66 20 74 65 73 ystem "rm -f tes
0270: 74 73 2f 74 65 73 74 2e 64 62 22 29 0a 28 64 65 ts/test.db").(de
0280: 66 69 6e 65 20 64 62 20 28 64 62 69 3a 6f 70 65 fine db (dbi:ope
0290: 6e 20 27 73 71 6c 69 74 65 33 20 27 28 28 64 62 n 'sqlite3 '((db
02a0: 6e 61 6d 65 20 2e 20 22 74 65 73 74 73 2f 74 65 name . "tests/te
02b0: 73 74 2e 64 62 22 29 29 29 29 0a 28 64 62 69 3a st.db")))).(dbi:
02c0: 65 78 65 63 20 64 62 20 22 43 52 45 41 54 45 20 exec db "CREATE
02d0: 54 41 42 4c 45 20 66 6f 6f 28 69 64 20 49 4e 54 TABLE foo(id INT
02e0: 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 EGER PRIMARY KEY
02f0: 2c 6e 61 6d 65 20 54 45 58 54 29 3b 22 29 0a 28 ,name TEXT);").(
0300: 64 62 69 3a 65 78 65 63 20 64 62 20 22 49 4e 53 dbi:exec db "INS
0310: 45 52 54 20 49 4e 54 4f 20 66 6f 6f 28 6e 61 6d ERT INTO foo(nam
0320: 65 29 20 56 41 4c 55 45 53 28 3f 29 3b 22 20 22 e) VALUES(?);" "
0330: 4d 61 74 74 22 29 0a 28 64 62 69 3a 66 6f 72 2d Matt").(dbi:for-
0340: 65 61 63 68 2d 72 6f 77 20 0a 20 28 6c 61 6d 62 each-row . (lamb
0350: 64 61 20 28 74 75 70 6c 65 29 0a 20 20 20 28 70 da (tuple). (p
0360: 72 69 6e 74 20 28 76 65 63 74 6f 72 2d 72 65 66 rint (vector-ref
0370: 20 74 75 70 6c 65 20 30 29 20 22 20 22 20 28 76 tuple 0) " " (v
0380: 65 63 74 6f 72 2d 72 65 66 20 74 75 70 6c 65 20 ector-ref tuple
0390: 31 29 29 29 0a 20 64 62 20 22 53 45 4c 45 43 54 1))). db "SELECT
03a0: 20 2a 20 46 52 4f 4d 20 66 6f 6f 3b 22 29 0a 28 * FROM foo;").(
03b0: 74 65 73 74 20 22 64 62 69 3a 67 65 74 2d 6f 6e test "dbi:get-on
03c0: 65 22 20 22 4d 61 74 74 22 20 28 64 62 69 3a 67 e" "Matt" (dbi:g
03d0: 65 74 2d 6f 6e 65 20 64 62 20 22 53 45 4c 45 43 et-one db "SELEC
03e0: 54 20 6e 61 6d 65 20 46 52 4f 4d 20 66 6f 6f 20 T name FROM foo
03f0: 57 48 45 52 45 20 6e 61 6d 65 3d 27 4d 61 74 74 WHERE name='Matt
0400: 27 3b 22 29 29 0a 0a 3b 3b 20 6b 65 79 73 74 6f ';"))..;; keysto
0410: 72 65 0a 28 64 62 69 3a 65 78 65 63 20 64 62 20 re.(dbi:exec db
0420: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 6d 65 "CREATE TABLE me
0430: 74 61 64 61 74 61 20 28 69 64 20 49 4e 54 45 47 tadata (id INTEG
0440: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 6b ER PRIMARY KEY,k
0450: 65 79 20 54 45 58 54 2c 76 61 6c 75 65 20 54 45 ey TEXT,value TE
0460: 58 54 29 3b 22 29 0a 0a 28 6b 65 79 73 74 6f 72 XT);")..(keystor
0470: 65 3a 73 65 74 21 20 64 62 20 22 53 43 48 45 4d e:set! db "SCHEM
0480: 41 2d 56 45 52 53 49 4f 4e 22 20 31 2e 32 29 0a A-VERSION" 1.2).
0490: 28 74 65 73 74 20 22 4b 65 79 73 74 6f 72 65 20 (test "Keystore
04a0: 67 65 74 22 20 22 31 2e 32 22 20 20 28 6b 65 79 get" "1.2" (key
04b0: 73 74 6f 72 65 3a 67 65 74 20 20 64 62 20 22 53 store:get db "S
04c0: 43 48 45 4d 41 2d 56 45 52 53 49 4f 4e 22 29 29 CHEMA-VERSION"))
04d0: 0a 28 6b 65 79 73 74 6f 72 65 3a 64 65 6c 21 20 .(keystore:del!
04e0: 64 62 20 22 53 43 48 45 4d 41 2d 56 45 52 53 49 db "SCHEMA-VERSI
04f0: 4f 4e 22 29 20 0a 28 74 65 73 74 20 22 4b 65 79 ON") .(test "Key
0500: 73 74 6f 72 65 20 67 65 74 20 64 65 6c 65 74 65 store get delete
0510: 64 22 20 23 66 20 28 6b 65 79 73 74 6f 72 65 3a d" #f (keystore:
0520: 67 65 74 20 64 62 20 22 53 43 48 45 4d 41 2d 56 get db "SCHEMA-V
0530: 45 52 53 49 4f 4e 22 29 29 0a 0a 28 73 79 73 74 ERSION"))..(syst
0540: 65 6d 20 22 72 6d 20 2d 66 20 74 65 73 74 73 2f em "rm -f tests/
0550: 74 65 73 74 2e 64 62 22 29 0a 0a 3b 3b 20 63 72 test.db")..;; cr
0560: 65 61 74 65 20 61 20 73 65 73 73 69 6f 6e 20 74 eate a session t
0570: 6f 20 77 6f 72 6b 20 77 69 74 68 22 29 0a 28 73 o work with").(s
0580: 65 74 65 6e 76 20 22 52 45 51 55 45 53 54 5f 55 etenv "REQUEST_U
0590: 52 49 22 20 22 2f 73 74 6d 6c 72 75 6e 3f 61 63 RI" "/stmlrun?ac
05a0: 74 69 6f 6e 3d 74 65 73 74 2e 74 65 73 74 22 29 tion=test.test")
05b0: 0a 28 73 65 74 65 6e 76 20 22 53 43 52 49 50 54 .(setenv "SCRIPT
05c0: 5f 4e 41 4d 45 22 20 22 2f 63 67 69 2d 62 69 6e _NAME" "/cgi-bin
05d0: 2f 73 74 6d 6c 72 75 6e 22 29 0a 28 73 65 74 65 /stmlrun").(sete
05e0: 6e 76 20 22 50 41 54 48 5f 49 4e 46 4f 22 20 22 nv "PATH_INFO" "
05f0: 2f 74 65 73 74 22 29 0a 28 73 65 74 65 6e 76 20 /test").(setenv
0600: 22 51 55 45 52 59 5f 53 54 52 49 4e 47 22 20 22 "QUERY_STRING" "
0610: 61 63 74 69 6f 6e 3d 74 65 73 74 2e 74 65 73 74 action=test.test
0620: 22 29 0a 28 73 65 74 65 6e 76 20 22 53 45 52 56 ").(setenv "SERV
0630: 45 52 5f 4e 41 4d 45 22 20 22 6c 6f 63 61 6c 68 ER_NAME" "localh
0640: 6f 73 74 22 29 0a 28 73 65 74 65 6e 76 20 22 52 ost").(setenv "R
0650: 45 51 55 45 53 54 5f 4d 45 54 48 4f 44 22 20 22 EQUEST_METHOD" "
0660: 47 45 54 22 29 0a 0a 28 6c 6f 61 64 20 22 2e 2f GET")..(load "./
0670: 73 65 74 75 70 2e 73 63 6d 22 29 0a 0a 28 73 3a setup.scm")..(s:
0680: 76 61 6c 69 64 61 74 65 2d 69 6e 70 75 74 73 29 validate-inputs)
0690: 0a 0a 3b 3b 20 74 65 73 74 20 73 65 73 73 69 6f ..;; test sessio
06a0: 6e 20 76 61 72 69 61 62 6c 65 73 0a 0a 28 73 65 n variables..(se
06b0: 73 73 69 6f 6e 3a 67 65 74 2d 76 61 72 73 20 73 ssion:get-vars s
06c0: 3a 73 65 73 73 69 6f 6e 29 0a 28 64 65 66 69 6e :session).(defin
06d0: 65 20 6e 61 64 61 20 22 61 6e 64 6e 6e 64 68 68 e nada "andnndhh
06e0: 73 68 61 61 73 22 29 0a 28 73 3a 73 65 73 73 69 shaas").(s:sessi
06f0: 6f 6e 2d 76 61 72 2d 73 65 74 21 20 22 6e 69 63 on-var-set! "nic
0700: 6b 22 20 6e 61 64 61 29 0a 28 74 65 73 74 20 22 k" nada).(test "
0710: 53 65 73 73 69 6f 6e 20 76 61 72 20 73 65 74 2f Session var set/
0720: 67 65 74 22 20 6e 61 64 61 20 20 28 73 3a 73 65 get" nada (s:se
0730: 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 22 6e ssion-var-get "n
0740: 69 63 6b 22 29 29 0a 28 70 72 69 6e 74 20 22 67 ick")).(print "g
0750: 6f 74 20 68 65 72 65 22 29 0a 28 73 65 73 73 69 ot here").(sessi
0760: 6f 6e 3a 73 61 76 65 2d 76 61 72 73 20 73 3a 73 on:save-vars s:s
0770: 65 73 73 69 6f 6e 29 0a 28 73 65 73 73 69 6f 6e ession).(session
0780: 3a 67 65 74 2d 76 61 72 73 20 20 73 3a 73 65 73 :get-vars s:ses
0790: 73 69 6f 6e 29 0a 28 74 65 73 74 20 22 53 65 73 sion).(test "Ses
07a0: 73 69 6f 6e 20 76 61 72 20 73 65 74 2f 67 65 74 sion var set/get
07b0: 20 61 66 74 65 72 20 73 61 76 65 2f 67 65 74 22 after save/get"
07c0: 20 6e 61 64 61 20 28 73 3a 73 65 73 73 69 6f 6e nada (s:session
07d0: 2d 76 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 -var-get "nick")
07e0: 29 0a 28 73 65 73 73 69 6f 6e 3a 64 65 6c 21 20 ).(session:del!
07f0: 73 3a 73 65 73 73 69 6f 6e 20 22 2a 73 65 73 73 s:session "*sess
0800: 69 6f 6e 76 61 72 73 2a 22 20 22 6e 69 63 6b 22 ionvars*" "nick"
0810: 29 0a 28 74 65 73 74 20 22 53 65 73 73 69 6f 6e ).(test "Session
0820: 20 76 61 72 20 64 65 6c 22 20 20 20 20 20 20 20 var del"
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 20 #f
0840: 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 (s:session-var
0850: 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 0a 28 73 -get "nick")).(s
0860: 65 73 73 69 6f 6e 3a 73 61 76 65 2d 76 61 72 73 ession:save-vars
0870: 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 73 65 73 s:session).(ses
0880: 73 69 6f 6e 3a 67 65 74 2d 76 61 72 73 20 73 3a sion:get-vars s:
0890: 73 65 73 73 69 6f 6e 29 0a 28 73 3a 73 65 73 73 session).(s:sess
08a0: 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 22 6e 69 ion-var-set! "ni
08b0: 63 6b 22 20 6e 61 64 61 29 0a 28 73 65 73 73 69 ck" nada).(sessi
08c0: 6f 6e 3a 73 61 76 65 2d 76 61 72 73 20 73 3a 73 on:save-vars s:s
08d0: 65 73 73 69 6f 6e 29 0a 0a 3b 3b 20 28 74 65 73 ession)..;; (tes
08e0: 74 20 22 53 65 73 73 69 6f 6e 20 76 61 72 20 64 t "Session var d
08f0: 65 6c 22 20 20 20 20 20 20 20 20 20 20 20 20 20 el"
0900: 20 20 20 20 20 20 20 23 66 20 20 20 28 73 3a 73 #f (s:s
0910: 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 22 ession-var-get "
0920: 6e 69 63 6b 22 29 29 0a 0a 3b 3b 20 74 65 73 74 nick"))..;; test
0930: 20 70 65 72 73 6f 6e 0a 0a 28 6c 6f 61 64 20 22 person..(load "
0940: 2e 2f 74 65 73 74 73 2f 6d 6f 64 65 6c 73 2f 74 ./tests/models/t
0950: 65 73 74 2e 73 63 6d 22 29 0a 0a 28 70 72 69 6e est.scm")..(prin
0960: 74 20 22 53 65 73 73 69 6f 6e 20 6b 65 79 20 69 t "Session key i
0970: 73 20 22 20 28 73 6c 6f 74 2d 72 65 66 20 73 3a s " (slot-ref s:
0980: 73 65 73 73 69 6f 6e 20 27 73 65 73 73 69 6f 6e session 'session
0990: 2d 6b 65 79 29 29 0a 0a 28 74 65 73 74 20 22 44 -key))..(test "D
09a0: 65 6c 65 74 65 20 73 65 73 73 69 6f 6e 22 20 23 elete session" #
09b0: 74 20 28 73 3a 64 65 6c 65 74 65 2d 73 65 73 73 t (s:delete-sess
09c0: 69 6f 6e 29 29 0a 0a 28 6c 65 74 20 28 28 66 68 ion))..(let ((fh
09d0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 70 69 70 (open-input-pip
09e0: 65 20 22 6c 73 20 2e 2f 74 65 73 74 73 2f 70 61 e "ls ./tests/pa
09f0: 67 65 73 2f 2a 2f 63 6f 6e 74 72 6f 6c 2e 73 63 ges/*/control.sc
0a00: 6d 22 29 29 29 0a 20 20 28 6c 65 74 20 6c 6f 6f m"))). (let loo
0a10: 70 20 28 28 6c 20 28 72 65 61 64 2d 6c 69 6e 65 p ((l (read-line
0a20: 20 66 68 29 29 29 0a 20 20 20 20 28 69 66 20 28 fh))). (if (
0a30: 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f not (eof-object?
0a40: 20 6c 29 29 0a 20 20 20 20 20 20 20 20 28 62 65 l)). (be
0a50: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 3b 3b gin. ;;
0a60: 20 28 70 72 69 6e 74 20 22 6c 6f 61 64 69 6e 67 (print "loading
0a70: 20 22 20 6c 29 0a 20 20 20 20 20 20 20 20 20 20 " l).
0a80: 28 6c 6f 61 64 20 6c 29 0a 20 20 20 20 20 20 20 (load l).
0a90: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l
0aa0: 69 6e 65 20 66 68 29 29 29 29 29 0a 20 20 28 63 ine fh))))). (c
0ab0: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
0ac0: 66 68 29 29 0a 0a 3b 3b 20 53 68 6f 75 6c 64 20 fh))..;; Should
0ad0: 68 61 76 65 20 70 6f 6c 6c 3a 70 6f 6c 6c 20 64 have poll:poll d
0ae0: 65 66 69 6e 65 64 20 6e 6f 77 2e 0a 28 74 65 73 efined now..(tes
0af0: 74 20 22 4d 61 6b 65 20 61 20 72 61 6e 64 6f 6d t "Make a random
0b00: 20 73 74 72 69 6e 67 22 20 32 20 28 73 74 72 69 string" 2 (stri
0b10: 6e 67 2d 6c 65 6e 67 74 68 20 28 73 65 73 73 69 ng-length (sessi
0b20: 6f 6e 3a 6d 61 6b 65 2d 72 61 6e 64 2d 73 74 72 on:make-rand-str
0b30: 69 6e 67 20 32 29 29 29 0a 28 74 65 73 74 20 22 ing 2))).(test "
0b40: 43 72 65 61 74 65 20 61 20 65 6e 63 72 79 70 74 Create a encrypt
0b50: 65 64 20 70 61 73 73 77 6f 72 64 22 20 22 61 62 ed password" "ab
0b60: 51 39 4b 59 2e 4b 66 72 59 72 63 22 20 28 73 3a Q9KY.KfrYrc" (s:
0b70: 63 72 79 70 74 2d 70 61 73 73 77 64 20 22 66 6f crypt-passwd "fo
0b80: 6f 22 20 22 61 62 22 29 29 0a 0a 28 74 65 73 74 o" "ab"))..(test
0b90: 20 22 73 3a 61 6e 79 2d 3e 73 74 72 69 6e 67 20 "s:any->string
0ba0: 6f 6e 20 61 20 68 61 73 68 2d 74 61 62 6c 65 22 on a hash-table"
0bb0: 20 22 23 3c 68 61 73 68 2d 74 61 62 6c 65 3e 22 "#<hash-table>"
0bc0: 20 28 73 3a 61 6e 79 2d 3e 73 74 72 69 6e 67 20 (s:any->string
0bd0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
0be0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 65 6c )))..(define sel
0bf0: 65 63 74 2d 6c 69 73 74 0a 20 20 27 28 28 61 20 ect-list. '((a
0c00: 62 20 63 29 28 64 20 28 65 20 66 20 67 29 28 68 b c)(d (e f g)(h
0c10: 20 69 20 6a 20 23 74 29 29 29 29 0a 28 64 65 66 i j #t)))).(def
0c20: 69 6e 65 20 72 65 73 75 6c 74 20 27 28 22 3c 53 ine result '("<S
0c30: 45 4c 45 43 54 20 6e 61 6d 65 3d 5c 22 65 66 67 ELECT name=\"efg
0c40: 5c 22 3e 22 20 0a 09 09 20 28 28 28 22 3c 4f 50 \">" ... ((("<OP
0c50: 54 49 4f 4e 20 6c 61 62 65 6c 3d 5c 22 61 5c 22 TION label=\"a\"
0c60: 20 76 61 6c 75 65 3d 5c 22 62 5c 22 3e 63 3c 2f value=\"b\">c</
0c70: 4f 50 54 49 4f 4e 3e 22 29 20 0a 09 09 20 20 20 OPTION>") ...
0c80: 28 22 3c 4f 50 54 47 52 4f 55 50 20 6c 61 62 65 ("<OPTGROUP labe
0c90: 6c 3d 64 22 20 0a 09 09 20 20 20 20 28 22 3c 4f l=d" ... ("<O
0ca0: 50 54 49 4f 4e 20 6c 61 62 65 6c 3d 5c 22 65 5c PTION label=\"e\
0cb0: 22 20 76 61 6c 75 65 3d 5c 22 66 5c 22 3e 67 3c " value=\"f\">g<
0cc0: 2f 4f 50 54 49 4f 4e 3e 22 29 0a 09 09 20 20 20 /OPTION>")...
0cd0: 20 28 22 3c 4f 50 54 49 4f 4e 20 20 73 65 6c 65 ("<OPTION sele
0ce0: 63 74 65 64 20 6c 61 62 65 6c 3d 5c 22 68 5c 22 cted label=\"h\"
0cf0: 20 76 61 6c 75 65 3d 5c 22 69 5c 22 3e 6a 3c 2f value=\"i\">j</
0d00: 4f 50 54 49 4f 4e 3e 22 29 20 0a 09 09 20 20 20 OPTION>") ...
0d10: 20 22 3c 2f 4f 50 54 47 52 4f 55 50 3e 22 29 29 "</OPTGROUP>"))
0d20: 29 0a 09 09 20 22 3c 2f 53 45 4c 45 43 54 3e 22 )... "</SELECT>"
0d30: 29 29 0a 0a 28 74 65 73 74 20 22 53 65 6c 65 63 ))..(test "Selec
0d40: 74 20 6c 69 73 74 22 20 72 65 73 75 6c 74 20 28 t list" result (
0d50: 73 3a 73 65 6c 65 63 74 20 73 65 6c 65 63 74 2d s:select select-
0d60: 6c 69 73 74 20 27 6e 61 6d 65 20 22 65 66 67 22 list 'name "efg"
0d70: 29 29 0a 0a 3b 3b 20 54 65 73 74 20 6d 6f 64 75 ))..;; Test modu
0d80: 6c 65 73 0a 0a 28 74 65 73 74 20 22 6d 69 73 63 les..(test "misc
0d90: 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 :non-zero-string
0da0: 20 5c 22 5c 22 22 20 23 66 20 28 6d 69 73 63 3a \"\"" #f (misc:
0db0: 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 non-zero-string
0dc0: 22 22 29 29 0a 28 74 65 73 74 20 22 6d 69 73 63 "")).(test "misc
0dd0: 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 :non-zero-string
0de0: 20 23 66 22 20 23 66 20 28 6d 69 73 63 3a 6e 6f #f" #f (misc:no
0df0: 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 23 66 n-zero-string #f
0e00: 29 29 0a 28 74 65 73 74 20 22 6d 69 73 63 3a 6e )).(test "misc:n
0e10: 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 27 on-zero-string '
0e20: 62 6c 61 68 22 20 23 66 20 28 6d 69 73 63 3a 6e blah" #f (misc:n
0e30: 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 27 on-zero-string '
0e40: 62 6c 61 68 29 29 0a 0a 3b 3b 20 66 6f 72 6d 73 blah))..;; forms
0e50: 0a 28 64 65 66 69 6e 65 20 66 6f 72 6d 20 23 66 .(define form #f
0e60: 29 0a 28 74 65 73 74 20 22 6d 61 6b 65 20 3c 66 ).(test "make <f
0e70: 6f 72 6d 64 61 74 3e 22 20 23 74 20 28 6c 65 74 ormdat>" #t (let
0e80: 20 28 28 66 20 28 6d 61 6b 65 20 3c 66 6f 72 6d ((f (make <form
0e90: 64 61 74 3e 29 29 29 0a 09 09 09 20 20 20 20 28 dat>))).... (
0ea0: 73 65 74 21 20 66 6f 72 6d 20 66 29 0a 09 09 09 set! form f)....
0eb0: 20 20 20 20 23 74 29 29 0a 28 74 65 73 74 20 22 #t)).(test "
0ec0: 66 6f 72 6d 64 61 74 3a 20 73 65 74 21 2f 67 65 formdat: set!/ge
0ed0: 74 22 20 22 59 65 70 21 22 20 28 62 65 67 69 6e t" "Yep!" (begin
0ee0: 0a 09 09 09 09 20 20 20 28 66 6f 72 6d 64 61 74 ..... (formdat
0ef0: 3a 73 65 74 21 20 66 6f 72 6d 20 22 62 6c 61 68 :set! form "blah
0f00: 22 20 22 59 65 70 21 22 29 0a 09 09 09 09 20 20 " "Yep!").....
0f10: 20 28 66 6f 72 6d 64 61 74 3a 67 65 74 20 20 66 (formdat:get f
0f20: 6f 72 6d 20 22 62 6c 61 68 22 29 29 29 0a 0a 3b orm "blah")))..;
0f30: 3b 20 54 68 65 20 74 77 69 6b 69 20 6d 6f 64 75 ; The twiki modu
0f40: 6c 65 0a 0a 3b 3b 20 63 6c 65 61 6e 20 75 70 0a le..;; clean up.
0f50: 28 73 79 73 74 65 6d 20 22 72 6d 20 2d 72 66 20 (system "rm -rf
0f60: 74 77 69 6b 69 73 2f 2a 22 29 0a 28 6c 6f 61 64 twikis/*").(load
0f70: 20 22 6d 6f 64 75 6c 65 73 2f 74 77 69 6b 69 2f "modules/twiki/
0f80: 74 77 69 6b 69 2d 6d 6f 64 2e 73 63 6d 22 29 0a twiki-mod.scm").
0f90: 28 64 65 66 69 6e 65 20 6b 65 79 73 20 28 6c 69 (define keys (li
0fa0: 73 74 20 22 62 6c 61 68 22 20 31 20 27 6e 61 64 st "blah" 1 'nad
0fb0: 61 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 a)).(test "twiki
0fc0: 3a 6b 65 79 73 2d 3e 6b 65 79 22 20 20 22 62 6c :keys->key" "bl
0fd0: 61 68 20 31 20 6e 61 64 61 22 20 28 74 77 69 6b ah 1 nada" (twik
0fe0: 69 3a 6b 65 79 73 2d 3e 6b 65 79 20 6b 65 79 73 i:keys->key keys
0ff0: 29 29 0a 28 64 65 66 69 6e 65 20 6b 65 79 20 28 )).(define key (
1000: 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b 65 79 20 twiki:keys->key
1010: 6b 65 79 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 keys))..(define
1020: 2a 74 64 62 2a 20 23 66 29 0a 28 74 65 73 74 20 *tdb* #f).(test
1030: 22 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 22 20 "twiki:open-db"
1040: 20 20 23 74 20 28 6c 65 74 20 28 28 64 62 20 28 #t (let ((db (
1050: 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 20 6b 65 twiki:open-db ke
1060: 79 29 29 29 0a 09 09 09 20 20 20 20 20 28 73 65 y))).... (se
1070: 74 21 20 2a 74 64 62 2a 20 64 62 29 0a 09 09 09 t! *tdb* db)....
1080: 20 20 20 20 20 28 69 66 20 2a 74 64 62 2a 20 23 (if *tdb* #
1090: 74 20 23 66 29 29 29 0a 28 64 65 66 69 6e 65 20 t #f))).(define
10a0: 77 69 6b 69 20 28 6d 61 6b 65 2d 74 77 69 6b 69 wiki (make-twiki
10b0: 3a 77 69 6b 69 29 29 0a 28 74 77 69 6b 69 3a 77 :wiki)).(twiki:w
10c0: 69 6b 69 2d 73 65 74 2d 77 69 64 21 20 77 69 6b iki-set-wid! wik
10d0: 69 20 31 29 0a 28 74 77 69 6b 69 3a 77 69 6b 69 i 1).(twiki:wiki
10e0: 2d 73 65 74 2d 6e 61 6d 65 21 20 77 69 6b 69 20 -set-name! wiki
10f0: 22 6d 61 69 6e 22 29 0a 28 74 77 69 6b 69 3a 77 "main").(twiki:w
1100: 69 6b 69 2d 73 65 74 2d 70 65 72 6d 73 21 20 77 iki-set-perms! w
1110: 69 6b 69 20 27 28 72 20 77 29 29 0a 0a 28 74 65 iki '(r w))..(te
1120: 73 74 20 22 74 77 69 6b 69 3a 64 61 74 2d 3e 68 st "twiki:dat->h
1130: 74 6d 6c 22 20 27 28 22 48 65 6c 6c 6f 22 20 22 tml" '("Hello" "
1140: 3c 42 52 3e 22 29 20 28 74 77 69 6b 69 3a 64 61 <BR>") (twiki:da
1150: 74 2d 3e 68 74 6d 6c 20 22 48 65 6c 6c 6f 22 20 t->html "Hello"
1160: 77 69 6b 69 29 29 0a 28 74 65 73 74 20 22 74 77 wiki)).(test "tw
1170: 69 6b 69 3a 6b 65 79 73 2d 3e 66 6e 61 6d 65 22 iki:keys->fname"
1180: 20 27 28 22 74 77 69 6b 69 73 2f 59 6d 78 68 61 '("twikis/Ymxha
1190: 2f 43 41 78 49 47 2f 35 68 5a 47 45 22 20 22 59 /CAxIG/5hZGE" "Y
11a0: 6d 78 68 61 43 41 78 49 47 35 68 5a 47 45 5f 22 mxhaCAxIG5hZGE_"
11b0: 29 20 3b 3b 20 28 22 74 77 69 6b 69 73 2f 64 39 ) ;; ("twikis/d9
11c0: 39 61 32 64 65 39 2f 36 38 30 38 34 39 33 62 2f 9a2de9/6808493b/
11d0: 32 33 37 37 30 66 37 30 22 20 22 64 39 39 61 32 23770f70" "d99a2
11e0: 64 65 39 36 38 30 38 34 39 33 62 32 33 37 37 30 de96808493b23770
11f0: 66 37 30 63 37 36 64 66 66 65 34 22 29 0a 20 20 f70c76dffe4").
1200: 20 20 20 20 28 74 77 69 6b 69 3a 6b 65 79 2d 3e (twiki:key->
1210: 66 6e 61 6d 65 20 6b 65 79 29 29 0a 0a 28 74 65 fname key))..(te
1220: 73 74 20 22 74 77 69 6b 69 3a 6e 61 6d 65 2d 3e st "twiki:name->
1230: 77 69 64 22 20 20 20 20 20 31 20 20 20 20 20 28 wid" 1 (
1240: 74 77 69 6b 69 3a 6e 61 6d 65 2d 3e 77 69 64 20 twiki:name->wid
1250: 2a 74 64 62 2a 20 22 6d 61 69 6e 22 29 29 0a 28 *tdb* "main")).(
1260: 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d test "twiki:get-
1270: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d 22 tiddlers-by-num"
1280: 20 27 28 29 20 28 74 77 69 6b 69 3a 67 65 74 2d '() (twiki:get-
1290: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d 20 tiddlers-by-num
12a0: 20 2a 74 64 62 2a 20 30 20 28 6c 69 73 74 20 31 *tdb* 0 (list 1
12b0: 20 32 20 33 29 29 29 0a 28 74 65 73 74 20 22 74 2 3))).(test "t
12c0: 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 wiki:get-tiddler
12d0: 73 2d 62 79 2d 6e 61 6d 65 22 20 27 28 29 20 28 s-by-name" '() (
12e0: 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 twiki:get-tiddle
12f0: 72 73 2d 62 79 2d 6e 61 6d 65 20 2a 74 64 62 2a rs-by-name *tdb*
1300: 20 30 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 0a 0 "MainMenu")).
1310: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 (test "twiki:get
1320: 2d 74 69 64 64 6c 65 72 73 22 20 20 27 28 29 20 -tiddlers" '()
1330: 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 (twiki:get-tidd
1340: 6c 65 72 73 20 2a 74 64 62 2a 20 30 20 28 6c 69 lers *tdb* 0 (li
1350: 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 29 st "MainMenu")))
1360: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 .(test "twiki:ge
1370: 74 2d 74 69 64 64 6c 65 72 73 22 20 20 27 28 29 t-tiddlers" '()
1380: 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 (twiki:get-tid
1390: 64 6c 65 72 73 20 2a 74 64 62 2a 20 30 20 28 6c dlers *tdb* 0 (l
13a0: 69 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22 20 22 ist "MainMenu" "
13b0: 41 6e 6f 74 68 65 72 4f 6e 65 22 29 29 29 0a 28 AnotherOne"))).(
13c0: 74 65 73 74 20 22 74 77 69 6b 69 3a 77 69 6b 69 test "twiki:wiki
13d0: 22 20 22 3c 54 41 42 4c 45 3e 22 20 20 20 20 20 " "<TABLE>"
13e0: 28 63 61 72 20 28 74 77 69 6b 69 3a 77 69 6b 69 (car (twiki:wiki
13f0: 20 22 6d 61 69 6e 22 20 28 6c 69 73 74 20 22 62 "main" (list "b
1400: 6c 61 68 22 20 31 20 27 6e 61 64 61 29 29 29 29 lah" 1 'nada))))
1410: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 76 69 .(test "twiki:vi
1420: 65 77 22 20 20 22 3c 44 49 56 20 63 6c 61 73 73 ew" "<DIV class
1430: 3d 5c 22 6e 6f 64 65 5c 22 3e 22 20 28 63 61 72 =\"node\">" (car
1440: 20 28 74 77 69 6b 69 3a 76 69 65 77 20 22 22 20 (twiki:view ""
1450: 22 22 20 30 20 28 74 77 69 6b 69 3a 74 69 64 64 "" 0 (twiki:tidd
1460: 6c 65 72 2d 6d 61 6b 65 29 20 77 69 6b 69 29 29 ler-make) wiki))
1470: 29 0a 0a 28 74 65 73 74 20 22 73 3a 74 64 22 20 )..(test "s:td"
1480: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 22 '("
1490: 3c 54 44 3e 22 20 28 28 29 29 20 22 3c 2f 54 44 <TD>" (()) "</TD
14a0: 3e 22 29 20 28 73 3a 74 64 20 27 28 29 29 29 0a >") (s:td '())).
14b0: 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 3a ;; (test "twiki:
14c0: 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d get-tiddlers-by-
14d0: 6e 61 6d 65 22 20 27 28 29 20 28 74 77 69 6b 69 name" '() (twiki
14e0: 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 :get-tiddlers-by
14f0: 2d 6e 61 6d 65 20 31 20 22 66 72 65 64 22 29 29 -name 1 "fred"))
1500: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 74 69 .(test "twiki:ti
1510: 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e 69 64 22 20 ddler-name->id"
1520: 31 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 1 (twiki:tiddler
1530: 2d 6e 61 6d 65 2d 3e 69 64 20 2a 74 64 62 2a 20 -name->id *tdb*
1540: 22 4d 61 69 6e 4d 65 6e 75 22 29 29 0a 28 74 65 "MainMenu")).(te
1550: 73 74 20 22 73 3a 73 65 74 21 20 61 20 76 61 72 st "s:set! a var
1560: 20 74 6f 20 23 66 22 20 20 20 20 20 22 22 0a 20 to #f" "".
1570: 20 20 20 20 20 28 62 65 67 69 6e 20 28 73 3a 73 (begin (s:s
1580: 65 74 21 20 22 42 4c 41 48 22 20 23 66 29 0a 09 et! "BLAH" #f)..
1590: 20 20 20 20 20 28 73 3a 67 65 74 20 22 42 4c 41 (s:get "BLA
15a0: 48 22 29 29 29 20 3b 3b 20 64 6f 6e 27 74 20 6b H"))) ;; don't k
15b0: 6e 6f 77 20 69 66 20 74 68 69 73 20 6f 6e 65 20 now if this one
15c0: 6d 61 6b 65 73 20 73 65 6e 73 65 2e 20 53 65 74 makes sense. Set
15d0: 74 69 6e 67 20 74 6f 20 23 66 20 73 68 6f 75 6c ting to #f shoul
15e0: 64 20 72 65 61 6c 6c 79 20 64 65 6c 65 74 65 20 d really delete
15f0: 74 68 65 20 76 61 6c 75 65 0a 28 74 65 73 74 20 the value.(test
1600: 22 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 22 "twiki:save-dat"
1610: 20 20 20 20 20 20 20 20 20 20 20 32 20 20 20 20 2
1620: 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d (twiki:save-
1630: 64 61 74 20 2a 74 64 62 2a 20 22 64 61 74 22 20 dat *tdb* "dat"
1640: 30 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 0)).(test "twiki
1650: 3a 67 65 74 2d 64 61 74 22 20 20 20 20 20 20 20 :get-dat"
1660: 20 20 20 20 20 22 64 61 74 22 20 20 20 20 28 74 "dat" (t
1670: 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 wiki:get-dat *td
1680: 62 2a 20 32 29 29 0a 28 74 65 73 74 20 22 74 77 b* 2)).(test "tw
1690: 69 6b 69 3a 67 65 74 2d 64 61 74 22 20 20 20 20 iki:get-dat"
16a0: 20 20 20 20 20 20 20 20 23 66 20 20 20 20 20 20 #f
16b0: 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 (twiki:get-dat
16c0: 2a 74 64 62 2a 20 35 29 29 0a 3b 3b 20 28 74 65 *tdb* 5)).;; (te
16d0: 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 st "twiki:get-da
16e0: 74 22 20 20 20 20 20 20 23 66 20 20 20 20 28 74 t" #f (t
16f0: 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 wiki:get-dat *td
1700: 62 2a 20 23 66 29 29 0a 28 74 65 73 74 20 22 74 b* #f)).(test "t
1710: 77 69 6b 69 3a 73 61 76 65 2d 74 69 64 64 6c 65 wiki:save-tiddle
1720: 72 22 20 20 20 20 20 20 20 23 74 20 20 20 20 20 r" #t
1730: 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 74 69 (twiki:save-ti
1740: 64 64 6c 65 72 20 2a 74 64 62 2a 20 22 68 65 61 ddler *tdb* "hea
1750: 64 69 6e 67 22 20 22 62 6f 64 79 22 20 22 74 61 ding" "body" "ta
1760: 67 73 22 20 6b 65 79 20 30 29 29 0a 3b 3b 20 28 gs" key 0)).;; (
1770: 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 test "twiki:save
1780: 2d 63 75 72 72 2d 74 69 64 64 6c 65 72 22 20 20 -curr-tiddler"
1790: 23 66 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a #f (twiki:
17a0: 73 61 76 65 2d 63 75 72 72 2d 74 69 64 64 6c 65 save-curr-tiddle
17b0: 72 20 2a 74 64 62 2a 20 31 29 29 0a 28 74 65 73 r *tdb* 1)).(tes
17c0: 74 20 22 74 77 69 6b 69 3a 65 64 69 74 2d 74 77 t "twiki:edit-tw
17d0: 69 64 64 6c 65 72 22 20 20 20 20 20 20 23 74 20 iddler" #t
17e0: 20 20 20 20 20 20 28 6c 69 73 74 3f 20 28 74 77 (list? (tw
17f0: 69 6b 69 3a 65 64 69 74 2d 74 69 64 64 6c 65 72 iki:edit-tiddler
1800: 20 2a 74 64 62 2a 20 6b 65 79 20 30 20 30 29 29 *tdb* key 0 0))
1810: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 6d ).(test "twiki:m
1820: 61 69 6e 74 5f 61 72 65 61 22 20 20 20 20 20 20 aint_area"
1830: 20 20 20 22 3c 44 49 56 3e 22 20 20 28 63 61 72 "<DIV>" (car
1840: 20 28 74 77 69 6b 69 3a 6d 61 69 6e 74 5f 61 72 (twiki:maint_ar
1850: 65 61 20 2a 74 64 62 2a 20 31 20 6b 65 79 20 77 ea *tdb* 1 key w
1860: 69 6b 69 29 29 29 0a 28 74 65 73 74 20 22 74 77 iki))).(test "tw
1870: 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 22 20 20 20 iki:pic_mgmt"
1880: 20 20 20 20 20 20 20 20 22 3c 44 49 56 3e 22 20 "<DIV>"
1890: 20 28 63 61 72 20 28 74 77 69 6b 69 3a 70 69 63 (car (twiki:pic
18a0: 5f 6d 67 6d 74 20 2a 74 64 62 2a 20 31 20 6b 65 _mgmt *tdb* 1 ke
18b0: 79 29 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20 62 y)))..;; get a b
18c0: 6c 6f 62 20 6a 70 67 20 74 6f 20 70 72 6f 63 65 lob jpg to proce
18d0: 73 73 0a 28 64 65 66 69 6e 65 20 69 6e 70 32 20 ss.(define inp2
18e0: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 (open-input-file
18f0: 20 22 74 65 73 74 73 2f 6b 69 61 74 6f 61 2e 70 "tests/kiatoa.p
1900: 6e 67 22 29 29 0a 28 64 65 66 69 6e 65 20 64 61 ng")).(define da
1910: 74 20 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f 62 t (string->blob
1920: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 (read-string #f
1930: 20 69 6e 70 32 29 29 29 0a 28 63 6c 6f 73 65 2d inp2))).(close-
1940: 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 32 29 input-port inp2)
1950: 0a 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a ...(test "twiki:
1960: 73 61 76 65 2d 70 69 63 22 20 20 20 20 20 20 20 save-pic"
1970: 20 20 20 20 23 74 20 20 20 20 20 20 20 28 74 77 #t (tw
1980: 69 6b 69 3a 73 61 76 65 2d 70 69 63 20 2a 74 64 iki:save-pic *td
1990: 62 2a 20 28 6c 69 73 74 20 22 6d 79 70 69 63 2e b* (list "mypic.
19a0: 6a 70 67 22 20 22 69 6d 61 67 65 2f 6a 70 65 67 jpg" "image/jpeg
19b0: 22 20 64 61 74 29 20 30 29 29 20 3b 3b 20 28 73 " dat) 0)) ;; (s
19c0: 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 22 74 65 73 tring->blob "tes
19d0: 74 69 6e 67 20 65 68 21 22 29 29 29 29 20 0a 3b ting eh!")))) .;
19e0: 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 ; (test "twiki:s
19f0: 61 76 65 2d 70 69 63 2d 66 72 6f 6d 2d 66 6f 72 ave-pic-from-for
1a00: 6d 22 20 23 66 20 20 20 20 20 20 20 28 74 77 69 m" #f (twi
1a10: 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 72 6f 6d ki:save-pic-from
1a20: 2d 66 6f 72 6d 20 2a 74 64 62 2a 20 31 29 29 0a -form *tdb* 1)).
1a30: 0a 3b 3b 20 6d 6f 72 65 20 74 65 73 74 73 20 6f .;; more tests o
1a40: 6e 20 64 61 74 73 0a 0a 28 64 65 66 69 6e 65 20 n dats..(define
1a50: 64 61 74 20 23 66 29 0a 28 6c 65 74 20 28 28 69 dat #f).(let ((i
1a60: 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 np (open-input-f
1a70: 69 6c 65 20 22 74 65 73 74 73 2f 6b 69 61 74 6f ile "tests/kiato
1a80: 61 2e 70 6e 67 22 29 29 29 0a 20 20 28 73 65 74 a.png"))). (set
1a90: 21 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 ! dat (read-stri
1aa0: 6e 67 20 23 66 20 69 6e 70 29 29 0a 20 20 28 63 ng #f inp)). (c
1ab0: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
1ac0: 69 6e 70 29 29 0a 28 75 73 65 20 6d 64 35 29 0a inp)).(use md5).
1ad0: 28 64 65 66 69 6e 65 20 64 61 74 2d 6d 64 35 20 (define dat-md5
1ae0: 28 6d 64 35 3a 64 69 67 65 73 74 20 64 61 74 29 (md5:digest dat)
1af0: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 ).(test "twiki:s
1b00: 61 76 65 2d 64 61 74 20 28 62 69 6e 61 72 79 29 ave-dat (binary)
1b10: 22 20 34 20 20 20 20 20 20 20 20 28 74 77 69 6b " 4 (twik
1b20: 69 3a 73 61 76 65 2d 64 61 74 20 2a 74 64 62 2a i:save-dat *tdb*
1b30: 20 64 61 74 20 31 29 29 0a 28 74 65 73 74 20 22 dat 1)).(test "
1b40: 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 28 62 twiki:get-dat (b
1b50: 69 6e 61 72 79 29 22 20 20 64 61 74 2d 6d 64 35 inary)" dat-md5
1b60: 20 20 28 6c 65 74 20 28 28 64 20 28 74 77 69 6b (let ((d (twik
1b70: 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 62 2a 20 i:get-dat *tdb*
1b80: 34 29 29 29 0a 09 09 09 09 09 20 20 20 28 6d 64 4)))...... (md
1b90: 35 3a 64 69 67 65 73 74 20 64 29 29 29 0a 3b 3b 5:digest d))).;;
1ba0: 20 66 6f 72 6d 73 0a 3b 3b 20 28 64 65 66 69 6e forms.;; (defin
1bb0: 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 e inp (open-inpu
1bc0: 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 78 t-file "tests/ex
1bd0: 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 29 ample.post.in"))
1be0: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 64 61 74 20 .;; (define dat
1bf0: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 (read-string #f
1c00: 69 6e 70 29 29 0a 3b 3b 20 28 64 65 66 69 6e 65 inp)).;; (define
1c10: 20 64 61 74 73 74 72 20 28 6f 70 65 6e 2d 69 6e datstr (open-in
1c20: 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 29 29 put-string dat))
1c30: 0a 0a 3b 3b 20 62 69 6e 61 72 79 20 69 6e 70 75 ..;; binary inpu
1c40: 74 73 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 28 ts.(define inp (
1c50: 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 open-input-file
1c60: 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 "tests/example.p
1c70: 6f 73 74 2e 62 69 6e 61 72 79 2e 69 6e 22 29 29 ost.binary.in"))
1c80: 0a 28 64 65 66 69 6e 65 20 64 61 74 20 23 66 29 .(define dat #f)
1c90: 0a 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 ..(test "formdat
1ca0: 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 6d :load-all-port m
1cb0: 75 6c 74 69 70 61 72 74 22 20 23 74 20 28 6c 65 ultipart" #t (le
1cc0: 74 20 28 28 69 64 61 74 20 28 66 6f 72 6d 64 61 t ((idat (formda
1cd0: 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 t:load-all-port
1ce0: 69 6e 70 29 29 29 0a 09 09 09 09 20 20 20 28 73 inp)))..... (s
1cf0: 65 74 21 20 64 61 74 20 69 64 61 74 29 0a 09 09 et! dat idat)...
1d00: 09 09 20 20 20 23 74 29 29 0a 28 74 65 73 74 20 .. #t)).(test
1d10: 22 66 6f 72 6d 64 61 74 3a 6b 65 79 73 22 20 27 "formdat:keys" '
1d20: 28 70 69 63 74 75 72 65 2d 6e 61 6d 65 20 69 6e (picture-name in
1d30: 70 75 74 2d 70 69 63 74 75 72 65 20 22 22 20 73 put-picture "" s
1d40: 75 62 6d 69 74 2d 70 69 63 74 75 72 65 29 20 28 ubmit-picture) (
1d50: 66 6f 72 6d 64 61 74 3a 6b 65 79 73 20 64 61 74 formdat:keys dat
1d60: 29 29 0a 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 ))..(define inp
1d70: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 (open-input-file
1d80: 20 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e "tests/example.
1d90: 70 6f 73 74 2e 69 6e 22 29 29 0a 28 74 65 73 74 post.in")).(test
1da0: 20 22 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 "formdat:load-a
1db0: 6c 6c 2d 70 6f 72 74 20 73 69 6e 67 6c 65 20 70 ll-port single p
1dc0: 61 72 74 22 20 23 74 20 28 6c 65 74 20 28 28 69 art" #t (let ((i
1dd0: 64 61 74 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 dat (formdat:loa
1de0: 64 2d 61 6c 6c 2d 70 6f 72 74 20 69 6e 70 29 29 d-all-port inp))
1df0: 29 0a 09 09 09 09 20 20 20 28 73 65 74 21 20 64 )..... (set! d
1e00: 61 74 20 69 64 61 74 29 0a 09 09 09 09 20 20 20 at idat).....
1e10: 23 74 29 29 0a 28 74 65 73 74 20 22 66 6f 72 6d #t)).(test "form
1e20: 64 61 74 3a 6b 65 79 73 22 20 27 28 65 6d 61 69 dat:keys" '(emai
1e30: 6c 2d 61 64 64 72 65 73 73 20 66 6f 72 6d 2d 6e l-address form-n
1e40: 61 6d 65 20 70 61 73 73 77 6f 72 64 29 20 28 66 ame password) (f
1e50: 6f 72 6d 64 61 74 3a 6b 65 79 73 20 64 61 74 29 ormdat:keys dat)
1e60: 29 0a 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d )..(close-input-
1e70: 70 6f 72 74 20 69 6e 70 29 0a port inp).