Artifact
855998c61db9f3486d14921292e5bcc7ab167d49:
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 28 orm "blah")))..(
0f30: 74 65 73 74 20 22 73 3a 73 74 72 69 6e 67 2d 3e test "s:string->
0f40: 70 67 69 6e 74 22 20 20 20 31 32 33 20 28 73 3a pgint" 123 (s:
0f50: 61 6e 79 2d 3e 70 67 69 6e 74 20 22 31 32 33 22 any->pgint "123"
0f60: 29 29 0a 28 74 65 73 74 20 22 73 3a 69 6c 6c 65 )).(test "s:ille
0f70: 67 61 6c 2d 70 67 69 6e 74 20 28 6c 65 67 61 6c gal-pgint (legal
0f80: 29 22 20 20 20 20 20 20 20 20 23 66 20 28 73 3a )" #f (s:
0f90: 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 31 30 illegal-pgint 10
0fa0: 31 31 29 29 0a 28 74 65 73 74 20 22 73 3a 69 6c 11)).(test "s:il
0fb0: 6c 65 67 61 6c 2d 70 67 69 6e 74 20 28 69 6c 6c legal-pgint (ill
0fc0: 65 67 61 6c 20 62 69 67 29 22 20 20 20 31 20 28 egal big)" 1 (
0fd0: 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 s:illegal-pgint
0fe0: 20 39 39 39 39 39 39 39 39 39 39 29 29 0a 28 74 9999999999)).(t
0ff0: 65 73 74 20 22 73 3a 69 6c 6c 65 67 61 6c 70 67 est "s:illegalpg
1000: 69 6e 74 20 28 69 6c 6c 65 67 61 6c 20 73 6d 61 int (illegal sma
1010: 6c 6c 29 22 20 2d 31 20 28 73 3a 69 6c 6c 65 67 ll)" -1 (s:illeg
1020: 61 6c 2d 70 67 69 6e 74 20 2d 39 39 39 39 39 39 al-pgint -999999
1030: 39 39 39 39 29 29 0a 0a 3b 3b 20 54 68 65 20 74 9999))..;; The t
1040: 77 69 6b 69 20 6d 6f 64 75 6c 65 0a 0a 3b 3b 20 wiki module..;;
1050: 63 6c 65 61 6e 20 75 70 0a 28 73 79 73 74 65 6d clean up.(system
1060: 20 22 72 6d 20 2d 72 66 20 74 77 69 6b 69 73 2f "rm -rf twikis/
1070: 2a 22 29 0a 28 6c 6f 61 64 20 22 6d 6f 64 75 6c *").(load "modul
1080: 65 73 2f 74 77 69 6b 69 2f 74 77 69 6b 69 2d 6d es/twiki/twiki-m
1090: 6f 64 2e 73 63 6d 22 29 0a 28 64 65 66 69 6e 65 od.scm").(define
10a0: 20 6b 65 79 73 20 28 6c 69 73 74 20 22 62 6c 61 keys (list "bla
10b0: 68 22 20 31 20 27 6e 61 64 61 29 29 0a 28 74 65 h" 1 'nada)).(te
10c0: 73 74 20 22 74 77 69 6b 69 3a 6b 65 79 73 2d 3e st "twiki:keys->
10d0: 6b 65 79 22 20 20 22 62 6c 61 68 20 31 20 6e 61 key" "blah 1 na
10e0: 64 61 22 20 28 74 77 69 6b 69 3a 6b 65 79 73 2d da" (twiki:keys-
10f0: 3e 6b 65 79 20 6b 65 79 73 29 29 0a 28 64 65 66 >key keys)).(def
1100: 69 6e 65 20 6b 65 79 20 28 74 77 69 6b 69 3a 6b ine key (twiki:k
1110: 65 79 73 2d 3e 6b 65 79 20 6b 65 79 73 29 29 0a eys->key keys)).
1120: 0a 28 64 65 66 69 6e 65 20 2a 74 64 62 2a 20 23 .(define *tdb* #
1130: 66 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a f).(test "twiki:
1140: 6f 70 65 6e 2d 64 62 22 20 20 20 23 74 20 28 6c open-db" #t (l
1150: 65 74 20 28 28 64 62 20 28 74 77 69 6b 69 3a 6f et ((db (twiki:o
1160: 70 65 6e 2d 64 62 20 6b 65 79 29 29 29 0a 09 09 pen-db key)))...
1170: 09 20 20 20 20 20 28 73 65 74 21 20 2a 74 64 62 . (set! *tdb
1180: 2a 20 64 62 29 0a 09 09 09 20 20 20 20 20 28 69 * db).... (i
1190: 66 20 2a 74 64 62 2a 20 23 74 20 23 66 29 29 29 f *tdb* #t #f)))
11a0: 0a 28 64 65 66 69 6e 65 20 77 69 6b 69 20 28 6d .(define wiki (m
11b0: 61 6b 65 2d 74 77 69 6b 69 3a 77 69 6b 69 29 29 ake-twiki:wiki))
11c0: 0a 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 .(twiki:wiki-set
11d0: 2d 77 69 64 21 20 77 69 6b 69 20 31 29 0a 28 74 -wid! wiki 1).(t
11e0: 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 6e 61 wiki:wiki-set-na
11f0: 6d 65 21 20 77 69 6b 69 20 22 6d 61 69 6e 22 29 me! wiki "main")
1200: 0a 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 .(twiki:wiki-set
1210: 2d 70 65 72 6d 73 21 20 77 69 6b 69 20 27 28 72 -perms! wiki '(r
1220: 20 77 29 29 0a 0a 28 74 65 73 74 20 22 74 77 69 w))..(test "twi
1230: 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 22 20 27 28 ki:dat->html" '(
1240: 22 48 65 6c 6c 6f 22 20 22 3c 42 52 3e 22 29 20 "Hello" "<BR>")
1250: 28 74 77 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c (twiki:dat->html
1260: 20 22 48 65 6c 6c 6f 22 20 77 69 6b 69 29 29 0a "Hello" wiki)).
1270: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 6b 65 79 (test "twiki:key
1280: 73 2d 3e 66 6e 61 6d 65 22 20 27 28 22 74 77 69 s->fname" '("twi
1290: 6b 69 73 2f 59 6d 78 68 61 2f 43 41 78 49 47 2f kis/Ymxha/CAxIG/
12a0: 35 68 5a 47 45 22 20 22 59 6d 78 68 61 43 41 78 5hZGE" "YmxhaCAx
12b0: 49 47 35 68 5a 47 45 5f 22 29 20 3b 3b 20 28 22 IG5hZGE_") ;; ("
12c0: 74 77 69 6b 69 73 2f 64 39 39 61 32 64 65 39 2f twikis/d99a2de9/
12d0: 36 38 30 38 34 39 33 62 2f 32 33 37 37 30 66 37 6808493b/23770f7
12e0: 30 22 20 22 64 39 39 61 32 64 65 39 36 38 30 38 0" "d99a2de96808
12f0: 34 39 33 62 32 33 37 37 30 66 37 30 63 37 36 64 493b23770f70c76d
1300: 66 66 65 34 22 29 0a 20 20 20 20 20 20 28 74 77 ffe4"). (tw
1310: 69 6b 69 3a 6b 65 79 2d 3e 66 6e 61 6d 65 20 6b iki:key->fname k
1320: 65 79 29 29 0a 0a 28 74 65 73 74 20 22 74 77 69 ey))..(test "twi
1330: 6b 69 3a 6e 61 6d 65 2d 3e 77 69 64 22 20 20 20 ki:name->wid"
1340: 20 20 31 20 20 20 20 20 28 74 77 69 6b 69 3a 6e 1 (twiki:n
1350: 61 6d 65 2d 3e 77 69 64 20 2a 74 64 62 2a 20 22 ame->wid *tdb* "
1360: 6d 61 69 6e 22 29 29 0a 28 74 65 73 74 20 22 74 main")).(test "t
1370: 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 wiki:get-tiddler
1380: 73 2d 62 79 2d 6e 75 6d 22 20 27 28 29 20 28 74 s-by-num" '() (t
1390: 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 wiki:get-tiddler
13a0: 73 2d 62 79 2d 6e 75 6d 20 20 2a 74 64 62 2a 20 s-by-num *tdb*
13b0: 30 20 28 6c 69 73 74 20 31 20 32 20 33 29 29 29 0 (list 1 2 3)))
13c0: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 .(test "twiki:ge
13d0: 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 t-tiddlers-by-na
13e0: 6d 65 22 20 27 28 29 20 28 74 77 69 6b 69 3a 67 me" '() (twiki:g
13f0: 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e et-tiddlers-by-n
1400: 61 6d 65 20 2a 74 64 62 2a 20 30 20 22 4d 61 69 ame *tdb* 0 "Mai
1410: 6e 4d 65 6e 75 22 29 29 0a 28 74 65 73 74 20 22 nMenu")).(test "
1420: 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 twiki:get-tiddle
1430: 72 73 22 20 20 27 28 29 20 20 28 74 77 69 6b 69 rs" '() (twiki
1440: 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 20 2a 74 :get-tiddlers *t
1450: 64 62 2a 20 30 20 28 6c 69 73 74 20 22 4d 61 69 db* 0 (list "Mai
1460: 6e 4d 65 6e 75 22 29 29 29 0a 28 74 65 73 74 20 nMenu"))).(test
1470: 22 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c "twiki:get-tiddl
1480: 65 72 73 22 20 20 27 28 29 20 20 28 74 77 69 6b ers" '() (twik
1490: 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 20 2a i:get-tiddlers *
14a0: 74 64 62 2a 20 30 20 28 6c 69 73 74 20 22 4d 61 tdb* 0 (list "Ma
14b0: 69 6e 4d 65 6e 75 22 20 22 41 6e 6f 74 68 65 72 inMenu" "Another
14c0: 4f 6e 65 22 29 29 29 0a 28 74 65 73 74 20 22 74 One"))).(test "t
14d0: 77 69 6b 69 3a 77 69 6b 69 22 20 22 3c 54 41 42 wiki:wiki" "<TAB
14e0: 4c 45 3e 22 20 20 20 20 20 28 63 61 72 20 28 74 LE>" (car (t
14f0: 77 69 6b 69 3a 77 69 6b 69 20 22 6d 61 69 6e 22 wiki:wiki "main"
1500: 20 28 6c 69 73 74 20 22 62 6c 61 68 22 20 31 20 (list "blah" 1
1510: 27 6e 61 64 61 29 29 29 29 0a 28 74 65 73 74 20 'nada)))).(test
1520: 22 74 77 69 6b 69 3a 76 69 65 77 22 20 20 22 3c "twiki:view" "<
1530: 44 49 56 20 63 6c 61 73 73 3d 5c 22 6e 6f 64 65 DIV class=\"node
1540: 5c 22 3e 22 20 28 63 61 72 20 28 74 77 69 6b 69 \">" (car (twiki
1550: 3a 76 69 65 77 20 22 22 20 22 22 20 30 20 28 74 :view "" "" 0 (t
1560: 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 6d 61 6b wiki:tiddler-mak
1570: 65 29 20 77 69 6b 69 29 29 29 0a 0a 28 74 65 73 e) wiki)))..(tes
1580: 74 20 22 73 3a 74 64 22 20 20 20 20 20 20 20 20 t "s:td"
1590: 20 20 20 20 20 20 27 28 22 3c 54 44 3e 22 20 28 '("<TD>" (
15a0: 28 29 29 20 22 3c 2f 54 44 3e 22 29 20 28 73 3a ()) "</TD>") (s:
15b0: 74 64 20 27 28 29 29 29 0a 3b 3b 20 28 74 65 73 td '())).;; (tes
15c0: 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 t "twiki:get-tid
15d0: 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 22 20 27 dlers-by-name" '
15e0: 28 29 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 () (twiki:get-ti
15f0: 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 20 31 ddlers-by-name 1
1600: 20 22 66 72 65 64 22 29 29 0a 28 74 65 73 74 20 "fred")).(test
1610: 22 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 6e "twiki:tiddler-n
1620: 61 6d 65 2d 3e 69 64 22 20 31 20 28 74 77 69 6b ame->id" 1 (twik
1630: 69 3a 74 69 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e i:tiddler-name->
1640: 69 64 20 2a 74 64 62 2a 20 22 4d 61 69 6e 4d 65 id *tdb* "MainMe
1650: 6e 75 22 29 29 0a 28 74 65 73 74 20 22 73 3a 73 nu")).(test "s:s
1660: 65 74 21 20 61 20 76 61 72 20 74 6f 20 23 66 22 et! a var to #f"
1670: 20 20 20 20 20 22 22 0a 20 20 20 20 20 20 28 62 "". (b
1680: 65 67 69 6e 20 28 73 3a 73 65 74 21 20 22 42 4c egin (s:set! "BL
1690: 41 48 22 20 23 66 29 0a 09 20 20 20 20 20 28 73 AH" #f).. (s
16a0: 3a 67 65 74 20 22 42 4c 41 48 22 29 29 29 20 3b :get "BLAH"))) ;
16b0: 3b 20 64 6f 6e 27 74 20 6b 6e 6f 77 20 69 66 20 ; don't know if
16c0: 74 68 69 73 20 6f 6e 65 20 6d 61 6b 65 73 20 73 this one makes s
16d0: 65 6e 73 65 2e 20 53 65 74 74 69 6e 67 20 74 6f ense. Setting to
16e0: 20 23 66 20 73 68 6f 75 6c 64 20 72 65 61 6c 6c #f should reall
16f0: 79 20 64 65 6c 65 74 65 20 74 68 65 20 76 61 6c y delete the val
1700: 75 65 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a ue.(test "twiki:
1710: 73 61 76 65 2d 64 61 74 22 20 20 20 20 20 20 20 save-dat"
1720: 20 20 20 20 32 20 20 20 20 20 20 20 20 28 74 77 2 (tw
1730: 69 6b 69 3a 73 61 76 65 2d 64 61 74 20 2a 74 64 iki:save-dat *td
1740: 62 2a 20 22 64 61 74 22 20 30 29 29 0a 28 74 65 b* "dat" 0)).(te
1750: 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 st "twiki:get-da
1760: 74 22 20 20 20 20 20 20 20 20 20 20 20 20 22 64 t" "d
1770: 61 74 22 20 20 20 20 28 74 77 69 6b 69 3a 67 65 at" (twiki:ge
1780: 74 2d 64 61 74 20 2a 74 64 62 2a 20 32 29 29 0a t-dat *tdb* 2)).
1790: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 (test "twiki:get
17a0: 2d 64 61 74 22 20 20 20 20 20 20 20 20 20 20 20 -dat"
17b0: 20 23 66 20 20 20 20 20 20 20 28 74 77 69 6b 69 #f (twiki
17c0: 3a 67 65 74 2d 64 61 74 20 2a 74 64 62 2a 20 35 :get-dat *tdb* 5
17d0: 29 29 0a 3b 3b 20 28 74 65 73 74 20 22 74 77 69 )).;; (test "twi
17e0: 6b 69 3a 67 65 74 2d 64 61 74 22 20 20 20 20 20 ki:get-dat"
17f0: 20 23 66 20 20 20 20 28 74 77 69 6b 69 3a 67 65 #f (twiki:ge
1800: 74 2d 64 61 74 20 2a 74 64 62 2a 20 23 66 29 29 t-dat *tdb* #f))
1810: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 .(test "twiki:sa
1820: 76 65 2d 74 69 64 64 6c 65 72 22 20 20 20 20 20 ve-tiddler"
1830: 20 20 23 74 20 20 20 20 20 20 20 28 74 77 69 6b #t (twik
1840: 69 3a 73 61 76 65 2d 74 69 64 64 6c 65 72 20 2a i:save-tiddler *
1850: 74 64 62 2a 20 22 68 65 61 64 69 6e 67 22 20 22 tdb* "heading" "
1860: 62 6f 64 79 22 20 22 74 61 67 73 22 20 6b 65 79 body" "tags" key
1870: 20 30 29 29 0a 3b 3b 20 28 74 65 73 74 20 22 74 0)).;; (test "t
1880: 77 69 6b 69 3a 73 61 76 65 2d 63 75 72 72 2d 74 wiki:save-curr-t
1890: 69 64 64 6c 65 72 22 20 20 23 66 20 20 20 20 20 iddler" #f
18a0: 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 63 75 (twiki:save-cu
18b0: 72 72 2d 74 69 64 64 6c 65 72 20 2a 74 64 62 2a rr-tiddler *tdb*
18c0: 20 31 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 1)).(test "twik
18d0: 69 3a 65 64 69 74 2d 74 77 69 64 64 6c 65 72 22 i:edit-twiddler"
18e0: 20 20 20 20 20 20 23 74 20 20 20 20 20 20 20 28 #t (
18f0: 6c 69 73 74 3f 20 28 74 77 69 6b 69 3a 65 64 69 list? (twiki:edi
1900: 74 2d 74 69 64 64 6c 65 72 20 2a 74 64 62 2a 20 t-tiddler *tdb*
1910: 6b 65 79 20 30 20 30 29 29 29 0a 28 74 65 73 74 key 0 0))).(test
1920: 20 22 74 77 69 6b 69 3a 6d 61 69 6e 74 5f 61 72 "twiki:maint_ar
1930: 65 61 22 20 20 20 20 20 20 20 20 20 22 3c 44 49 ea" "<DI
1940: 56 3e 22 20 20 28 63 61 72 20 28 74 77 69 6b 69 V>" (car (twiki
1950: 3a 6d 61 69 6e 74 5f 61 72 65 61 20 2a 74 64 62 :maint_area *tdb
1960: 2a 20 31 20 6b 65 79 20 77 69 6b 69 29 29 29 0a * 1 key wiki))).
1970: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 70 69 63 (test "twiki:pic
1980: 5f 6d 67 6d 74 22 20 20 20 20 20 20 20 20 20 20 _mgmt"
1990: 20 22 3c 44 49 56 3e 22 20 20 28 63 61 72 20 28 "<DIV>" (car (
19a0: 74 77 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 20 2a twiki:pic_mgmt *
19b0: 74 64 62 2a 20 31 20 6b 65 79 29 29 29 0a 0a 3b tdb* 1 key)))..;
19c0: 3b 20 67 65 74 20 61 20 62 6c 6f 62 20 6a 70 67 ; get a blob jpg
19d0: 20 74 6f 20 70 72 6f 63 65 73 73 0a 28 64 65 66 to process.(def
19e0: 69 6e 65 20 69 6e 70 32 20 28 6f 70 65 6e 2d 69 ine inp2 (open-i
19f0: 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 nput-file "tests
1a00: 2f 6b 69 61 74 6f 61 2e 70 6e 67 22 29 29 0a 28 /kiatoa.png")).(
1a10: 64 65 66 69 6e 65 20 64 61 74 20 20 28 73 74 72 define dat (str
1a20: 69 6e 67 2d 3e 62 6c 6f 62 20 28 72 65 61 64 2d ing->blob (read-
1a30: 73 74 72 69 6e 67 20 23 66 20 69 6e 70 32 29 29 string #f inp2))
1a40: 29 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 ).(close-input-p
1a50: 6f 72 74 20 69 6e 70 32 29 0a 0a 0a 28 74 65 73 ort inp2)...(tes
1a60: 74 20 22 74 77 69 6b 69 3a 73 61 76 65 2d 70 69 t "twiki:save-pi
1a70: 63 22 20 20 20 20 20 20 20 20 20 20 20 23 74 20 c" #t
1a80: 20 20 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 (twiki:sav
1a90: 65 2d 70 69 63 20 2a 74 64 62 2a 20 28 6c 69 73 e-pic *tdb* (lis
1aa0: 74 20 22 6d 79 70 69 63 2e 6a 70 67 22 20 22 69 t "mypic.jpg" "i
1ab0: 6d 61 67 65 2f 6a 70 65 67 22 20 64 61 74 29 20 mage/jpeg" dat)
1ac0: 30 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 3e 0)) ;; (string->
1ad0: 62 6c 6f 62 20 22 74 65 73 74 69 6e 67 20 65 68 blob "testing eh
1ae0: 21 22 29 29 29 29 20 0a 3b 3b 20 28 74 65 73 74 !")))) .;; (test
1af0: 20 22 74 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 "twiki:save-pic
1b00: 2d 66 72 6f 6d 2d 66 6f 72 6d 22 20 23 66 20 20 -from-form" #f
1b10: 20 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 (twiki:save
1b20: 2d 70 69 63 2d 66 72 6f 6d 2d 66 6f 72 6d 20 2a -pic-from-form *
1b30: 74 64 62 2a 20 31 29 29 0a 0a 3b 3b 20 6d 6f 72 tdb* 1))..;; mor
1b40: 65 20 74 65 73 74 73 20 6f 6e 20 64 61 74 73 0a e tests on dats.
1b50: 0a 28 64 65 66 69 6e 65 20 64 61 74 20 23 66 29 .(define dat #f)
1b60: 0a 28 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 65 .(let ((inp (ope
1b70: 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 n-input-file "te
1b80: 73 74 73 2f 6b 69 61 74 6f 61 2e 70 6e 67 22 29 sts/kiatoa.png")
1b90: 29 29 0a 20 20 28 73 65 74 21 20 64 61 74 20 28 )). (set! dat (
1ba0: 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 69 read-string #f i
1bb0: 6e 70 29 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e np)). (close-in
1bc0: 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 29 0a 28 put-port inp)).(
1bd0: 75 73 65 20 6d 64 35 29 0a 28 64 65 66 69 6e 65 use md5).(define
1be0: 20 64 61 74 2d 6d 64 35 20 28 6d 64 35 3a 64 69 dat-md5 (md5:di
1bf0: 67 65 73 74 20 64 61 74 29 29 0a 28 74 65 73 74 gest dat)).(test
1c00: 20 22 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 "twiki:save-dat
1c10: 20 28 62 69 6e 61 72 79 29 22 20 34 20 20 20 20 (binary)" 4
1c20: 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d (twiki:save-
1c30: 64 61 74 20 2a 74 64 62 2a 20 64 61 74 20 31 29 dat *tdb* dat 1)
1c40: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 ).(test "twiki:g
1c50: 65 74 2d 64 61 74 20 28 62 69 6e 61 72 79 29 22 et-dat (binary)"
1c60: 20 20 64 61 74 2d 6d 64 35 20 20 28 6c 65 74 20 dat-md5 (let
1c70: 28 28 64 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 ((d (twiki:get-d
1c80: 61 74 20 2a 74 64 62 2a 20 34 29 29 29 0a 09 09 at *tdb* 4)))...
1c90: 09 09 09 20 20 20 28 6d 64 35 3a 64 69 67 65 73 ... (md5:diges
1ca0: 74 20 64 29 29 29 0a 3b 3b 20 66 6f 72 6d 73 0a t d))).;; forms.
1cb0: 3b 3b 20 28 64 65 66 69 6e 65 20 69 6e 70 20 28 ;; (define inp (
1cc0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 open-input-file
1cd0: 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 "tests/example.p
1ce0: 6f 73 74 2e 69 6e 22 29 29 0a 3b 3b 20 28 64 65 ost.in")).;; (de
1cf0: 66 69 6e 65 20 64 61 74 20 28 72 65 61 64 2d 73 fine dat (read-s
1d00: 74 72 69 6e 67 20 23 66 20 69 6e 70 29 29 0a 3b tring #f inp)).;
1d10: 3b 20 28 64 65 66 69 6e 65 20 64 61 74 73 74 72 ; (define datstr
1d20: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 (open-input-str
1d30: 69 6e 67 20 64 61 74 29 29 0a 0a 3b 3b 20 62 69 ing dat))..;; bi
1d40: 6e 61 72 79 20 69 6e 70 75 74 73 0a 28 64 65 66 nary inputs.(def
1d50: 69 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e ine inp (open-in
1d60: 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f put-file "tests/
1d70: 65 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 62 69 6e example.post.bin
1d80: 61 72 79 2e 69 6e 22 29 29 0a 28 64 65 66 69 6e ary.in")).(defin
1d90: 65 20 64 61 74 20 23 66 29 0a 0a 28 74 65 73 74 e dat #f)..(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 6d 75 6c 74 69 70 61 72 ll-port multipar
1dc0: 74 22 20 23 74 20 28 6c 65 74 20 28 28 69 64 61 t" #t (let ((ida
1dd0: 74 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d t (formdat:load-
1de0: 61 6c 6c 2d 70 6f 72 74 20 69 6e 70 29 29 29 0a all-port inp))).
1df0: 09 09 09 09 20 20 20 28 73 65 74 21 20 64 61 74 .... (set! dat
1e00: 20 69 64 61 74 29 0a 09 09 09 09 20 20 20 23 74 idat)..... #t
1e10: 29 29 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 )).(test "formda
1e20: 74 3a 6b 65 79 73 22 20 27 28 70 69 63 74 75 72 t:keys" '(pictur
1e30: 65 2d 6e 61 6d 65 20 69 6e 70 75 74 2d 70 69 63 e-name input-pic
1e40: 74 75 72 65 20 22 22 20 73 75 62 6d 69 74 2d 70 ture "" submit-p
1e50: 69 63 74 75 72 65 29 20 28 66 6f 72 6d 64 61 74 icture) (formdat
1e60: 3a 6b 65 79 73 20 64 61 74 29 29 0a 0a 28 64 65 :keys dat))..(de
1e70: 66 69 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 fine inp (open-i
1e80: 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 nput-file "tests
1e90: 2f 65 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e /example.post.in
1ea0: 22 29 29 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 ")).(test "formd
1eb0: 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 at:load-all-port
1ec0: 20 73 69 6e 67 6c 65 20 70 61 72 74 22 20 23 74 single part" #t
1ed0: 20 28 6c 65 74 20 28 28 69 64 61 74 20 28 66 6f (let ((idat (fo
1ee0: 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 rmdat:load-all-p
1ef0: 6f 72 74 20 69 6e 70 29 29 29 0a 09 09 09 09 20 ort inp))).....
1f00: 20 20 28 73 65 74 21 20 64 61 74 20 69 64 61 74 (set! dat idat
1f10: 29 0a 09 09 09 09 20 20 20 23 74 29 29 0a 28 74 )..... #t)).(t
1f20: 65 73 74 20 22 66 6f 72 6d 64 61 74 3a 6b 65 79 est "formdat:key
1f30: 73 22 20 27 28 65 6d 61 69 6c 2d 61 64 64 72 65 s" '(email-addre
1f40: 73 73 20 66 6f 72 6d 2d 6e 61 6d 65 20 70 61 73 ss form-name pas
1f50: 73 77 6f 72 64 29 20 28 66 6f 72 6d 64 61 74 3a sword) (formdat:
1f60: 6b 65 79 73 20 64 61 74 29 29 0a 0a 28 63 6c 6f keys dat))..(clo
1f70: 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e se-input-port in
1f80: 70 29 0a p).