Artifact
0840de6e92b698e758b1d92fa348405316b129d4:
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 28 72 65 71 75 69 72 65 2d 6c 69 62 72 5).(require-libr
0180: 61 72 79 20 64 62 69 29 0a 0a 28 6c 6f 61 64 20 ary dbi)..(load
0190: 22 2e 2f 72 65 71 75 69 72 65 6d 65 6e 74 73 2e "./requirements.
01a0: 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 6d scm").(load "./m
01b0: 69 73 63 2d 73 74 6d 6c 2e 73 63 6d 22 29 0a 28 isc-stml.scm").(
01c0: 6c 6f 61 64 20 22 2e 2f 66 6f 72 6d 64 61 74 2e load "./formdat.
01d0: 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 73 scm").(load "./s
01e0: 74 6d 6c 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 tml.scm").(load
01f0: 22 2e 2f 73 65 73 73 69 6f 6e 2e 73 63 6d 22 29 "./session.scm")
0200: 0a 28 6c 6f 61 64 20 22 2e 2f 73 71 6c 74 62 6c .(load "./sqltbl
0210: 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f .scm").(load "./
0220: 68 74 6d 6c 2d 66 69 6c 74 65 72 2e 73 63 6d 22 html-filter.scm"
0230: 29 0a 28 6c 6f 61 64 20 22 2e 2f 6b 65 79 73 74 ).(load "./keyst
0240: 6f 72 65 2e 73 63 6d 22 29 0a 0a 3b 3b 20 54 65 ore.scm")..;; Te
0250: 73 74 20 74 68 65 20 70 72 69 6d 69 74 69 76 65 st the primitive
0260: 20 64 62 69 20 69 6e 74 65 72 66 61 63 65 0a 0a dbi interface..
0270: 28 73 79 73 74 65 6d 20 22 72 6d 20 2d 66 20 74 (system "rm -f t
0280: 65 73 74 73 2f 74 65 73 74 2e 64 62 22 29 0a 28 ests/test.db").(
0290: 64 65 66 69 6e 65 20 64 62 20 28 64 62 69 3a 6f define db (dbi:o
02a0: 70 65 6e 20 27 73 71 6c 69 74 65 33 20 27 28 28 pen 'sqlite3 '((
02b0: 64 62 6e 61 6d 65 20 2e 20 22 74 65 73 74 73 2f dbname . "tests/
02c0: 74 65 73 74 2e 64 62 22 29 29 29 29 0a 28 64 62 test.db")))).(db
02d0: 69 3a 65 78 65 63 20 64 62 20 22 43 52 45 41 54 i:exec db "CREAT
02e0: 45 20 54 41 42 4c 45 20 66 6f 6f 28 69 64 20 49 E TABLE foo(id I
02f0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
0300: 45 59 2c 6e 61 6d 65 20 54 45 58 54 29 3b 22 29 EY,name TEXT);")
0310: 0a 28 64 62 69 3a 65 78 65 63 20 64 62 20 22 49 .(dbi:exec db "I
0320: 4e 53 45 52 54 20 49 4e 54 4f 20 66 6f 6f 28 6e NSERT INTO foo(n
0330: 61 6d 65 29 20 56 41 4c 55 45 53 28 3f 29 3b 22 ame) VALUES(?);"
0340: 20 22 4d 61 74 74 22 29 0a 28 64 62 69 3a 66 6f "Matt").(dbi:fo
0350: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 28 6c 61 r-each-row . (la
0360: 6d 62 64 61 20 28 74 75 70 6c 65 29 0a 20 20 20 mbda (tuple).
0370: 28 70 72 69 6e 74 20 28 76 65 63 74 6f 72 2d 72 (print (vector-r
0380: 65 66 20 74 75 70 6c 65 20 30 29 20 22 20 22 20 ef tuple 0) " "
0390: 28 76 65 63 74 6f 72 2d 72 65 66 20 74 75 70 6c (vector-ref tupl
03a0: 65 20 31 29 29 29 0a 20 64 62 20 22 53 45 4c 45 e 1))). db "SELE
03b0: 43 54 20 2a 20 46 52 4f 4d 20 66 6f 6f 3b 22 29 CT * FROM foo;")
03c0: 0a 28 74 65 73 74 20 22 64 62 69 3a 67 65 74 2d .(test "dbi:get-
03d0: 6f 6e 65 22 20 22 4d 61 74 74 22 20 28 64 62 69 one" "Matt" (dbi
03e0: 3a 67 65 74 2d 6f 6e 65 20 64 62 20 22 53 45 4c :get-one db "SEL
03f0: 45 43 54 20 6e 61 6d 65 20 46 52 4f 4d 20 66 6f ECT name FROM fo
0400: 6f 20 57 48 45 52 45 20 6e 61 6d 65 3d 27 4d 61 o WHERE name='Ma
0410: 74 74 27 3b 22 29 29 0a 0a 3b 3b 20 6b 65 79 73 tt';"))..;; keys
0420: 74 6f 72 65 0a 28 64 62 69 3a 65 78 65 63 20 64 tore.(dbi:exec d
0430: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 b "CREATE TABLE
0440: 6d 65 74 61 64 61 74 61 20 28 69 64 20 49 4e 54 metadata (id INT
0450: 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 EGER PRIMARY KEY
0460: 2c 6b 65 79 20 54 45 58 54 2c 76 61 6c 75 65 20 ,key TEXT,value
0470: 54 45 58 54 29 3b 22 29 0a 0a 28 6b 65 79 73 74 TEXT);")..(keyst
0480: 6f 72 65 3a 73 65 74 21 20 64 62 20 22 53 43 48 ore:set! db "SCH
0490: 45 4d 41 2d 56 45 52 53 49 4f 4e 22 20 31 2e 32 EMA-VERSION" 1.2
04a0: 29 0a 28 74 65 73 74 20 22 4b 65 79 73 74 6f 72 ).(test "Keystor
04b0: 65 20 67 65 74 22 20 22 31 2e 32 22 20 20 28 6b e get" "1.2" (k
04c0: 65 79 73 74 6f 72 65 3a 67 65 74 20 20 64 62 20 eystore:get db
04d0: 22 53 43 48 45 4d 41 2d 56 45 52 53 49 4f 4e 22 "SCHEMA-VERSION"
04e0: 29 29 0a 28 6b 65 79 73 74 6f 72 65 3a 64 65 6c )).(keystore:del
04f0: 21 20 64 62 20 22 53 43 48 45 4d 41 2d 56 45 52 ! db "SCHEMA-VER
0500: 53 49 4f 4e 22 29 20 0a 28 74 65 73 74 20 22 4b SION") .(test "K
0510: 65 79 73 74 6f 72 65 20 67 65 74 20 64 65 6c 65 eystore get dele
0520: 74 65 64 22 20 23 66 20 28 6b 65 79 73 74 6f 72 ted" #f (keystor
0530: 65 3a 67 65 74 20 64 62 20 22 53 43 48 45 4d 41 e:get db "SCHEMA
0540: 2d 56 45 52 53 49 4f 4e 22 29 29 0a 0a 28 73 79 -VERSION"))..(sy
0550: 73 74 65 6d 20 22 72 6d 20 2d 66 20 74 65 73 74 stem "rm -f test
0560: 73 2f 74 65 73 74 2e 64 62 22 29 0a 0a 3b 3b 20 s/test.db")..;;
0570: 63 72 65 61 74 65 20 61 20 73 65 73 73 69 6f 6e create a session
0580: 20 74 6f 20 77 6f 72 6b 20 77 69 74 68 22 29 0a to work with").
0590: 28 73 65 74 65 6e 76 20 22 52 45 51 55 45 53 54 (setenv "REQUEST
05a0: 5f 55 52 49 22 20 22 2f 73 74 6d 6c 72 75 6e 3f _URI" "/stmlrun?
05b0: 61 63 74 69 6f 6e 3d 74 65 73 74 2e 74 65 73 74 action=test.test
05c0: 22 29 0a 28 73 65 74 65 6e 76 20 22 53 43 52 49 ").(setenv "SCRI
05d0: 50 54 5f 4e 41 4d 45 22 20 22 2f 63 67 69 2d 62 PT_NAME" "/cgi-b
05e0: 69 6e 2f 73 74 6d 6c 72 75 6e 22 29 0a 28 73 65 in/stmlrun").(se
05f0: 74 65 6e 76 20 22 50 41 54 48 5f 49 4e 46 4f 22 tenv "PATH_INFO"
0600: 20 22 2f 74 65 73 74 22 29 0a 28 73 65 74 65 6e "/test").(seten
0610: 76 20 22 51 55 45 52 59 5f 53 54 52 49 4e 47 22 v "QUERY_STRING"
0620: 20 22 61 63 74 69 6f 6e 3d 74 65 73 74 2e 74 65 "action=test.te
0630: 73 74 22 29 0a 28 73 65 74 65 6e 76 20 22 53 45 st").(setenv "SE
0640: 52 56 45 52 5f 4e 41 4d 45 22 20 22 6c 6f 63 61 RVER_NAME" "loca
0650: 6c 68 6f 73 74 22 29 0a 28 73 65 74 65 6e 76 20 lhost").(setenv
0660: 22 52 45 51 55 45 53 54 5f 4d 45 54 48 4f 44 22 "REQUEST_METHOD"
0670: 20 22 47 45 54 22 29 0a 0a 28 6c 6f 61 64 20 22 "GET")..(load "
0680: 2e 2f 73 65 74 75 70 2e 73 63 6d 22 29 0a 0a 28 ./setup.scm")..(
0690: 73 3a 76 61 6c 69 64 61 74 65 2d 69 6e 70 75 74 s:validate-input
06a0: 73 29 0a 0a 3b 3b 20 74 65 73 74 20 73 65 73 73 s)..;; test sess
06b0: 69 6f 6e 20 76 61 72 69 61 62 6c 65 73 0a 0a 28 ion variables..(
06c0: 73 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 72 73 session:get-vars
06d0: 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 64 65 66 s:session).(def
06e0: 69 6e 65 20 6e 61 64 61 20 22 61 6e 64 6e 6e 64 ine nada "andnnd
06f0: 68 68 73 68 61 61 73 22 29 0a 28 73 3a 73 65 73 hhshaas").(s:ses
0700: 73 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 22 6e sion-var-set! "n
0710: 69 63 6b 22 20 6e 61 64 61 29 0a 28 74 65 73 74 ick" nada).(test
0720: 20 22 53 65 73 73 69 6f 6e 20 76 61 72 20 73 65 "Session var se
0730: 74 2f 67 65 74 22 20 6e 61 64 61 20 20 28 73 3a t/get" nada (s:
0740: 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 session-var-get
0750: 22 6e 69 63 6b 22 29 29 0a 28 70 72 69 6e 74 20 "nick")).(print
0760: 22 67 6f 74 20 68 65 72 65 22 29 0a 28 73 65 73 "got here").(ses
0770: 73 69 6f 6e 3a 73 61 76 65 2d 76 61 72 73 20 73 sion:save-vars s
0780: 3a 73 65 73 73 69 6f 6e 29 0a 28 73 65 73 73 69 :session).(sessi
0790: 6f 6e 3a 67 65 74 2d 76 61 72 73 20 20 73 3a 73 on:get-vars s:s
07a0: 65 73 73 69 6f 6e 29 0a 28 74 65 73 74 20 22 53 ession).(test "S
07b0: 65 73 73 69 6f 6e 20 76 61 72 20 73 65 74 2f 67 ession var set/g
07c0: 65 74 20 61 66 74 65 72 20 73 61 76 65 2f 67 65 et after save/ge
07d0: 74 22 20 6e 61 64 61 20 28 73 3a 73 65 73 73 69 t" nada (s:sessi
07e0: 6f 6e 2d 76 61 72 2d 67 65 74 20 22 6e 69 63 6b on-var-get "nick
07f0: 22 29 29 0a 28 73 65 73 73 69 6f 6e 3a 64 65 6c ")).(session:del
0800: 21 20 73 3a 73 65 73 73 69 6f 6e 20 22 2a 73 65 ! s:session "*se
0810: 73 73 69 6f 6e 76 61 72 73 2a 22 20 22 6e 69 63 ssionvars*" "nic
0820: 6b 22 29 0a 28 74 65 73 74 20 22 53 65 73 73 69 k").(test "Sessi
0830: 6f 6e 20 76 61 72 20 64 65 6c 22 20 20 20 20 20 on var del"
0840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
0850: 66 20 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d 76 f (s:session-v
0860: 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 0a ar-get "nick")).
0870: 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 2d 76 61 (session:save-va
0880: 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 73 rs s:session).(s
0890: 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 72 73 20 ession:get-vars
08a0: 73 3a 73 65 73 73 69 6f 6e 29 0a 28 73 3a 73 65 s:session).(s:se
08b0: 73 73 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 22 ssion-var-set! "
08c0: 6e 69 63 6b 22 20 6e 61 64 61 29 0a 28 73 65 73 nick" nada).(ses
08d0: 73 69 6f 6e 3a 73 61 76 65 2d 76 61 72 73 20 73 sion:save-vars s
08e0: 3a 73 65 73 73 69 6f 6e 29 0a 0a 3b 3b 20 28 74 :session)..;; (t
08f0: 65 73 74 20 22 53 65 73 73 69 6f 6e 20 76 61 72 est "Session var
0900: 20 64 65 6c 22 20 20 20 20 20 20 20 20 20 20 20 del"
0910: 20 20 20 20 20 20 20 20 20 23 66 20 20 20 28 73 #f (s
0920: 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 :session-var-get
0930: 20 22 6e 69 63 6b 22 29 29 0a 0a 3b 3b 20 74 65 "nick"))..;; te
0940: 73 74 20 70 65 72 73 6f 6e 0a 0a 28 6c 6f 61 64 st person..(load
0950: 20 22 2e 2f 74 65 73 74 73 2f 6d 6f 64 65 6c 73 "./tests/models
0960: 2f 74 65 73 74 2e 73 63 6d 22 29 0a 0a 28 70 72 /test.scm")..(pr
0970: 69 6e 74 20 22 53 65 73 73 69 6f 6e 20 6b 65 79 int "Session key
0980: 20 69 73 20 22 20 28 73 6c 6f 74 2d 72 65 66 20 is " (slot-ref
0990: 73 3a 73 65 73 73 69 6f 6e 20 27 73 65 73 73 69 s:session 'sessi
09a0: 6f 6e 2d 6b 65 79 29 29 0a 0a 28 74 65 73 74 20 on-key))..(test
09b0: 22 44 65 6c 65 74 65 20 73 65 73 73 69 6f 6e 22 "Delete session"
09c0: 20 23 74 20 28 73 3a 64 65 6c 65 74 65 2d 73 65 #t (s:delete-se
09d0: 73 73 69 6f 6e 29 29 0a 0a 28 6c 65 74 20 28 28 ssion))..(let ((
09e0: 66 68 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 70 fh (open-input-p
09f0: 69 70 65 20 22 6c 73 20 2e 2f 74 65 73 74 73 2f ipe "ls ./tests/
0a00: 70 61 67 65 73 2f 2a 2f 63 6f 6e 74 72 6f 6c 2e pages/*/control.
0a10: 73 63 6d 22 29 29 29 0a 20 20 28 6c 65 74 20 6c scm"))). (let l
0a20: 6f 6f 70 20 28 28 6c 20 28 72 65 61 64 2d 6c 69 oop ((l (read-li
0a30: 6e 65 20 66 68 29 29 29 0a 20 20 20 20 28 69 66 ne fh))). (if
0a40: 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 (not (eof-objec
0a50: 74 3f 20 6c 29 29 0a 20 20 20 20 20 20 20 20 28 t? l)). (
0a60: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
0a70: 3b 3b 20 28 70 72 69 6e 74 20 22 6c 6f 61 64 69 ;; (print "loadi
0a80: 6e 67 20 22 20 6c 29 0a 20 20 20 20 20 20 20 20 ng " l).
0a90: 20 20 28 6c 6f 61 64 20 6c 29 0a 20 20 20 20 20 (load l).
0aa0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read
0ab0: 2d 6c 69 6e 65 20 66 68 29 29 29 29 29 0a 20 20 -line fh))))).
0ac0: 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 (close-input-por
0ad0: 74 20 66 68 29 29 0a 0a 3b 3b 20 53 68 6f 75 6c t fh))..;; Shoul
0ae0: 64 20 68 61 76 65 20 70 6f 6c 6c 3a 70 6f 6c 6c d have poll:poll
0af0: 20 64 65 66 69 6e 65 64 20 6e 6f 77 2e 0a 28 74 defined now..(t
0b00: 65 73 74 20 22 4d 61 6b 65 20 61 20 72 61 6e 64 est "Make a rand
0b10: 6f 6d 20 73 74 72 69 6e 67 22 20 32 20 28 73 74 om string" 2 (st
0b20: 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 73 65 73 ring-length (ses
0b30: 73 69 6f 6e 3a 6d 61 6b 65 2d 72 61 6e 64 2d 73 sion:make-rand-s
0b40: 74 72 69 6e 67 20 32 29 29 29 0a 28 74 65 73 74 tring 2))).(test
0b50: 20 22 43 72 65 61 74 65 20 61 20 65 6e 63 72 79 "Create a encry
0b60: 70 74 65 64 20 70 61 73 73 77 6f 72 64 22 20 22 pted password" "
0b70: 61 62 51 39 4b 59 2e 4b 66 72 59 72 63 22 20 28 abQ9KY.KfrYrc" (
0b80: 73 3a 63 72 79 70 74 2d 70 61 73 73 77 64 20 22 s:crypt-passwd "
0b90: 66 6f 6f 22 20 22 61 62 22 29 29 0a 0a 28 74 65 foo" "ab"))..(te
0ba0: 73 74 20 22 73 3a 61 6e 79 2d 3e 73 74 72 69 6e st "s:any->strin
0bb0: 67 20 6f 6e 20 61 20 68 61 73 68 2d 74 61 62 6c g on a hash-tabl
0bc0: 65 22 20 22 23 3c 68 61 73 68 2d 74 61 62 6c 65 e" "#<hash-table
0bd0: 3e 22 20 28 73 3a 61 6e 79 2d 3e 73 74 72 69 6e >" (s:any->strin
0be0: 67 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 g (make-hash-tab
0bf0: 6c 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 le)))..(define s
0c00: 65 6c 65 63 74 2d 6c 69 73 74 0a 20 20 27 28 28 elect-list. '((
0c10: 61 20 62 20 63 29 28 64 20 28 65 20 66 20 67 29 a b c)(d (e f g)
0c20: 28 68 20 69 20 6a 20 23 74 29 29 29 29 0a 28 64 (h i j #t)))).(d
0c30: 65 66 69 6e 65 20 72 65 73 75 6c 74 20 27 28 22 efine result '("
0c40: 3c 53 45 4c 45 43 54 20 6e 61 6d 65 3d 5c 22 65 <SELECT name=\"e
0c50: 66 67 5c 22 3e 22 20 0a 09 09 20 28 28 28 22 3c fg\">" ... ((("<
0c60: 4f 50 54 49 4f 4e 20 6c 61 62 65 6c 3d 5c 22 61 OPTION label=\"a
0c70: 5c 22 20 76 61 6c 75 65 3d 5c 22 62 5c 22 3e 63 \" value=\"b\">c
0c80: 3c 2f 4f 50 54 49 4f 4e 3e 22 29 20 0a 09 09 20 </OPTION>") ...
0c90: 20 20 28 22 3c 4f 50 54 47 52 4f 55 50 20 6c 61 ("<OPTGROUP la
0ca0: 62 65 6c 3d 64 22 20 0a 09 09 20 20 20 20 28 22 bel=d" ... ("
0cb0: 3c 4f 50 54 49 4f 4e 20 6c 61 62 65 6c 3d 5c 22 <OPTION label=\"
0cc0: 65 5c 22 20 76 61 6c 75 65 3d 5c 22 66 5c 22 3e e\" value=\"f\">
0cd0: 67 3c 2f 4f 50 54 49 4f 4e 3e 22 29 0a 09 09 20 g</OPTION>")...
0ce0: 20 20 20 28 22 3c 4f 50 54 49 4f 4e 20 20 73 65 ("<OPTION se
0cf0: 6c 65 63 74 65 64 20 6c 61 62 65 6c 3d 5c 22 68 lected label=\"h
0d00: 5c 22 20 76 61 6c 75 65 3d 5c 22 69 5c 22 3e 6a \" value=\"i\">j
0d10: 3c 2f 4f 50 54 49 4f 4e 3e 22 29 20 0a 09 09 20 </OPTION>") ...
0d20: 20 20 20 22 3c 2f 4f 50 54 47 52 4f 55 50 3e 22 "</OPTGROUP>"
0d30: 29 29 29 0a 09 09 20 22 3c 2f 53 45 4c 45 43 54 )))... "</SELECT
0d40: 3e 22 29 29 0a 0a 28 74 65 73 74 20 22 53 65 6c >"))..(test "Sel
0d50: 65 63 74 20 6c 69 73 74 22 20 72 65 73 75 6c 74 ect list" result
0d60: 20 28 73 3a 73 65 6c 65 63 74 20 73 65 6c 65 63 (s:select selec
0d70: 74 2d 6c 69 73 74 20 27 6e 61 6d 65 20 22 65 66 t-list 'name "ef
0d80: 67 22 29 29 0a 0a 3b 3b 20 54 65 73 74 20 6d 6f g"))..;; Test mo
0d90: 64 75 6c 65 73 0a 0a 28 74 65 73 74 20 22 6d 69 dules..(test "mi
0da0: 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 sc:non-zero-stri
0db0: 6e 67 20 5c 22 5c 22 22 20 23 66 20 28 6d 69 73 ng \"\"" #f (mis
0dc0: 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e c:non-zero-strin
0dd0: 67 20 22 22 29 29 0a 28 74 65 73 74 20 22 6d 69 g "")).(test "mi
0de0: 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 sc:non-zero-stri
0df0: 6e 67 20 23 66 22 20 23 66 20 28 6d 69 73 63 3a ng #f" #f (misc:
0e00: 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 non-zero-string
0e10: 23 66 29 29 0a 28 74 65 73 74 20 22 6d 69 73 63 #f)).(test "misc
0e20: 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 :non-zero-string
0e30: 20 27 62 6c 61 68 22 20 23 66 20 28 6d 69 73 63 'blah" #f (misc
0e40: 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 :non-zero-string
0e50: 20 27 62 6c 61 68 29 29 0a 0a 3b 3b 20 66 6f 72 'blah))..;; for
0e60: 6d 73 0a 28 64 65 66 69 6e 65 20 66 6f 72 6d 20 ms.(define form
0e70: 23 66 29 0a 28 74 65 73 74 20 22 6d 61 6b 65 20 #f).(test "make
0e80: 3c 66 6f 72 6d 64 61 74 3e 22 20 23 74 20 28 6c <formdat>" #t (l
0e90: 65 74 20 28 28 66 20 28 6d 61 6b 65 2d 66 6f 72 et ((f (make-for
0ea0: 6d 64 61 74 3a 66 6f 72 6d 64 61 74 29 29 29 0a mdat:formdat))).
0eb0: 09 09 09 20 20 20 20 28 73 65 74 21 20 66 6f 72 ... (set! for
0ec0: 6d 20 66 29 0a 09 09 09 20 20 20 20 23 74 29 29 m f).... #t))
0ed0: 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 3a .(test "formdat:
0ee0: 20 73 65 74 21 2f 67 65 74 22 20 22 59 65 70 21 set!/get" "Yep!
0ef0: 22 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 " (begin.....
0f00: 28 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 66 6f (formdat:set! fo
0f10: 72 6d 20 22 62 6c 61 68 22 20 22 59 65 70 21 22 rm "blah" "Yep!"
0f20: 29 0a 09 09 09 09 20 20 20 28 66 6f 72 6d 64 61 )..... (formda
0f30: 74 3a 67 65 74 20 20 66 6f 72 6d 20 22 62 6c 61 t:get form "bla
0f40: 68 22 29 29 29 0a 0a 28 74 65 73 74 20 22 73 3a h")))..(test "s:
0f50: 73 74 72 69 6e 67 2d 3e 70 67 69 6e 74 22 20 20 string->pgint"
0f60: 20 31 32 33 20 28 73 3a 61 6e 79 2d 3e 70 67 69 123 (s:any->pgi
0f70: 6e 74 20 22 31 32 33 22 29 29 0a 28 74 65 73 74 nt "123")).(test
0f80: 20 22 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e "s:illegal-pgin
0f90: 74 20 28 6c 65 67 61 6c 29 22 20 20 20 20 20 20 t (legal)"
0fa0: 20 20 23 66 20 28 73 3a 69 6c 6c 65 67 61 6c 2d #f (s:illegal-
0fb0: 70 67 69 6e 74 20 31 30 31 31 29 29 0a 28 74 65 pgint 1011)).(te
0fc0: 73 74 20 22 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 st "s:illegal-pg
0fd0: 69 6e 74 20 28 69 6c 6c 65 67 61 6c 20 62 69 67 int (illegal big
0fe0: 29 22 20 20 20 31 20 28 73 3a 69 6c 6c 65 67 61 )" 1 (s:illega
0ff0: 6c 2d 70 67 69 6e 74 20 20 39 39 39 39 39 39 39 l-pgint 9999999
1000: 39 39 39 29 29 0a 28 74 65 73 74 20 22 73 3a 69 999)).(test "s:i
1010: 6c 6c 65 67 61 6c 70 67 69 6e 74 20 28 69 6c 6c llegalpgint (ill
1020: 65 67 61 6c 20 73 6d 61 6c 6c 29 22 20 2d 31 20 egal small)" -1
1030: 28 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 (s:illegal-pgint
1040: 20 2d 39 39 39 39 39 39 39 39 39 39 29 29 0a 0a -9999999999))..
1050: 3b 3b 20 54 68 65 20 74 77 69 6b 69 20 6d 6f 64 ;; The twiki mod
1060: 75 6c 65 0a 0a 3b 3b 20 63 6c 65 61 6e 20 75 70 ule..;; clean up
1070: 0a 28 73 79 73 74 65 6d 20 22 72 6d 20 2d 72 66 .(system "rm -rf
1080: 20 74 77 69 6b 69 73 2f 2a 22 29 0a 28 6c 6f 61 twikis/*").(loa
1090: 64 20 22 6d 6f 64 75 6c 65 73 2f 74 77 69 6b 69 d "modules/twiki
10a0: 2f 74 77 69 6b 69 2d 6d 6f 64 2e 73 63 6d 22 29 /twiki-mod.scm")
10b0: 0a 28 64 65 66 69 6e 65 20 6b 65 79 73 20 28 6c .(define keys (l
10c0: 69 73 74 20 22 62 6c 61 68 22 20 31 20 27 6e 61 ist "blah" 1 'na
10d0: 64 61 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b da)).(test "twik
10e0: 69 3a 6b 65 79 73 2d 3e 6b 65 79 22 20 20 22 62 i:keys->key" "b
10f0: 6c 61 68 20 31 20 6e 61 64 61 22 20 28 74 77 69 lah 1 nada" (twi
1100: 6b 69 3a 6b 65 79 73 2d 3e 6b 65 79 20 6b 65 79 ki:keys->key key
1110: 73 29 29 0a 28 64 65 66 69 6e 65 20 6b 65 79 20 s)).(define key
1120: 28 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b 65 79 (twiki:keys->key
1130: 20 6b 65 79 73 29 29 0a 0a 28 64 65 66 69 6e 65 keys))..(define
1140: 20 2a 74 64 62 2a 20 23 66 29 0a 28 74 65 73 74 *tdb* #f).(test
1150: 20 22 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 22 "twiki:open-db"
1160: 20 20 20 23 74 20 28 6c 65 74 20 28 28 64 62 20 #t (let ((db
1170: 28 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 20 6b (twiki:open-db k
1180: 65 79 29 29 29 0a 09 09 09 20 20 20 20 20 28 73 ey))).... (s
1190: 65 74 21 20 2a 74 64 62 2a 20 64 62 29 0a 09 09 et! *tdb* db)...
11a0: 09 20 20 20 20 20 28 69 66 20 2a 74 64 62 2a 20 . (if *tdb*
11b0: 23 74 20 23 66 29 29 29 0a 28 64 65 66 69 6e 65 #t #f))).(define
11c0: 20 77 69 6b 69 20 28 6d 61 6b 65 2d 74 77 69 6b wiki (make-twik
11d0: 69 3a 77 69 6b 69 29 29 0a 28 74 77 69 6b 69 3a i:wiki)).(twiki:
11e0: 77 69 6b 69 2d 73 65 74 2d 77 69 64 21 20 77 69 wiki-set-wid! wi
11f0: 6b 69 20 31 29 0a 28 74 77 69 6b 69 3a 77 69 6b ki 1).(twiki:wik
1200: 69 2d 73 65 74 2d 6e 61 6d 65 21 20 77 69 6b 69 i-set-name! wiki
1210: 20 22 6d 61 69 6e 22 29 0a 28 74 77 69 6b 69 3a "main").(twiki:
1220: 77 69 6b 69 2d 73 65 74 2d 70 65 72 6d 73 21 20 wiki-set-perms!
1230: 77 69 6b 69 20 27 28 72 20 77 29 29 0a 0a 28 74 wiki '(r w))..(t
1240: 65 73 74 20 22 74 77 69 6b 69 3a 64 61 74 2d 3e est "twiki:dat->
1250: 68 74 6d 6c 22 20 27 28 22 48 65 6c 6c 6f 22 20 html" '("Hello"
1260: 22 3c 42 52 3e 22 29 20 28 74 77 69 6b 69 3a 64 "<BR>") (twiki:d
1270: 61 74 2d 3e 68 74 6d 6c 20 22 48 65 6c 6c 6f 22 at->html "Hello"
1280: 20 77 69 6b 69 29 29 0a 28 74 65 73 74 20 22 74 wiki)).(test "t
1290: 77 69 6b 69 3a 6b 65 79 73 2d 3e 66 6e 61 6d 65 wiki:keys->fname
12a0: 22 20 27 28 22 74 77 69 6b 69 73 2f 59 6d 78 68 " '("twikis/Ymxh
12b0: 61 2f 43 41 78 49 47 2f 35 68 5a 47 45 22 20 22 a/CAxIG/5hZGE" "
12c0: 59 6d 78 68 61 43 41 78 49 47 35 68 5a 47 45 5f YmxhaCAxIG5hZGE_
12d0: 22 29 20 3b 3b 20 28 22 74 77 69 6b 69 73 2f 64 ") ;; ("twikis/d
12e0: 39 39 61 32 64 65 39 2f 36 38 30 38 34 39 33 62 99a2de9/6808493b
12f0: 2f 32 33 37 37 30 66 37 30 22 20 22 64 39 39 61 /23770f70" "d99a
1300: 32 64 65 39 36 38 30 38 34 39 33 62 32 33 37 37 2de96808493b2377
1310: 30 66 37 30 63 37 36 64 66 66 65 34 22 29 0a 20 0f70c76dffe4").
1320: 20 20 20 20 20 28 74 77 69 6b 69 3a 6b 65 79 2d (twiki:key-
1330: 3e 66 6e 61 6d 65 20 6b 65 79 29 29 0a 0a 28 74 >fname key))..(t
1340: 65 73 74 20 22 74 77 69 6b 69 3a 6e 61 6d 65 2d est "twiki:name-
1350: 3e 77 69 64 22 20 20 20 20 20 31 20 20 20 20 20 >wid" 1
1360: 28 74 77 69 6b 69 3a 6e 61 6d 65 2d 3e 77 69 64 (twiki:name->wid
1370: 20 2a 74 64 62 2a 20 22 6d 61 69 6e 22 29 29 0a *tdb* "main")).
1380: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 (test "twiki:get
1390: 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d -tiddlers-by-num
13a0: 22 20 27 28 29 20 28 74 77 69 6b 69 3a 67 65 74 " '() (twiki:get
13b0: 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d -tiddlers-by-num
13c0: 20 20 2a 74 64 62 2a 20 30 20 28 6c 69 73 74 20 *tdb* 0 (list
13d0: 31 20 32 20 33 29 29 29 0a 28 74 65 73 74 20 22 1 2 3))).(test "
13e0: 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 twiki:get-tiddle
13f0: 72 73 2d 62 79 2d 6e 61 6d 65 22 20 27 28 29 20 rs-by-name" '()
1400: 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c (twiki:get-tiddl
1410: 65 72 73 2d 62 79 2d 6e 61 6d 65 20 2a 74 64 62 ers-by-name *tdb
1420: 2a 20 30 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 * 0 "MainMenu"))
1430: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 .(test "twiki:ge
1440: 74 2d 74 69 64 64 6c 65 72 73 22 20 20 27 28 29 t-tiddlers" '()
1450: 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 (twiki:get-tid
1460: 64 6c 65 72 73 20 2a 74 64 62 2a 20 30 20 28 6c dlers *tdb* 0 (l
1470: 69 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 ist "MainMenu"))
1480: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 ).(test "twiki:g
1490: 65 74 2d 74 69 64 64 6c 65 72 73 22 20 20 27 28 et-tiddlers" '(
14a0: 29 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 ) (twiki:get-ti
14b0: 64 64 6c 65 72 73 20 2a 74 64 62 2a 20 30 20 28 ddlers *tdb* 0 (
14c0: 6c 69 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22 20 list "MainMenu"
14d0: 22 41 6e 6f 74 68 65 72 4f 6e 65 22 29 29 29 0a "AnotherOne"))).
14e0: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 77 69 6b (test "twiki:wik
14f0: 69 22 20 22 3c 54 41 42 4c 45 3e 22 20 20 20 20 i" "<TABLE>"
1500: 20 28 63 61 72 20 28 74 77 69 6b 69 3a 77 69 6b (car (twiki:wik
1510: 69 20 22 6d 61 69 6e 22 20 28 6c 69 73 74 20 22 i "main" (list "
1520: 62 6c 61 68 22 20 31 20 27 6e 61 64 61 29 29 29 blah" 1 'nada)))
1530: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 76 ).(test "twiki:v
1540: 69 65 77 22 20 20 22 3c 44 49 56 20 63 6c 61 73 iew" "<DIV clas
1550: 73 3d 5c 22 6e 6f 64 65 5c 22 3e 22 20 28 63 61 s=\"node\">" (ca
1560: 72 20 28 74 77 69 6b 69 3a 76 69 65 77 20 22 22 r (twiki:view ""
1570: 20 22 22 20 30 20 28 74 77 69 6b 69 3a 74 69 64 "" 0 (twiki:tid
1580: 64 6c 65 72 2d 6d 61 6b 65 29 20 77 69 6b 69 29 dler-make) wiki)
1590: 29 29 0a 0a 28 74 65 73 74 20 22 73 3a 74 64 22 ))..(test "s:td"
15a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 '(
15b0: 22 3c 54 44 3e 22 20 28 28 29 29 20 22 3c 2f 54 "<TD>" (()) "</T
15c0: 44 3e 22 29 20 28 73 3a 74 64 20 27 28 29 29 29 D>") (s:td '()))
15d0: 0a 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 .;; (test "twiki
15e0: 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 :get-tiddlers-by
15f0: 2d 6e 61 6d 65 22 20 27 28 29 20 28 74 77 69 6b -name" '() (twik
1600: 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 i:get-tiddlers-b
1610: 79 2d 6e 61 6d 65 20 31 20 22 66 72 65 64 22 29 y-name 1 "fred")
1620: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 74 ).(test "twiki:t
1630: 69 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e 69 64 22 iddler-name->id"
1640: 20 31 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 1 (twiki:tiddle
1650: 72 2d 6e 61 6d 65 2d 3e 69 64 20 2a 74 64 62 2a r-name->id *tdb*
1660: 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 0a 28 74 "MainMenu")).(t
1670: 65 73 74 20 22 73 3a 73 65 74 21 20 61 20 76 61 est "s:set! a va
1680: 72 20 74 6f 20 23 66 22 20 20 20 20 20 22 22 0a r to #f" "".
1690: 20 20 20 20 20 20 28 62 65 67 69 6e 20 28 73 3a (begin (s:
16a0: 73 65 74 21 20 22 42 4c 41 48 22 20 23 66 29 0a set! "BLAH" #f).
16b0: 09 20 20 20 20 20 28 73 3a 67 65 74 20 22 42 4c . (s:get "BL
16c0: 41 48 22 29 29 29 20 3b 3b 20 64 6f 6e 27 74 20 AH"))) ;; don't
16d0: 6b 6e 6f 77 20 69 66 20 74 68 69 73 20 6f 6e 65 know if this one
16e0: 20 6d 61 6b 65 73 20 73 65 6e 73 65 2e 20 53 65 makes sense. Se
16f0: 74 74 69 6e 67 20 74 6f 20 23 66 20 73 68 6f 75 tting to #f shou
1700: 6c 64 20 72 65 61 6c 6c 79 20 64 65 6c 65 74 65 ld really delete
1710: 20 74 68 65 20 76 61 6c 75 65 0a 28 74 65 73 74 the value.(test
1720: 20 22 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 "twiki:save-dat
1730: 22 20 20 20 20 20 20 20 20 20 20 20 32 20 20 20 " 2
1740: 20 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 (twiki:save
1750: 2d 64 61 74 20 2a 74 64 62 2a 20 22 64 61 74 22 -dat *tdb* "dat"
1760: 20 30 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 0)).(test "twik
1770: 69 3a 67 65 74 2d 64 61 74 22 20 20 20 20 20 20 i:get-dat"
1780: 20 20 20 20 20 20 22 64 61 74 22 20 20 20 20 28 "dat" (
1790: 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 twiki:get-dat *t
17a0: 64 62 2a 20 32 29 29 0a 28 74 65 73 74 20 22 74 db* 2)).(test "t
17b0: 77 69 6b 69 3a 67 65 74 2d 64 61 74 22 20 20 20 wiki:get-dat"
17c0: 20 20 20 20 20 20 20 20 20 23 66 20 20 20 20 20 #f
17d0: 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 (twiki:get-dat
17e0: 20 2a 74 64 62 2a 20 35 29 29 0a 3b 3b 20 28 74 *tdb* 5)).;; (t
17f0: 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 est "twiki:get-d
1800: 61 74 22 20 20 20 20 20 20 23 66 20 20 20 20 28 at" #f (
1810: 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 twiki:get-dat *t
1820: 64 62 2a 20 23 66 29 29 0a 28 74 65 73 74 20 22 db* #f)).(test "
1830: 74 77 69 6b 69 3a 73 61 76 65 2d 74 69 64 64 6c twiki:save-tiddl
1840: 65 72 22 20 20 20 20 20 20 20 23 74 20 20 20 20 er" #t
1850: 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 74 (twiki:save-t
1860: 69 64 64 6c 65 72 20 2a 74 64 62 2a 20 22 68 65 iddler *tdb* "he
1870: 61 64 69 6e 67 22 20 22 62 6f 64 79 22 20 22 74 ading" "body" "t
1880: 61 67 73 22 20 6b 65 79 20 30 29 29 0a 3b 3b 20 ags" key 0)).;;
1890: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 (test "twiki:sav
18a0: 65 2d 63 75 72 72 2d 74 69 64 64 6c 65 72 22 20 e-curr-tiddler"
18b0: 20 23 66 20 20 20 20 20 20 20 28 74 77 69 6b 69 #f (twiki
18c0: 3a 73 61 76 65 2d 63 75 72 72 2d 74 69 64 64 6c :save-curr-tiddl
18d0: 65 72 20 2a 74 64 62 2a 20 31 29 29 0a 28 74 65 er *tdb* 1)).(te
18e0: 73 74 20 22 74 77 69 6b 69 3a 65 64 69 74 2d 74 st "twiki:edit-t
18f0: 77 69 64 64 6c 65 72 22 20 20 20 20 20 20 23 74 widdler" #t
1900: 20 20 20 20 20 20 20 28 6c 69 73 74 3f 20 28 74 (list? (t
1910: 77 69 6b 69 3a 65 64 69 74 2d 74 69 64 64 6c 65 wiki:edit-tiddle
1920: 72 20 2a 74 64 62 2a 20 6b 65 79 20 30 20 30 29 r *tdb* key 0 0)
1930: 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )).(test "twiki:
1940: 6d 61 69 6e 74 5f 61 72 65 61 22 20 20 20 20 20 maint_area"
1950: 20 20 20 20 22 3c 44 49 56 3e 22 20 20 28 63 61 "<DIV>" (ca
1960: 72 20 28 74 77 69 6b 69 3a 6d 61 69 6e 74 5f 61 r (twiki:maint_a
1970: 72 65 61 20 2a 74 64 62 2a 20 31 20 6b 65 79 20 rea *tdb* 1 key
1980: 77 69 6b 69 29 29 29 0a 28 74 65 73 74 20 22 74 wiki))).(test "t
1990: 77 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 22 20 20 wiki:pic_mgmt"
19a0: 20 20 20 20 20 20 20 20 20 22 3c 44 49 56 3e 22 "<DIV>"
19b0: 20 20 28 63 61 72 20 28 74 77 69 6b 69 3a 70 69 (car (twiki:pi
19c0: 63 5f 6d 67 6d 74 20 2a 74 64 62 2a 20 31 20 6b c_mgmt *tdb* 1 k
19d0: 65 79 29 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20 ey)))..;; get a
19e0: 62 6c 6f 62 20 6a 70 67 20 74 6f 20 70 72 6f 63 blob jpg to proc
19f0: 65 73 73 0a 28 64 65 66 69 6e 65 20 69 6e 70 32 ess.(define inp2
1a00: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c (open-input-fil
1a10: 65 20 22 74 65 73 74 73 2f 6b 69 61 74 6f 61 2e e "tests/kiatoa.
1a20: 70 6e 67 22 29 29 0a 28 64 65 66 69 6e 65 20 64 png")).(define d
1a30: 61 74 20 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f at (string->blo
1a40: 62 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 b (read-string #
1a50: 66 20 69 6e 70 32 29 29 29 0a 28 63 6c 6f 73 65 f inp2))).(close
1a60: 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 32 -input-port inp2
1a70: 29 0a 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 )...(test "twiki
1a80: 3a 73 61 76 65 2d 70 69 63 22 20 20 20 20 20 20 :save-pic"
1a90: 20 20 20 20 20 23 74 20 20 20 20 20 20 20 28 74 #t (t
1aa0: 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 20 2a 74 wiki:save-pic *t
1ab0: 64 62 2a 20 28 6c 69 73 74 20 22 6d 79 70 69 63 db* (list "mypic
1ac0: 2e 6a 70 67 22 20 22 69 6d 61 67 65 2f 6a 70 65 .jpg" "image/jpe
1ad0: 67 22 20 64 61 74 29 20 30 29 29 20 3b 3b 20 28 g" dat) 0)) ;; (
1ae0: 73 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 22 74 65 string->blob "te
1af0: 73 74 69 6e 67 20 65 68 21 22 29 29 29 29 20 0a sting eh!")))) .
1b00: 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 3a ;; (test "twiki:
1b10: 73 61 76 65 2d 70 69 63 2d 66 72 6f 6d 2d 66 6f save-pic-from-fo
1b20: 72 6d 22 20 23 66 20 20 20 20 20 20 20 28 74 77 rm" #f (tw
1b30: 69 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 72 6f iki:save-pic-fro
1b40: 6d 2d 66 6f 72 6d 20 2a 74 64 62 2a 20 31 29 29 m-form *tdb* 1))
1b50: 0a 0a 3b 3b 20 6d 6f 72 65 20 74 65 73 74 73 20 ..;; more tests
1b60: 6f 6e 20 64 61 74 73 0a 0a 28 64 65 66 69 6e 65 on dats..(define
1b70: 20 64 61 74 20 23 66 29 0a 28 6c 65 74 20 28 28 dat #f).(let ((
1b80: 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d inp (open-input-
1b90: 66 69 6c 65 20 22 74 65 73 74 73 2f 6b 69 61 74 file "tests/kiat
1ba0: 6f 61 2e 70 6e 67 22 29 29 29 0a 20 20 28 73 65 oa.png"))). (se
1bb0: 74 21 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 t! dat (read-str
1bc0: 69 6e 67 20 23 66 20 69 6e 70 29 29 0a 20 20 28 ing #f inp)). (
1bd0: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
1be0: 20 69 6e 70 29 29 0a 28 75 73 65 20 6d 64 35 29 inp)).(use md5)
1bf0: 0a 28 64 65 66 69 6e 65 20 64 61 74 2d 6d 64 35 .(define dat-md5
1c00: 20 28 6d 64 35 3a 64 69 67 65 73 74 20 64 61 74 (md5:digest dat
1c10: 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )).(test "twiki:
1c20: 73 61 76 65 2d 64 61 74 20 28 62 69 6e 61 72 79 save-dat (binary
1c30: 29 22 20 34 20 20 20 20 20 20 20 20 28 74 77 69 )" 4 (twi
1c40: 6b 69 3a 73 61 76 65 2d 64 61 74 20 2a 74 64 62 ki:save-dat *tdb
1c50: 2a 20 64 61 74 20 31 29 29 0a 28 74 65 73 74 20 * dat 1)).(test
1c60: 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 28 "twiki:get-dat (
1c70: 62 69 6e 61 72 79 29 22 20 20 64 61 74 2d 6d 64 binary)" dat-md
1c80: 35 20 20 28 6c 65 74 20 28 28 64 20 28 74 77 69 5 (let ((d (twi
1c90: 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 62 2a ki:get-dat *tdb*
1ca0: 20 34 29 29 29 0a 09 09 09 09 09 20 20 20 28 6d 4)))...... (m
1cb0: 64 35 3a 64 69 67 65 73 74 20 64 29 29 29 0a 3b d5:digest d))).;
1cc0: 3b 20 66 6f 72 6d 73 0a 3b 3b 20 28 64 65 66 69 ; forms.;; (defi
1cd0: 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 ne inp (open-inp
1ce0: 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 ut-file "tests/e
1cf0: 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 xample.post.in")
1d00: 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 64 61 74 ).;; (define dat
1d10: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 (read-string #f
1d20: 20 69 6e 70 29 29 0a 3b 3b 20 28 64 65 66 69 6e inp)).;; (defin
1d30: 65 20 64 61 74 73 74 72 20 28 6f 70 65 6e 2d 69 e datstr (open-i
1d40: 6e 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 29 nput-string dat)
1d50: 29 0a 0a 3b 3b 20 62 69 6e 61 72 79 20 69 6e 70 )..;; binary inp
1d60: 75 74 73 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 uts.(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 62 69 6e 61 72 79 2e 69 6e 22 29 post.binary.in")
1da0: 29 0a 28 64 65 66 69 6e 65 20 64 61 74 20 23 66 ).(define dat #f
1db0: 29 0a 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 )..(test "formda
1dc0: 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 t:load-all-port
1dd0: 6d 75 6c 74 69 70 61 72 74 22 20 23 74 20 28 6c multipart" #t (l
1de0: 65 74 20 28 28 69 64 61 74 20 28 66 6f 72 6d 64 et ((idat (formd
1df0: 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 at:load-all-port
1e00: 20 69 6e 70 29 29 29 0a 09 09 09 09 20 20 20 28 inp)))..... (
1e10: 73 65 74 21 20 64 61 74 20 69 64 61 74 29 0a 09 set! dat idat)..
1e20: 09 09 09 20 20 20 23 74 29 29 0a 28 74 65 73 74 ... #t)).(test
1e30: 20 22 66 6f 72 6d 64 61 74 3a 6b 65 79 73 22 20 "formdat:keys"
1e40: 27 28 70 69 63 74 75 72 65 2d 6e 61 6d 65 20 69 '(picture-name i
1e50: 6e 70 75 74 2d 70 69 63 74 75 72 65 20 22 22 20 nput-picture ""
1e60: 73 75 62 6d 69 74 2d 70 69 63 74 75 72 65 29 20 submit-picture)
1e70: 28 66 6f 72 6d 64 61 74 3a 6b 65 79 73 20 64 61 (formdat:keys da
1e80: 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 69 6e 70 t))..(define inp
1e90: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c (open-input-fil
1ea0: 65 20 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 e "tests/example
1eb0: 2e 70 6f 73 74 2e 69 6e 22 29 29 0a 28 74 65 73 .post.in")).(tes
1ec0: 74 20 22 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d t "formdat:load-
1ed0: 61 6c 6c 2d 70 6f 72 74 20 73 69 6e 67 6c 65 20 all-port single
1ee0: 70 61 72 74 22 20 23 74 20 28 6c 65 74 20 28 28 part" #t (let ((
1ef0: 69 64 61 74 20 28 66 6f 72 6d 64 61 74 3a 6c 6f idat (formdat:lo
1f00: 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 69 6e 70 29 ad-all-port inp)
1f10: 29 29 0a 09 09 09 09 20 20 20 28 73 65 74 21 20 ))..... (set!
1f20: 64 61 74 20 69 64 61 74 29 0a 09 09 09 09 20 20 dat idat).....
1f30: 20 23 74 29 29 0a 28 74 65 73 74 20 22 66 6f 72 #t)).(test "for
1f40: 6d 64 61 74 3a 6b 65 79 73 22 20 27 28 65 6d 61 mdat:keys" '(ema
1f50: 69 6c 2d 61 64 64 72 65 73 73 20 66 6f 72 6d 2d il-address form-
1f60: 6e 61 6d 65 20 70 61 73 73 77 6f 72 64 29 20 28 name password) (
1f70: 66 6f 72 6d 64 61 74 3a 6b 65 79 73 20 64 61 74 formdat:keys dat
1f80: 29 29 0a 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 ))..(close-input
1f90: 2d 70 6f 72 74 20 69 6e 70 29 0a -port inp).