Artifact
9cca07365b82d1f225e7b590b72b3234ce501110:
0000: 23 21 2f 75 73 72 2f 6c 6f 63 61 6c 2f 62 69 6e #!/usr/local/bin
0010: 2f 63 73 69 20 2d 71 20 0a 0a 3b 3b 20 43 6f 70 /csi -q ..;; Cop
0020: 79 72 69 67 68 74 20 32 30 30 37 2d 32 30 30 38 yright 2007-2008
0030: 2c 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e , Matthew Wellan
0040: 64 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 d..;; .;; This
0050: 70 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 program is made
0060: 61 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 available under
0070: 74 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 the GNU GPL vers
0080: 69 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 ion 2.0 or.;; g
0090: 72 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 reater. See the
00a0: 61 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c accompanying fil
00b0: 65 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 e COPYING for de
00c0: 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 tails..;; .;; T
00d0: 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 his program is d
00e0: 69 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f istributed WITHO
00f0: 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b UT ANY WARRANTY;
0100: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 without even th
0110: 65 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 e.;; implied wa
0120: 72 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 rranty of MERCHA
0130: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
0140: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
0150: 43 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 CULAR.;; PURPOS
0160: 45 2e 0a 0a 28 75 73 65 20 74 65 73 74 20 6d 64 E...(use test md
0170: 35 29 0a 0a 28 72 65 71 75 69 72 65 2d 65 78 74 5)..(require-ext
0180: 65 6e 73 69 6f 6e 20 73 71 6c 69 74 65 33 29 0a ension sqlite3).
0190: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
01a0: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
01b0: 29 29 0a 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 ))..(require-lib
01c0: 72 61 72 79 20 64 62 69 29 0a 0a 28 6c 6f 61 64 rary dbi)..(load
01d0: 20 22 2e 2f 72 65 71 75 69 72 65 6d 65 6e 74 73 "./requirements
01e0: 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f .scm").(load "./
01f0: 63 6f 6f 6b 69 65 2e 73 6f 22 29 0a 28 6c 6f 61 cookie.so").(loa
0200: 64 20 22 2e 2f 6d 69 73 63 2d 73 74 6d 6c 2e 73 d "./misc-stml.s
0210: 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 66 6f cm").(load "./fo
0220: 72 6d 64 61 74 2e 73 63 6d 22 29 0a 28 6c 6f 61 rmdat.scm").(loa
0230: 64 20 22 2e 2f 73 74 6d 6c 2e 73 63 6d 22 29 0a d "./stml.scm").
0240: 28 6c 6f 61 64 20 22 2e 2f 73 65 73 73 69 6f 6e (load "./session
0250: 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f .scm").(load "./
0260: 73 71 6c 74 62 6c 2e 73 63 6d 22 29 0a 28 6c 6f sqltbl.scm").(lo
0270: 61 64 20 22 2e 2f 68 74 6d 6c 2d 66 69 6c 74 65 ad "./html-filte
0280: 72 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e r.scm").(load ".
0290: 2f 6b 65 79 73 74 6f 72 65 2e 73 63 6d 22 29 0a /keystore.scm").
02a0: 0a 3b 3b 20 54 65 73 74 20 74 68 65 20 70 72 69 .;; Test the pri
02b0: 6d 69 74 69 76 65 20 64 62 69 20 69 6e 74 65 72 mitive dbi inter
02c0: 66 61 63 65 0a 0a 28 73 79 73 74 65 6d 20 22 72 face..(system "r
02d0: 6d 20 2d 66 20 74 65 73 74 73 2f 74 65 73 74 2e m -f tests/test.
02e0: 64 62 22 29 0a 28 64 65 66 69 6e 65 20 64 62 20 db").(define db
02f0: 28 64 62 69 3a 6f 70 65 6e 20 27 73 71 6c 69 74 (dbi:open 'sqlit
0300: 65 33 20 27 28 28 64 62 6e 61 6d 65 20 2e 20 22 e3 '((dbname . "
0310: 74 65 73 74 73 2f 74 65 73 74 2e 64 62 22 29 29 tests/test.db"))
0320: 29 29 0a 28 64 62 69 3a 65 78 65 63 20 64 62 20 )).(dbi:exec db
0330: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 66 6f "CREATE TABLE fo
0340: 6f 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 o(id INTEGER PRI
0350: 4d 41 52 59 20 4b 45 59 2c 6e 61 6d 65 20 54 45 MARY KEY,name TE
0360: 58 54 29 3b 22 29 0a 28 64 62 69 3a 65 78 65 63 XT);").(dbi:exec
0370: 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f db "INSERT INTO
0380: 20 66 6f 6f 28 6e 61 6d 65 29 20 56 41 4c 55 45 foo(name) VALUE
0390: 53 28 3f 29 3b 22 20 22 4d 61 74 74 22 29 0a 28 S(?);" "Matt").(
03a0: 64 62 69 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 dbi:for-each-row
03b0: 20 0a 20 28 6c 61 6d 62 64 61 20 28 74 75 70 6c . (lambda (tupl
03c0: 65 29 0a 20 20 20 28 70 72 69 6e 74 20 28 76 65 e). (print (ve
03d0: 63 74 6f 72 2d 72 65 66 20 74 75 70 6c 65 20 30 ctor-ref tuple 0
03e0: 29 20 22 20 22 20 28 76 65 63 74 6f 72 2d 72 65 ) " " (vector-re
03f0: 66 20 74 75 70 6c 65 20 31 29 29 29 0a 20 64 62 f tuple 1))). db
0400: 20 22 53 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20 "SELECT * FROM
0410: 66 6f 6f 3b 22 29 0a 28 74 65 73 74 20 22 64 62 foo;").(test "db
0420: 69 3a 67 65 74 2d 6f 6e 65 22 20 22 4d 61 74 74 i:get-one" "Matt
0430: 22 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 20 64 " (dbi:get-one d
0440: 62 20 22 53 45 4c 45 43 54 20 6e 61 6d 65 20 46 b "SELECT name F
0450: 52 4f 4d 20 66 6f 6f 20 57 48 45 52 45 20 6e 61 ROM foo WHERE na
0460: 6d 65 3d 27 4d 61 74 74 27 3b 22 29 29 0a 0a 3b me='Matt';"))..;
0470: 3b 20 6b 65 79 73 74 6f 72 65 0a 28 64 62 69 3a ; keystore.(dbi:
0480: 65 78 65 63 20 64 62 20 22 43 52 45 41 54 45 20 exec db "CREATE
0490: 54 41 42 4c 45 20 6d 65 74 61 64 61 74 61 20 28 TABLE metadata (
04a0: 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 id INTEGER PRIMA
04b0: 52 59 20 4b 45 59 2c 6b 65 79 20 54 45 58 54 2c RY KEY,key TEXT,
04c0: 76 61 6c 75 65 20 54 45 58 54 29 3b 22 29 0a 0a value TEXT);")..
04d0: 28 6b 65 79 73 74 6f 72 65 3a 73 65 74 21 20 64 (keystore:set! d
04e0: 62 20 22 53 43 48 45 4d 41 2d 56 45 52 53 49 4f b "SCHEMA-VERSIO
04f0: 4e 22 20 31 2e 32 29 0a 28 74 65 73 74 20 22 4b N" 1.2).(test "K
0500: 65 79 73 74 6f 72 65 20 67 65 74 22 20 22 31 2e eystore get" "1.
0510: 32 22 20 20 28 6b 65 79 73 74 6f 72 65 3a 67 65 2" (keystore:ge
0520: 74 20 20 64 62 20 22 53 43 48 45 4d 41 2d 56 45 t db "SCHEMA-VE
0530: 52 53 49 4f 4e 22 29 29 0a 28 6b 65 79 73 74 6f RSION")).(keysto
0540: 72 65 3a 64 65 6c 21 20 64 62 20 22 53 43 48 45 re:del! db "SCHE
0550: 4d 41 2d 56 45 52 53 49 4f 4e 22 29 20 0a 28 74 MA-VERSION") .(t
0560: 65 73 74 20 22 4b 65 79 73 74 6f 72 65 20 67 65 est "Keystore ge
0570: 74 20 64 65 6c 65 74 65 64 22 20 23 66 20 28 6b t deleted" #f (k
0580: 65 79 73 74 6f 72 65 3a 67 65 74 20 64 62 20 22 eystore:get db "
0590: 53 43 48 45 4d 41 2d 56 45 52 53 49 4f 4e 22 29 SCHEMA-VERSION")
05a0: 29 0a 0a 28 73 79 73 74 65 6d 20 22 72 6d 20 2d )..(system "rm -
05b0: 66 20 74 65 73 74 73 2f 74 65 73 74 2e 64 62 22 f tests/test.db"
05c0: 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 73 )..;; create a s
05d0: 65 73 73 69 6f 6e 20 74 6f 20 77 6f 72 6b 20 77 ession to work w
05e0: 69 74 68 22 29 0a 28 73 65 74 65 6e 76 20 22 52 ith").(setenv "R
05f0: 45 51 55 45 53 54 5f 55 52 49 22 20 22 2f 73 74 EQUEST_URI" "/st
0600: 6d 6c 72 75 6e 3f 61 63 74 69 6f 6e 3d 74 65 73 mlrun?action=tes
0610: 74 2e 74 65 73 74 22 29 0a 28 73 65 74 65 6e 76 t.test").(setenv
0620: 20 22 53 43 52 49 50 54 5f 4e 41 4d 45 22 20 22 "SCRIPT_NAME" "
0630: 2f 63 67 69 2d 62 69 6e 2f 73 74 6d 6c 72 75 6e /cgi-bin/stmlrun
0640: 22 29 0a 28 73 65 74 65 6e 76 20 22 50 41 54 48 ").(setenv "PATH
0650: 5f 49 4e 46 4f 22 20 22 2f 74 65 73 74 22 29 0a _INFO" "/test").
0660: 28 73 65 74 65 6e 76 20 22 51 55 45 52 59 5f 53 (setenv "QUERY_S
0670: 54 52 49 4e 47 22 20 22 61 63 74 69 6f 6e 3d 74 TRING" "action=t
0680: 65 73 74 2e 74 65 73 74 22 29 0a 28 73 65 74 65 est.test").(sete
0690: 6e 76 20 22 53 45 52 56 45 52 5f 4e 41 4d 45 22 nv "SERVER_NAME"
06a0: 20 22 6c 6f 63 61 6c 68 6f 73 74 22 29 0a 28 73 "localhost").(s
06b0: 65 74 65 6e 76 20 22 52 45 51 55 45 53 54 5f 4d etenv "REQUEST_M
06c0: 45 54 48 4f 44 22 20 22 47 45 54 22 29 0a 0a 28 ETHOD" "GET")..(
06d0: 6c 6f 61 64 20 22 2e 2f 73 65 74 75 70 2e 73 63 load "./setup.sc
06e0: 6d 22 29 0a 0a 28 73 3a 76 61 6c 69 64 61 74 65 m")..(s:validate
06f0: 2d 69 6e 70 75 74 73 29 0a 0a 3b 3b 20 74 65 73 -inputs)..;; tes
0700: 74 20 73 65 73 73 69 6f 6e 20 76 61 72 69 61 62 t session variab
0710: 6c 65 73 0a 0a 28 73 65 73 73 69 6f 6e 3a 67 65 les..(session:ge
0720: 74 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e t-vars s:session
0730: 29 0a 28 64 65 66 69 6e 65 20 6e 61 64 61 20 22 ).(define nada "
0740: 61 6e 64 6e 6e 64 68 68 73 68 61 61 73 22 29 0a andnndhhshaas").
0750: 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 73 (s:session-var-s
0760: 65 74 21 20 22 6e 69 63 6b 22 20 6e 61 64 61 29 et! "nick" nada)
0770: 0a 28 74 65 73 74 20 22 53 65 73 73 69 6f 6e 20 .(test "Session
0780: 76 61 72 20 73 65 74 2f 67 65 74 22 20 6e 61 64 var set/get" nad
0790: 61 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 a (s:session-va
07a0: 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 0a 28 r-get "nick")).(
07b0: 70 72 69 6e 74 20 22 67 6f 74 20 68 65 72 65 22 print "got here"
07c0: 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 2d ).(session:save-
07d0: 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 0a vars s:session).
07e0: 28 73 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 72 (session:get-var
07f0: 73 20 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 74 s s:session).(t
0800: 65 73 74 20 22 53 65 73 73 69 6f 6e 20 76 61 72 est "Session var
0810: 20 73 65 74 2f 67 65 74 20 61 66 74 65 72 20 73 set/get after s
0820: 61 76 65 2f 67 65 74 22 20 6e 61 64 61 20 28 73 ave/get" nada (s
0830: 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 :session-var-get
0840: 20 22 6e 69 63 6b 22 29 29 0a 28 73 65 73 73 69 "nick")).(sessi
0850: 6f 6e 3a 64 65 6c 21 20 73 3a 73 65 73 73 69 6f on:del! s:sessio
0860: 6e 20 22 2a 73 65 73 73 69 6f 6e 76 61 72 73 2a n "*sessionvars*
0870: 22 20 22 6e 69 63 6b 22 29 0a 28 74 65 73 74 20 " "nick").(test
0880: 22 53 65 73 73 69 6f 6e 20 76 61 72 20 64 65 6c "Session var del
0890: 22 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 "
08a0: 20 20 20 20 20 23 66 20 20 20 28 73 3a 73 65 73 #f (s:ses
08b0: 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 22 6e 69 sion-var-get "ni
08c0: 63 6b 22 29 29 0a 28 73 65 73 73 69 6f 6e 3a 73 ck")).(session:s
08d0: 61 76 65 2d 76 61 72 73 20 73 3a 73 65 73 73 69 ave-vars s:sessi
08e0: 6f 6e 29 0a 28 73 65 73 73 69 6f 6e 3a 67 65 74 on).(session:get
08f0: 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 -vars s:session)
0900: 0a 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d .(s:session-var-
0910: 73 65 74 21 20 22 6e 69 63 6b 22 20 6e 61 64 61 set! "nick" nada
0920: 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 2d ).(session:save-
0930: 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 0a vars s:session).
0940: 0a 3b 3b 20 28 74 65 73 74 20 22 53 65 73 73 69 .;; (test "Sessi
0950: 6f 6e 20 76 61 72 20 64 65 6c 22 20 20 20 20 20 on var del"
0960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
0970: 66 20 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d 76 f (s:session-v
0980: 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 0a ar-get "nick")).
0990: 0a 3b 3b 20 74 65 73 74 20 70 65 72 73 6f 6e 0a .;; test person.
09a0: 0a 28 6c 6f 61 64 20 22 2e 2f 74 65 73 74 73 2f .(load "./tests/
09b0: 6d 6f 64 65 6c 73 2f 74 65 73 74 2e 73 63 6d 22 models/test.scm"
09c0: 29 0a 0a 28 70 72 69 6e 74 20 22 53 65 73 73 69 )..(print "Sessi
09d0: 6f 6e 20 6b 65 79 20 69 73 20 22 20 28 73 64 61 on key is " (sda
09e0: 74 2d 67 65 74 2d 73 65 73 73 69 6f 6e 2d 6b 65 t-get-session-ke
09f0: 79 20 73 3a 73 65 73 73 69 6f 6e 29 29 0a 0a 28 y s:session))..(
0a00: 74 65 73 74 20 22 44 65 6c 65 74 65 20 73 65 73 test "Delete ses
0a10: 73 69 6f 6e 22 20 23 74 20 28 73 3a 64 65 6c 65 sion" #t (s:dele
0a20: 74 65 2d 73 65 73 73 69 6f 6e 29 29 0a 0a 28 6c te-session))..(l
0a30: 65 74 20 28 28 66 68 20 28 6f 70 65 6e 2d 69 6e et ((fh (open-in
0a40: 70 75 74 2d 70 69 70 65 20 22 6c 73 20 2e 2f 74 put-pipe "ls ./t
0a50: 65 73 74 73 2f 70 61 67 65 73 2f 2a 2f 63 6f 6e ests/pages/*/con
0a60: 74 72 6f 6c 2e 73 63 6d 22 29 29 29 0a 20 20 28 trol.scm"))). (
0a70: 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 20 28 72 65 let loop ((l (re
0a80: 61 64 2d 6c 69 6e 65 20 66 68 29 29 29 0a 20 20 ad-line fh))).
0a90: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d (if (not (eof-
0aa0: 6f 62 6a 65 63 74 3f 20 6c 29 29 0a 20 20 20 20 object? l)).
0ab0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
0ac0: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
0ad0: 6c 6f 61 64 69 6e 67 20 22 20 6c 29 0a 20 20 20 loading " l).
0ae0: 20 20 20 20 20 20 20 28 6c 6f 61 64 20 6c 29 0a (load l).
0af0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
0b00: 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 29 29 (read-line fh)))
0b10: 29 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 )). (close-inpu
0b20: 74 2d 70 6f 72 74 20 66 68 29 29 0a 0a 3b 3b 20 t-port fh))..;;
0b30: 53 68 6f 75 6c 64 20 68 61 76 65 20 70 6f 6c 6c Should have poll
0b40: 3a 70 6f 6c 6c 20 64 65 66 69 6e 65 64 20 6e 6f :poll defined no
0b50: 77 2e 0a 28 74 65 73 74 20 22 4d 61 6b 65 20 61 w..(test "Make a
0b60: 20 72 61 6e 64 6f 6d 20 73 74 72 69 6e 67 22 20 random string"
0b70: 32 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 2 (string-length
0b80: 20 28 73 65 73 73 69 6f 6e 3a 6d 61 6b 65 2d 72 (session:make-r
0b90: 61 6e 64 2d 73 74 72 69 6e 67 20 32 29 29 29 0a and-string 2))).
0ba0: 28 74 65 73 74 20 22 43 72 65 61 74 65 20 61 20 (test "Create a
0bb0: 65 6e 63 72 79 70 74 65 64 20 70 61 73 73 77 6f encrypted passwo
0bc0: 72 64 22 20 22 61 62 51 39 4b 59 2e 4b 66 72 59 rd" "abQ9KY.KfrY
0bd0: 72 63 22 20 28 73 3a 63 72 79 70 74 2d 70 61 73 rc" (s:crypt-pas
0be0: 73 77 64 20 22 66 6f 6f 22 20 22 61 62 22 29 29 swd "foo" "ab"))
0bf0: 0a 0a 28 74 65 73 74 20 22 73 3a 61 6e 79 2d 3e ..(test "s:any->
0c00: 73 74 72 69 6e 67 20 6f 6e 20 61 20 68 61 73 68 string on a hash
0c10: 2d 74 61 62 6c 65 22 20 22 23 3c 68 61 73 68 2d -table" "#<hash-
0c20: 74 61 62 6c 65 3e 22 20 28 73 3a 61 6e 79 2d 3e table>" (s:any->
0c30: 73 74 72 69 6e 67 20 28 6d 61 6b 65 2d 68 61 73 string (make-has
0c40: 68 2d 74 61 62 6c 65 29 29 29 0a 0a 28 64 65 66 h-table)))..(def
0c50: 69 6e 65 20 73 65 6c 65 63 74 2d 6c 69 73 74 0a ine select-list.
0c60: 20 20 27 28 28 61 20 62 20 63 29 28 64 20 28 65 '((a b c)(d (e
0c70: 20 66 20 67 29 28 68 20 69 20 6a 20 23 74 29 29 f g)(h i j #t))
0c80: 29 29 0a 28 64 65 66 69 6e 65 20 72 65 73 75 6c )).(define resul
0c90: 74 20 27 28 22 3c 53 45 4c 45 43 54 20 6e 61 6d t '("<SELECT nam
0ca0: 65 3d 5c 22 65 66 67 5c 22 3e 22 20 0a 09 09 20 e=\"efg\">" ...
0cb0: 28 28 28 22 3c 4f 50 54 49 4f 4e 20 6c 61 62 65 ((("<OPTION labe
0cc0: 6c 3d 5c 22 61 5c 22 20 76 61 6c 75 65 3d 5c 22 l=\"a\" value=\"
0cd0: 62 5c 22 3e 63 3c 2f 4f 50 54 49 4f 4e 3e 22 29 b\">c</OPTION>")
0ce0: 20 0a 09 09 20 20 20 28 22 3c 4f 50 54 47 52 4f ... ("<OPTGRO
0cf0: 55 50 20 6c 61 62 65 6c 3d 64 22 20 0a 09 09 20 UP label=d" ...
0d00: 20 20 20 28 22 3c 4f 50 54 49 4f 4e 20 6c 61 62 ("<OPTION lab
0d10: 65 6c 3d 5c 22 65 5c 22 20 76 61 6c 75 65 3d 5c el=\"e\" value=\
0d20: 22 66 5c 22 3e 67 3c 2f 4f 50 54 49 4f 4e 3e 22 "f\">g</OPTION>"
0d30: 29 0a 09 09 20 20 20 20 28 22 3c 4f 50 54 49 4f )... ("<OPTIO
0d40: 4e 20 20 73 65 6c 65 63 74 65 64 20 6c 61 62 65 N selected labe
0d50: 6c 3d 5c 22 68 5c 22 20 76 61 6c 75 65 3d 5c 22 l=\"h\" value=\"
0d60: 69 5c 22 3e 6a 3c 2f 4f 50 54 49 4f 4e 3e 22 29 i\">j</OPTION>")
0d70: 20 0a 09 09 20 20 20 20 22 3c 2f 4f 50 54 47 52 ... "</OPTGR
0d80: 4f 55 50 3e 22 29 29 29 0a 09 09 20 22 3c 2f 53 OUP>")))... "</S
0d90: 45 4c 45 43 54 3e 22 29 29 0a 0a 28 74 65 73 74 ELECT>"))..(test
0da0: 20 22 53 65 6c 65 63 74 20 6c 69 73 74 22 20 72 "Select list" r
0db0: 65 73 75 6c 74 20 28 73 3a 73 65 6c 65 63 74 20 esult (s:select
0dc0: 73 65 6c 65 63 74 2d 6c 69 73 74 20 27 6e 61 6d select-list 'nam
0dd0: 65 20 22 65 66 67 22 29 29 0a 0a 3b 3b 20 54 65 e "efg"))..;; Te
0de0: 73 74 20 6d 6f 64 75 6c 65 73 0a 0a 28 74 65 73 st modules..(tes
0df0: 74 20 22 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f t "misc:non-zero
0e00: 2d 73 74 72 69 6e 67 20 5c 22 5c 22 22 20 23 66 -string \"\"" #f
0e10: 20 28 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d (misc:non-zero-
0e20: 73 74 72 69 6e 67 20 22 22 29 29 0a 28 74 65 73 string "")).(tes
0e30: 74 20 22 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f t "misc:non-zero
0e40: 2d 73 74 72 69 6e 67 20 23 66 22 20 23 66 20 28 -string #f" #f (
0e50: 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 misc:non-zero-st
0e60: 72 69 6e 67 20 23 66 29 29 0a 28 74 65 73 74 20 ring #f)).(test
0e70: 22 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 "misc:non-zero-s
0e80: 74 72 69 6e 67 20 27 62 6c 61 68 22 20 23 66 20 tring 'blah" #f
0e90: 28 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 (misc:non-zero-s
0ea0: 74 72 69 6e 67 20 27 62 6c 61 68 29 29 0a 0a 3b tring 'blah))..;
0eb0: 3b 20 66 6f 72 6d 73 0a 28 64 65 66 69 6e 65 20 ; forms.(define
0ec0: 66 6f 72 6d 20 23 66 29 0a 28 74 65 73 74 20 22 form #f).(test "
0ed0: 6d 61 6b 65 20 3c 66 6f 72 6d 64 61 74 3e 22 20 make <formdat>"
0ee0: 23 74 20 28 6c 65 74 20 28 28 66 20 28 6d 61 6b #t (let ((f (mak
0ef0: 65 2d 66 6f 72 6d 64 61 74 3a 66 6f 72 6d 64 61 e-formdat:formda
0f00: 74 29 29 29 0a 09 09 09 20 20 20 20 28 73 65 74 t))).... (set
0f10: 21 20 66 6f 72 6d 20 66 29 0a 09 09 09 20 20 20 ! form f)....
0f20: 20 23 74 29 29 0a 28 74 65 73 74 20 22 66 6f 72 #t)).(test "for
0f30: 6d 64 61 74 3a 20 73 65 74 21 2f 67 65 74 22 20 mdat: set!/get"
0f40: 22 59 65 70 21 22 20 28 62 65 67 69 6e 0a 09 09 "Yep!" (begin...
0f50: 09 09 20 20 20 28 66 6f 72 6d 64 61 74 3a 73 65 .. (formdat:se
0f60: 74 21 20 66 6f 72 6d 20 22 62 6c 61 68 22 20 22 t! form "blah" "
0f70: 59 65 70 21 22 29 0a 09 09 09 09 20 20 20 28 66 Yep!")..... (f
0f80: 6f 72 6d 64 61 74 3a 67 65 74 20 20 66 6f 72 6d ormdat:get form
0f90: 20 22 62 6c 61 68 22 29 29 29 0a 0a 28 74 65 73 "blah")))..(tes
0fa0: 74 20 22 73 3a 73 74 72 69 6e 67 2d 3e 70 67 69 t "s:string->pgi
0fb0: 6e 74 22 20 20 20 31 32 33 20 28 73 3a 61 6e 79 nt" 123 (s:any
0fc0: 2d 3e 70 67 69 6e 74 20 22 31 32 33 22 29 29 0a ->pgint "123")).
0fd0: 28 74 65 73 74 20 22 73 3a 69 6c 6c 65 67 61 6c (test "s:illegal
0fe0: 2d 70 67 69 6e 74 20 28 6c 65 67 61 6c 29 22 20 -pgint (legal)"
0ff0: 20 20 20 20 20 20 20 23 66 20 28 73 3a 69 6c 6c #f (s:ill
1000: 65 67 61 6c 2d 70 67 69 6e 74 20 31 30 31 31 29 egal-pgint 1011)
1010: 29 0a 28 74 65 73 74 20 22 73 3a 69 6c 6c 65 67 ).(test "s:illeg
1020: 61 6c 2d 70 67 69 6e 74 20 28 69 6c 6c 65 67 61 al-pgint (illega
1030: 6c 20 62 69 67 29 22 20 20 20 31 20 28 73 3a 69 l big)" 1 (s:i
1040: 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 20 39 39 llegal-pgint 99
1050: 39 39 39 39 39 39 39 39 29 29 0a 28 74 65 73 74 99999999)).(test
1060: 20 22 73 3a 69 6c 6c 65 67 61 6c 70 67 69 6e 74 "s:illegalpgint
1070: 20 28 69 6c 6c 65 67 61 6c 20 73 6d 61 6c 6c 29 (illegal small)
1080: 22 20 2d 31 20 28 73 3a 69 6c 6c 65 67 61 6c 2d " -1 (s:illegal-
1090: 70 67 69 6e 74 20 2d 39 39 39 39 39 39 39 39 39 pgint -999999999
10a0: 39 29 29 0a 0a 3b 3b 20 54 68 65 20 74 77 69 6b 9))..;; The twik
10b0: 69 20 6d 6f 64 75 6c 65 0a 0a 3b 3b 20 63 6c 65 i module..;; cle
10c0: 61 6e 20 75 70 0a 28 73 79 73 74 65 6d 20 22 72 an up.(system "r
10d0: 6d 20 2d 72 66 20 74 77 69 6b 69 73 2f 2a 22 29 m -rf twikis/*")
10e0: 0a 28 6c 6f 61 64 20 22 6d 6f 64 75 6c 65 73 2f .(load "modules/
10f0: 74 77 69 6b 69 2f 74 77 69 6b 69 2d 6d 6f 64 2e twiki/twiki-mod.
1100: 73 63 6d 22 29 0a 28 64 65 66 69 6e 65 20 6b 65 scm").(define ke
1110: 79 73 20 28 6c 69 73 74 20 22 62 6c 61 68 22 20 ys (list "blah"
1120: 31 20 27 6e 61 64 61 29 29 0a 28 74 65 73 74 20 1 'nada)).(test
1130: 22 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b 65 79 "twiki:keys->key
1140: 22 20 20 22 62 6c 61 68 20 31 20 6e 61 64 61 22 " "blah 1 nada"
1150: 20 28 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b 65 (twiki:keys->ke
1160: 79 20 6b 65 79 73 29 29 0a 28 64 65 66 69 6e 65 y keys)).(define
1170: 20 6b 65 79 20 28 74 77 69 6b 69 3a 6b 65 79 73 key (twiki:keys
1180: 2d 3e 6b 65 79 20 6b 65 79 73 29 29 0a 0a 28 64 ->key keys))..(d
1190: 65 66 69 6e 65 20 2a 74 64 62 2a 20 23 66 29 0a efine *tdb* #f).
11a0: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 6f 70 65 (test "twiki:ope
11b0: 6e 2d 64 62 22 20 20 20 23 74 20 28 6c 65 74 20 n-db" #t (let
11c0: 28 28 64 62 20 28 74 77 69 6b 69 3a 6f 70 65 6e ((db (twiki:open
11d0: 2d 64 62 20 6b 65 79 29 29 29 0a 09 09 09 20 20 -db key)))....
11e0: 20 20 20 28 73 65 74 21 20 2a 74 64 62 2a 20 64 (set! *tdb* d
11f0: 62 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 2a b).... (if *
1200: 74 64 62 2a 20 23 74 20 23 66 29 29 29 0a 28 64 tdb* #t #f))).(d
1210: 65 66 69 6e 65 20 77 69 6b 69 20 28 6d 61 6b 65 efine wiki (make
1220: 2d 74 77 69 6b 69 3a 77 69 6b 69 29 29 0a 28 74 -twiki:wiki)).(t
1230: 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 77 69 wiki:wiki-set-wi
1240: 64 21 20 77 69 6b 69 20 31 29 0a 28 74 77 69 6b d! wiki 1).(twik
1250: 69 3a 77 69 6b 69 2d 73 65 74 2d 6e 61 6d 65 21 i:wiki-set-name!
1260: 20 77 69 6b 69 20 22 6d 61 69 6e 22 29 0a 28 74 wiki "main").(t
1270: 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 70 65 wiki:wiki-set-pe
1280: 72 6d 73 21 20 77 69 6b 69 20 27 28 72 20 77 29 rms! wiki '(r w)
1290: 29 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )..(test "twiki:
12a0: 64 61 74 2d 3e 68 74 6d 6c 22 20 27 28 22 48 65 dat->html" '("He
12b0: 6c 6c 6f 22 20 22 3c 42 52 3e 22 29 20 28 74 77 llo" "<BR>") (tw
12c0: 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 20 22 48 iki:dat->html "H
12d0: 65 6c 6c 6f 22 20 77 69 6b 69 29 29 0a 28 74 65 ello" wiki)).(te
12e0: 73 74 20 22 74 77 69 6b 69 3a 6b 65 79 73 2d 3e st "twiki:keys->
12f0: 66 6e 61 6d 65 22 20 27 28 22 74 77 69 6b 69 73 fname" '("twikis
1300: 2f 59 6d 78 68 61 2f 43 41 78 49 47 2f 35 68 5a /Ymxha/CAxIG/5hZ
1310: 47 45 22 20 22 59 6d 78 68 61 43 41 78 49 47 35 GE" "YmxhaCAxIG5
1320: 68 5a 47 45 5f 22 29 20 3b 3b 20 28 22 74 77 69 hZGE_") ;; ("twi
1330: 6b 69 73 2f 64 39 39 61 32 64 65 39 2f 36 38 30 kis/d99a2de9/680
1340: 38 34 39 33 62 2f 32 33 37 37 30 66 37 30 22 20 8493b/23770f70"
1350: 22 64 39 39 61 32 64 65 39 36 38 30 38 34 39 33 "d99a2de96808493
1360: 62 32 33 37 37 30 66 37 30 63 37 36 64 66 66 65 b23770f70c76dffe
1370: 34 22 29 0a 20 20 20 20 20 20 28 74 77 69 6b 69 4"). (twiki
1380: 3a 6b 65 79 2d 3e 66 6e 61 6d 65 20 6b 65 79 29 :key->fname key)
1390: 29 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )..(test "twiki:
13a0: 6e 61 6d 65 2d 3e 77 69 64 22 20 20 20 20 20 31 name->wid" 1
13b0: 20 20 20 20 20 28 74 77 69 6b 69 3a 6e 61 6d 65 (twiki:name
13c0: 2d 3e 77 69 64 20 2a 74 64 62 2a 20 22 6d 61 69 ->wid *tdb* "mai
13d0: 6e 22 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b n")).(test "twik
13e0: 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 i:get-tiddlers-b
13f0: 79 2d 6e 75 6d 22 20 27 28 29 20 28 74 77 69 6b y-num" '() (twik
1400: 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 i:get-tiddlers-b
1410: 79 2d 6e 75 6d 20 20 2a 74 64 62 2a 20 30 20 28 y-num *tdb* 0 (
1420: 6c 69 73 74 20 31 20 32 20 33 29 29 29 0a 28 74 list 1 2 3))).(t
1430: 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 74 est "twiki:get-t
1440: 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 22 iddlers-by-name"
1450: 20 27 28 29 20 28 74 77 69 6b 69 3a 67 65 74 2d '() (twiki:get-
1460: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 tiddlers-by-name
1470: 20 2a 74 64 62 2a 20 30 20 22 4d 61 69 6e 4d 65 *tdb* 0 "MainMe
1480: 6e 75 22 29 29 0a 28 74 65 73 74 20 22 74 77 69 nu")).(test "twi
1490: 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 22 ki:get-tiddlers"
14a0: 20 20 27 28 29 20 20 28 74 77 69 6b 69 3a 67 65 '() (twiki:ge
14b0: 74 2d 74 69 64 64 6c 65 72 73 20 2a 74 64 62 2a t-tiddlers *tdb*
14c0: 20 30 20 28 6c 69 73 74 20 22 4d 61 69 6e 4d 65 0 (list "MainMe
14d0: 6e 75 22 29 29 29 0a 28 74 65 73 74 20 22 74 77 nu"))).(test "tw
14e0: 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 iki:get-tiddlers
14f0: 22 20 20 27 28 29 20 20 28 74 77 69 6b 69 3a 67 " '() (twiki:g
1500: 65 74 2d 74 69 64 64 6c 65 72 73 20 2a 74 64 62 et-tiddlers *tdb
1510: 2a 20 30 20 28 6c 69 73 74 20 22 4d 61 69 6e 4d * 0 (list "MainM
1520: 65 6e 75 22 20 22 41 6e 6f 74 68 65 72 4f 6e 65 enu" "AnotherOne
1530: 22 29 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b "))).(test "twik
1540: 69 3a 77 69 6b 69 22 20 22 3c 54 41 42 4c 45 3e i:wiki" "<TABLE>
1550: 22 20 20 20 20 20 28 63 61 72 20 28 74 77 69 6b " (car (twik
1560: 69 3a 77 69 6b 69 20 22 6d 61 69 6e 22 20 28 6c i:wiki "main" (l
1570: 69 73 74 20 22 62 6c 61 68 22 20 31 20 27 6e 61 ist "blah" 1 'na
1580: 64 61 29 29 29 29 0a 28 74 65 73 74 20 22 74 77 da)))).(test "tw
1590: 69 6b 69 3a 76 69 65 77 22 20 20 22 3c 44 49 56 iki:view" "<DIV
15a0: 20 63 6c 61 73 73 3d 5c 22 6e 6f 64 65 5c 22 3e class=\"node\">
15b0: 22 20 28 63 61 72 20 28 74 77 69 6b 69 3a 76 69 " (car (twiki:vi
15c0: 65 77 20 22 22 20 22 22 20 30 20 28 74 77 69 6b ew "" "" 0 (twik
15d0: 69 3a 74 69 64 64 6c 65 72 2d 6d 61 6b 65 29 20 i:tiddler-make)
15e0: 77 69 6b 69 29 29 29 0a 0a 28 74 65 73 74 20 22 wiki)))..(test "
15f0: 73 3a 74 64 22 20 20 20 20 20 20 20 20 20 20 20 s:td"
1600: 20 20 20 27 28 22 3c 54 44 3e 22 20 28 28 29 29 '("<TD>" (())
1610: 20 22 3c 2f 54 44 3e 22 29 20 28 73 3a 74 64 20 "</TD>") (s:td
1620: 27 28 29 29 29 0a 3b 3b 20 28 74 65 73 74 20 22 '())).;; (test "
1630: 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 twiki:get-tiddle
1640: 72 73 2d 62 79 2d 6e 61 6d 65 22 20 27 28 29 20 rs-by-name" '()
1650: 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c (twiki:get-tiddl
1660: 65 72 73 2d 62 79 2d 6e 61 6d 65 20 31 20 22 66 ers-by-name 1 "f
1670: 72 65 64 22 29 29 0a 28 74 65 73 74 20 22 74 77 red")).(test "tw
1680: 69 6b 69 3a 74 69 64 64 6c 65 72 2d 6e 61 6d 65 iki:tiddler-name
1690: 2d 3e 69 64 22 20 31 20 28 74 77 69 6b 69 3a 74 ->id" 1 (twiki:t
16a0: 69 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e 69 64 20 iddler-name->id
16b0: 2a 74 64 62 2a 20 22 4d 61 69 6e 4d 65 6e 75 22 *tdb* "MainMenu"
16c0: 29 29 0a 28 74 65 73 74 20 22 73 3a 73 65 74 21 )).(test "s:set!
16d0: 20 61 20 76 61 72 20 74 6f 20 23 66 22 20 20 20 a var to #f"
16e0: 20 20 22 22 0a 20 20 20 20 20 20 28 62 65 67 69 "". (begi
16f0: 6e 20 28 73 3a 73 65 74 21 20 22 42 4c 41 48 22 n (s:set! "BLAH"
1700: 20 23 66 29 0a 09 20 20 20 20 20 28 73 3a 67 65 #f).. (s:ge
1710: 74 20 22 42 4c 41 48 22 29 29 29 20 3b 3b 20 64 t "BLAH"))) ;; d
1720: 6f 6e 27 74 20 6b 6e 6f 77 20 69 66 20 74 68 69 on't know if thi
1730: 73 20 6f 6e 65 20 6d 61 6b 65 73 20 73 65 6e 73 s one makes sens
1740: 65 2e 20 53 65 74 74 69 6e 67 20 74 6f 20 23 66 e. Setting to #f
1750: 20 73 68 6f 75 6c 64 20 72 65 61 6c 6c 79 20 64 should really d
1760: 65 6c 65 74 65 20 74 68 65 20 76 61 6c 75 65 0a elete the value.
1770: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 (test "twiki:sav
1780: 65 2d 64 61 74 22 20 20 20 20 20 20 20 20 20 20 e-dat"
1790: 20 32 20 20 20 20 20 20 20 20 28 74 77 69 6b 69 2 (twiki
17a0: 3a 73 61 76 65 2d 64 61 74 20 2a 74 64 62 2a 20 :save-dat *tdb*
17b0: 22 64 61 74 22 20 30 29 29 0a 28 74 65 73 74 20 "dat" 0)).(test
17c0: 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 22 20 "twiki:get-dat"
17d0: 20 20 20 20 20 20 20 20 20 20 20 22 64 61 74 22 "dat"
17e0: 20 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 (twiki:get-d
17f0: 61 74 20 2a 74 64 62 2a 20 32 29 29 0a 28 74 65 at *tdb* 2)).(te
1800: 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 st "twiki:get-da
1810: 74 22 20 20 20 20 20 20 20 20 20 20 20 20 23 66 t" #f
1820: 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a 67 65 (twiki:ge
1830: 74 2d 64 61 74 20 2a 74 64 62 2a 20 35 29 29 0a t-dat *tdb* 5)).
1840: 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 3a ;; (test "twiki:
1850: 67 65 74 2d 64 61 74 22 20 20 20 20 20 20 23 66 get-dat" #f
1860: 20 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 (twiki:get-d
1870: 61 74 20 2a 74 64 62 2a 20 23 66 29 29 0a 28 74 at *tdb* #f)).(t
1880: 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 2d est "twiki:save-
1890: 74 69 64 64 6c 65 72 22 20 20 20 20 20 20 20 23 tiddler" #
18a0: 74 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a 73 t (twiki:s
18b0: 61 76 65 2d 74 69 64 64 6c 65 72 20 2a 74 64 62 ave-tiddler *tdb
18c0: 2a 20 22 68 65 61 64 69 6e 67 22 20 22 62 6f 64 * "heading" "bod
18d0: 79 22 20 22 74 61 67 73 22 20 6b 65 79 20 30 29 y" "tags" key 0)
18e0: 29 0a 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b ).;; (test "twik
18f0: 69 3a 73 61 76 65 2d 63 75 72 72 2d 74 69 64 64 i:save-curr-tidd
1900: 6c 65 72 22 20 20 23 66 20 20 20 20 20 20 20 28 ler" #f (
1910: 74 77 69 6b 69 3a 73 61 76 65 2d 63 75 72 72 2d twiki:save-curr-
1920: 74 69 64 64 6c 65 72 20 2a 74 64 62 2a 20 31 29 tiddler *tdb* 1)
1930: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 65 ).(test "twiki:e
1940: 64 69 74 2d 74 77 69 64 64 6c 65 72 22 20 20 20 dit-twiddler"
1950: 20 20 20 23 74 20 20 20 20 20 20 20 28 6c 69 73 #t (lis
1960: 74 3f 20 28 74 77 69 6b 69 3a 65 64 69 74 2d 74 t? (twiki:edit-t
1970: 69 64 64 6c 65 72 20 2a 74 64 62 2a 20 6b 65 79 iddler *tdb* key
1980: 20 30 20 30 29 29 29 0a 28 74 65 73 74 20 22 74 0 0))).(test "t
1990: 77 69 6b 69 3a 6d 61 69 6e 74 5f 61 72 65 61 22 wiki:maint_area"
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 6d 61 (car (twiki:ma
19c0: 69 6e 74 5f 61 72 65 61 20 2a 74 64 62 2a 20 31 int_area *tdb* 1
19d0: 20 6b 65 79 20 77 69 6b 69 29 29 29 0a 28 74 65 key wiki))).(te
19e0: 73 74 20 22 74 77 69 6b 69 3a 70 69 63 5f 6d 67 st "twiki:pic_mg
19f0: 6d 74 22 20 20 20 20 20 20 20 20 20 20 20 22 3c mt" "<
1a00: 44 49 56 3e 22 20 20 28 63 61 72 20 28 74 77 69 DIV>" (car (twi
1a10: 6b 69 3a 70 69 63 5f 6d 67 6d 74 20 2a 74 64 62 ki:pic_mgmt *tdb
1a20: 2a 20 31 20 6b 65 79 29 29 29 0a 0a 3b 3b 20 67 * 1 key)))..;; g
1a30: 65 74 20 61 20 62 6c 6f 62 20 6a 70 67 20 74 6f et a blob jpg to
1a40: 20 70 72 6f 63 65 73 73 0a 28 64 65 66 69 6e 65 process.(define
1a50: 20 69 6e 70 32 20 28 6f 70 65 6e 2d 69 6e 70 75 inp2 (open-inpu
1a60: 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 6b 69 t-file "tests/ki
1a70: 61 74 6f 61 2e 70 6e 67 22 29 29 0a 28 64 65 66 atoa.png")).(def
1a80: 69 6e 65 20 64 61 74 20 20 28 73 74 72 69 6e 67 ine dat (string
1a90: 2d 3e 62 6c 6f 62 20 28 72 65 61 64 2d 73 74 72 ->blob (read-str
1aa0: 69 6e 67 20 23 66 20 69 6e 70 32 29 29 29 0a 28 ing #f inp2))).(
1ab0: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
1ac0: 20 69 6e 70 32 29 0a 0a 0a 28 74 65 73 74 20 22 inp2)...(test "
1ad0: 74 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 22 20 twiki:save-pic"
1ae0: 20 20 20 20 20 20 20 20 20 20 23 74 20 20 20 20 #t
1af0: 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 70 (twiki:save-p
1b00: 69 63 20 2a 74 64 62 2a 20 28 6c 69 73 74 20 22 ic *tdb* (list "
1b10: 6d 79 70 69 63 2e 6a 70 67 22 20 22 69 6d 61 67 mypic.jpg" "imag
1b20: 65 2f 6a 70 65 67 22 20 64 61 74 29 20 30 29 29 e/jpeg" dat) 0))
1b30: 20 3b 3b 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f ;; (string->blo
1b40: 62 20 22 74 65 73 74 69 6e 67 20 65 68 21 22 29 b "testing eh!")
1b50: 29 29 29 20 0a 3b 3b 20 28 74 65 73 74 20 22 74 ))) .;; (test "t
1b60: 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 72 wiki:save-pic-fr
1b70: 6f 6d 2d 66 6f 72 6d 22 20 23 66 20 20 20 20 20 om-form" #f
1b80: 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 70 69 (twiki:save-pi
1b90: 63 2d 66 72 6f 6d 2d 66 6f 72 6d 20 2a 74 64 62 c-from-form *tdb
1ba0: 2a 20 31 29 29 0a 0a 3b 3b 20 6d 6f 72 65 20 74 * 1))..;; more t
1bb0: 65 73 74 73 20 6f 6e 20 64 61 74 73 0a 0a 28 64 ests on dats..(d
1bc0: 65 66 69 6e 65 20 64 61 74 20 23 66 29 0a 28 6c efine dat #f).(l
1bd0: 65 74 20 28 28 69 6e 70 20 28 6f 70 65 6e 2d 69 et ((inp (open-i
1be0: 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 nput-file "tests
1bf0: 2f 6b 69 61 74 6f 61 2e 70 6e 67 22 29 29 29 0a /kiatoa.png"))).
1c00: 20 20 28 73 65 74 21 20 64 61 74 20 28 72 65 61 (set! dat (rea
1c10: 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 29 d-string #f inp)
1c20: 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 74 ). (close-input
1c30: 2d 70 6f 72 74 20 69 6e 70 29 29 0a 28 75 73 65 -port inp)).(use
1c40: 20 6d 64 35 29 0a 28 64 65 66 69 6e 65 20 64 61 md5).(define da
1c50: 74 2d 6d 64 35 20 28 6d 64 35 3a 64 69 67 65 73 t-md5 (md5:diges
1c60: 74 20 64 61 74 29 29 0a 28 74 65 73 74 20 22 74 t dat)).(test "t
1c70: 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 20 28 62 wiki:save-dat (b
1c80: 69 6e 61 72 79 29 22 20 34 20 20 20 20 20 20 20 inary)" 4
1c90: 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 (twiki:save-dat
1ca0: 20 2a 74 64 62 2a 20 64 61 74 20 31 29 29 0a 28 *tdb* dat 1)).(
1cb0: 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d test "twiki:get-
1cc0: 64 61 74 20 28 62 69 6e 61 72 79 29 22 20 20 64 dat (binary)" d
1cd0: 61 74 2d 6d 64 35 20 20 28 6c 65 74 20 28 28 64 at-md5 (let ((d
1ce0: 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 (twiki:get-dat
1cf0: 2a 74 64 62 2a 20 34 29 29 29 0a 09 09 09 09 09 *tdb* 4)))......
1d00: 20 20 20 28 6d 64 35 3a 64 69 67 65 73 74 20 64 (md5:digest d
1d10: 29 29 29 0a 3b 3b 20 66 6f 72 6d 73 0a 3b 3b 20 ))).;; forms.;;
1d20: 28 64 65 66 69 6e 65 20 69 6e 70 20 28 6f 70 65 (define inp (ope
1d30: 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 n-input-file "te
1d40: 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 6f 73 74 sts/example.post
1d50: 2e 69 6e 22 29 29 0a 3b 3b 20 28 64 65 66 69 6e .in")).;; (defin
1d60: 65 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 e dat (read-stri
1d70: 6e 67 20 23 66 20 69 6e 70 29 29 0a 3b 3b 20 28 ng #f inp)).;; (
1d80: 64 65 66 69 6e 65 20 64 61 74 73 74 72 20 28 6f define datstr (o
1d90: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
1da0: 20 64 61 74 29 29 0a 0a 3b 3b 20 62 69 6e 61 72 dat))..;; binar
1db0: 79 20 69 6e 70 75 74 73 0a 28 64 65 66 69 6e 65 y inputs.(define
1dc0: 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 inp (open-input
1dd0: 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 78 61 -file "tests/exa
1de0: 6d 70 6c 65 2e 70 6f 73 74 2e 62 69 6e 61 72 79 mple.post.binary
1df0: 2e 69 6e 22 29 29 0a 28 64 65 66 69 6e 65 20 64 .in")).(define d
1e00: 61 74 20 23 66 29 0a 0a 28 74 65 73 74 20 22 66 at #f)..(test "f
1e10: 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d ormdat:load-all-
1e20: 70 6f 72 74 20 6d 75 6c 74 69 70 61 72 74 22 20 port multipart"
1e30: 23 74 20 28 6c 65 74 20 28 28 69 64 61 74 20 28 #t (let ((idat (
1e40: 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c formdat:load-all
1e50: 2d 70 6f 72 74 20 69 6e 70 29 29 29 0a 09 09 09 -port inp)))....
1e60: 09 20 20 20 28 73 65 74 21 20 64 61 74 20 69 64 . (set! dat id
1e70: 61 74 29 0a 09 09 09 09 20 20 20 23 74 29 29 0a at)..... #t)).
1e80: 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 3a 6b (test "formdat:k
1e90: 65 79 73 22 20 27 28 70 69 63 74 75 72 65 2d 6e eys" '(picture-n
1ea0: 61 6d 65 20 69 6e 70 75 74 2d 70 69 63 74 75 72 ame input-pictur
1eb0: 65 20 22 22 20 73 75 62 6d 69 74 2d 70 69 63 74 e "" submit-pict
1ec0: 75 72 65 29 20 28 66 6f 72 6d 64 61 74 3a 6b 65 ure) (formdat:ke
1ed0: 79 73 20 64 61 74 29 29 0a 0a 28 64 65 66 69 6e ys dat))..(defin
1ee0: 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 e inp (open-inpu
1ef0: 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 78 t-file "tests/ex
1f00: 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 29 ample.post.in"))
1f10: 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 3a .(test "formdat:
1f20: 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 73 69 load-all-port si
1f30: 6e 67 6c 65 20 70 61 72 74 22 20 23 74 20 28 6c ngle part" #t (l
1f40: 65 74 20 28 28 69 64 61 74 20 28 66 6f 72 6d 64 et ((idat (formd
1f50: 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 at:load-all-port
1f60: 20 69 6e 70 29 29 29 0a 09 09 09 09 20 20 20 28 inp)))..... (
1f70: 73 65 74 21 20 64 61 74 20 69 64 61 74 29 0a 09 set! dat idat)..
1f80: 09 09 09 20 20 20 23 74 29 29 0a 28 74 65 73 74 ... #t)).(test
1f90: 20 22 66 6f 72 6d 64 61 74 3a 6b 65 79 73 22 20 "formdat:keys"
1fa0: 27 28 65 6d 61 69 6c 2d 61 64 64 72 65 73 73 20 '(email-address
1fb0: 66 6f 72 6d 2d 6e 61 6d 65 20 70 61 73 73 77 6f form-name passwo
1fc0: 72 64 29 20 28 66 6f 72 6d 64 61 74 3a 6b 65 79 rd) (formdat:key
1fd0: 73 20 64 61 74 29 29 0a 0a 28 63 6c 6f 73 65 2d s dat))..(close-
1fe0: 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a input-port inp).