Artifact
5b953a70349f0ea00db9aa5e1eb7f16a921f469b:
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 3b 3b 20 28 72 65 71 75 69 72 65 2d ))..;; (require-
01c0: 6c 69 62 72 61 72 79 20 64 62 69 29 0a 28 75 73 library dbi).(us
01d0: 65 20 28 70 72 65 66 69 78 20 64 62 69 20 64 62 e (prefix dbi db
01e0: 69 3a 29 29 0a 0a 28 6c 6f 61 64 20 22 2e 2f 72 i:))..(load "./r
01f0: 65 71 75 69 72 65 6d 65 6e 74 73 2e 73 63 6d 22 equirements.scm"
0200: 29 0a 28 6c 6f 61 64 20 22 2e 2f 63 6f 6f 6b 69 ).(load "./cooki
0210: 65 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e e.scm").(load ".
0220: 2f 6d 69 73 63 2d 73 74 6d 6c 2e 73 63 6d 22 29 /misc-stml.scm")
0230: 0a 28 6c 6f 61 64 20 22 2e 2f 66 6f 72 6d 64 61 .(load "./formda
0240: 74 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e t.scm").(load ".
0250: 2f 73 74 6d 6c 2e 73 63 6d 22 29 0a 28 6c 6f 61 /stml.scm").(loa
0260: 64 20 22 2e 2f 73 65 73 73 69 6f 6e 2e 73 63 6d d "./session.scm
0270: 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 73 71 6c 74 ").(load "./sqlt
0280: 62 6c 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 bl.scm").(load "
0290: 2e 2f 68 74 6d 6c 2d 66 69 6c 74 65 72 2e 73 63 ./html-filter.sc
02a0: 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 6b 65 79 m").(load "./key
02b0: 73 74 6f 72 65 2e 73 63 6d 22 29 0a 0a 3b 3b 20 store.scm")..;;
02c0: 54 65 73 74 20 74 68 65 20 70 72 69 6d 69 74 69 Test the primiti
02d0: 76 65 20 64 62 69 20 69 6e 74 65 72 66 61 63 65 ve dbi interface
02e0: 0a 0a 28 73 79 73 74 65 6d 20 22 72 6d 20 2d 66 ..(system "rm -f
02f0: 20 74 65 73 74 73 2f 74 65 73 74 2e 64 62 22 29 tests/test.db")
0300: 0a 28 64 65 66 69 6e 65 20 64 62 20 28 64 62 69 .(define db (dbi
0310: 3a 6f 70 65 6e 20 27 73 71 6c 69 74 65 33 20 27 :open 'sqlite3 '
0320: 28 28 64 62 6e 61 6d 65 20 2e 20 22 74 65 73 74 ((dbname . "test
0330: 73 2f 74 65 73 74 2e 64 62 22 29 29 29 29 0a 28 s/test.db")))).(
0340: 64 62 69 3a 65 78 65 63 20 64 62 20 22 43 52 45 dbi:exec db "CRE
0350: 41 54 45 20 54 41 42 4c 45 20 66 6f 6f 28 69 64 ATE TABLE foo(id
0360: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
0370: 20 4b 45 59 2c 6e 61 6d 65 20 54 45 58 54 29 3b KEY,name TEXT);
0380: 22 29 0a 28 64 62 69 3a 65 78 65 63 20 64 62 20 ").(dbi:exec db
0390: 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 66 6f 6f "INSERT INTO foo
03a0: 28 6e 61 6d 65 29 20 56 41 4c 55 45 53 28 3f 29 (name) VALUES(?)
03b0: 3b 22 20 22 4d 61 74 74 22 29 0a 28 64 62 69 3a ;" "Matt").(dbi:
03c0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 28 for-each-row . (
03d0: 6c 61 6d 62 64 61 20 28 74 75 70 6c 65 29 0a 20 lambda (tuple).
03e0: 20 20 28 70 72 69 6e 74 20 28 76 65 63 74 6f 72 (print (vector
03f0: 2d 72 65 66 20 74 75 70 6c 65 20 30 29 20 22 20 -ref tuple 0) "
0400: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 75 " (vector-ref tu
0410: 70 6c 65 20 31 29 29 29 0a 20 64 62 20 22 53 45 ple 1))). db "SE
0420: 4c 45 43 54 20 2a 20 46 52 4f 4d 20 66 6f 6f 3b LECT * FROM foo;
0430: 22 29 0a 28 74 65 73 74 20 22 64 62 69 3a 67 65 ").(test "dbi:ge
0440: 74 2d 6f 6e 65 22 20 22 4d 61 74 74 22 20 28 64 t-one" "Matt" (d
0450: 62 69 3a 67 65 74 2d 6f 6e 65 20 64 62 20 22 53 bi:get-one db "S
0460: 45 4c 45 43 54 20 6e 61 6d 65 20 46 52 4f 4d 20 ELECT name FROM
0470: 66 6f 6f 20 57 48 45 52 45 20 6e 61 6d 65 3d 27 foo WHERE name='
0480: 4d 61 74 74 27 3b 22 29 29 0a 0a 3b 3b 20 6b 65 Matt';"))..;; ke
0490: 79 73 74 6f 72 65 0a 28 64 62 69 3a 65 78 65 63 ystore.(dbi:exec
04a0: 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c db "CREATE TABL
04b0: 45 20 6d 65 74 61 64 61 74 61 20 28 69 64 20 49 E metadata (id I
04c0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
04d0: 45 59 2c 6b 65 79 20 54 45 58 54 2c 76 61 6c 75 EY,key TEXT,valu
04e0: 65 20 54 45 58 54 29 3b 22 29 0a 0a 28 6b 65 79 e TEXT);")..(key
04f0: 73 74 6f 72 65 3a 73 65 74 21 20 64 62 20 22 53 store:set! db "S
0500: 43 48 45 4d 41 2d 56 45 52 53 49 4f 4e 22 20 31 CHEMA-VERSION" 1
0510: 2e 32 29 0a 28 74 65 73 74 20 22 4b 65 79 73 74 .2).(test "Keyst
0520: 6f 72 65 20 67 65 74 22 20 22 31 2e 32 22 20 20 ore get" "1.2"
0530: 28 6b 65 79 73 74 6f 72 65 3a 67 65 74 20 20 64 (keystore:get d
0540: 62 20 22 53 43 48 45 4d 41 2d 56 45 52 53 49 4f b "SCHEMA-VERSIO
0550: 4e 22 29 29 0a 28 6b 65 79 73 74 6f 72 65 3a 64 N")).(keystore:d
0560: 65 6c 21 20 64 62 20 22 53 43 48 45 4d 41 2d 56 el! db "SCHEMA-V
0570: 45 52 53 49 4f 4e 22 29 20 0a 28 74 65 73 74 20 ERSION") .(test
0580: 22 4b 65 79 73 74 6f 72 65 20 67 65 74 20 64 65 "Keystore get de
0590: 6c 65 74 65 64 22 20 23 66 20 28 6b 65 79 73 74 leted" #f (keyst
05a0: 6f 72 65 3a 67 65 74 20 64 62 20 22 53 43 48 45 ore:get db "SCHE
05b0: 4d 41 2d 56 45 52 53 49 4f 4e 22 29 29 0a 0a 28 MA-VERSION"))..(
05c0: 73 79 73 74 65 6d 20 22 72 6d 20 2d 66 20 74 65 system "rm -f te
05d0: 73 74 73 2f 74 65 73 74 2e 64 62 22 29 0a 0a 3b sts/test.db")..;
05e0: 3b 20 63 72 65 61 74 65 20 61 20 73 65 73 73 69 ; create a sessi
05f0: 6f 6e 20 74 6f 20 77 6f 72 6b 20 77 69 74 68 22 on to work with"
0600: 29 0a 28 73 65 74 65 6e 76 20 22 52 45 51 55 45 ).(setenv "REQUE
0610: 53 54 5f 55 52 49 22 20 22 2f 73 74 6d 6c 72 75 ST_URI" "/stmlru
0620: 6e 3f 61 63 74 69 6f 6e 3d 74 65 73 74 2e 74 65 n?action=test.te
0630: 73 74 22 29 0a 28 73 65 74 65 6e 76 20 22 53 43 st").(setenv "SC
0640: 52 49 50 54 5f 4e 41 4d 45 22 20 22 2f 63 67 69 RIPT_NAME" "/cgi
0650: 2d 62 69 6e 2f 73 74 6d 6c 72 75 6e 22 29 0a 28 -bin/stmlrun").(
0660: 73 65 74 65 6e 76 20 22 50 41 54 48 5f 49 4e 46 setenv "PATH_INF
0670: 4f 22 20 22 2f 74 65 73 74 22 29 0a 28 73 65 74 O" "/test").(set
0680: 65 6e 76 20 22 51 55 45 52 59 5f 53 54 52 49 4e env "QUERY_STRIN
0690: 47 22 20 22 61 63 74 69 6f 6e 3d 74 65 73 74 2e G" "action=test.
06a0: 74 65 73 74 22 29 0a 28 73 65 74 65 6e 76 20 22 test").(setenv "
06b0: 53 45 52 56 45 52 5f 4e 41 4d 45 22 20 22 6c 6f SERVER_NAME" "lo
06c0: 63 61 6c 68 6f 73 74 22 29 0a 28 73 65 74 65 6e calhost").(seten
06d0: 76 20 22 52 45 51 55 45 53 54 5f 4d 45 54 48 4f v "REQUEST_METHO
06e0: 44 22 20 22 47 45 54 22 29 0a 0a 28 6c 6f 61 64 D" "GET")..(load
06f0: 20 22 2e 2f 73 65 74 75 70 2e 73 63 6d 22 29 0a "./setup.scm").
0700: 0a 28 73 3a 76 61 6c 69 64 61 74 65 2d 69 6e 70 .(s:validate-inp
0710: 75 74 73 29 0a 0a 3b 3b 20 74 65 73 74 20 73 65 uts)..;; test se
0720: 73 73 69 6f 6e 20 76 61 72 69 61 62 6c 65 73 0a ssion variables.
0730: 0a 28 73 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 .(session:get-va
0740: 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 64 rs s:session).(d
0750: 65 66 69 6e 65 20 6e 61 64 61 20 22 61 6e 64 6e efine nada "andn
0760: 6e 64 68 68 73 68 61 61 73 22 29 0a 28 73 3a 73 ndhhshaas").(s:s
0770: 65 73 73 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 ession-var-set!
0780: 22 6e 69 63 6b 22 20 6e 61 64 61 29 0a 28 74 65 "nick" nada).(te
0790: 73 74 20 22 53 65 73 73 69 6f 6e 20 76 61 72 20 st "Session var
07a0: 73 65 74 2f 67 65 74 22 20 6e 61 64 61 20 20 28 set/get" nada (
07b0: 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 s:session-var-ge
07c0: 74 20 22 6e 69 63 6b 22 29 29 0a 28 70 72 69 6e t "nick")).(prin
07d0: 74 20 22 67 6f 74 20 68 65 72 65 22 29 0a 28 73 t "got here").(s
07e0: 65 73 73 69 6f 6e 3a 73 61 76 65 2d 76 61 72 73 ession:save-vars
07f0: 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 73 65 73 s:session).(ses
0800: 73 69 6f 6e 3a 67 65 74 2d 76 61 72 73 20 20 73 sion:get-vars s
0810: 3a 73 65 73 73 69 6f 6e 29 0a 28 74 65 73 74 20 :session).(test
0820: 22 53 65 73 73 69 6f 6e 20 76 61 72 20 73 65 74 "Session var set
0830: 2f 67 65 74 20 61 66 74 65 72 20 73 61 76 65 2f /get after save/
0840: 67 65 74 22 20 6e 61 64 61 20 28 73 3a 73 65 73 get" nada (s:ses
0850: 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 22 6e 69 sion-var-get "ni
0860: 63 6b 22 29 29 0a 28 73 65 73 73 69 6f 6e 3a 64 ck")).(session:d
0870: 65 6c 21 20 73 3a 73 65 73 73 69 6f 6e 20 22 2a el! s:session "*
0880: 73 65 73 73 69 6f 6e 76 61 72 73 2a 22 20 22 6e sessionvars*" "n
0890: 69 63 6b 22 29 0a 28 74 65 73 74 20 22 53 65 73 ick").(test "Ses
08a0: 73 69 6f 6e 20 76 61 72 20 64 65 6c 22 20 20 20 sion var del"
08b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08c0: 20 23 66 20 20 20 28 73 3a 73 65 73 73 69 6f 6e #f (s:session
08d0: 2d 76 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 -var-get "nick")
08e0: 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 2d ).(session:save-
08f0: 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 0a vars s:session).
0900: 28 73 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 72 (session:get-var
0910: 73 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 73 3a s s:session).(s:
0920: 73 65 73 73 69 6f 6e 2d 76 61 72 2d 73 65 74 21 session-var-set!
0930: 20 22 6e 69 63 6b 22 20 6e 61 64 61 29 0a 28 73 "nick" nada).(s
0940: 65 73 73 69 6f 6e 3a 73 61 76 65 2d 76 61 72 73 ession:save-vars
0950: 20 73 3a 73 65 73 73 69 6f 6e 29 0a 0a 3b 3b 20 s:session)..;;
0960: 28 74 65 73 74 20 22 53 65 73 73 69 6f 6e 20 76 (test "Session v
0970: 61 72 20 64 65 6c 22 20 20 20 20 20 20 20 20 20 ar del"
0980: 20 20 20 20 20 20 20 20 20 20 20 23 66 20 20 20 #f
0990: 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 (s:session-var-g
09a0: 65 74 20 22 6e 69 63 6b 22 29 29 0a 0a 3b 3b 20 et "nick"))..;;
09b0: 74 65 73 74 20 70 65 72 73 6f 6e 0a 0a 28 6c 6f test person..(lo
09c0: 61 64 20 22 2e 2f 74 65 73 74 73 2f 6d 6f 64 65 ad "./tests/mode
09d0: 6c 73 2f 74 65 73 74 2e 73 63 6d 22 29 0a 0a 28 ls/test.scm")..(
09e0: 70 72 69 6e 74 20 22 53 65 73 73 69 6f 6e 20 6b print "Session k
09f0: 65 79 20 69 73 20 22 20 28 73 64 61 74 2d 67 65 ey is " (sdat-ge
0a00: 74 2d 73 65 73 73 69 6f 6e 2d 6b 65 79 20 73 3a t-session-key s:
0a10: 73 65 73 73 69 6f 6e 29 29 0a 0a 28 74 65 73 74 session))..(test
0a20: 20 22 44 65 6c 65 74 65 20 73 65 73 73 69 6f 6e "Delete session
0a30: 22 20 23 74 20 28 73 3a 64 65 6c 65 74 65 2d 73 " #t (s:delete-s
0a40: 65 73 73 69 6f 6e 29 29 0a 0a 28 6c 65 74 20 28 ession))..(let (
0a50: 28 66 68 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d (fh (open-input-
0a60: 70 69 70 65 20 22 6c 73 20 2e 2f 74 65 73 74 73 pipe "ls ./tests
0a70: 2f 70 61 67 65 73 2f 2a 2f 63 6f 6e 74 72 6f 6c /pages/*/control
0a80: 2e 73 63 6d 22 29 29 29 0a 20 20 28 6c 65 74 20 .scm"))). (let
0a90: 6c 6f 6f 70 20 28 28 6c 20 28 72 65 61 64 2d 6c loop ((l (read-l
0aa0: 69 6e 65 20 66 68 29 29 29 0a 20 20 20 20 28 69 ine fh))). (i
0ab0: 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 f (not (eof-obje
0ac0: 63 74 3f 20 6c 29 29 0a 20 20 20 20 20 20 20 20 ct? l)).
0ad0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
0ae0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 6c 6f 61 64 ;; (print "load
0af0: 69 6e 67 20 22 20 6c 29 0a 20 20 20 20 20 20 20 ing " l).
0b00: 20 20 20 28 6c 6f 61 64 20 6c 29 0a 20 20 20 20 (load l).
0b10: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 (loop (rea
0b20: 64 2d 6c 69 6e 65 20 66 68 29 29 29 29 29 0a 20 d-line fh))))).
0b30: 20 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f (close-input-po
0b40: 72 74 20 66 68 29 29 0a 0a 3b 3b 20 53 68 6f 75 rt fh))..;; Shou
0b50: 6c 64 20 68 61 76 65 20 70 6f 6c 6c 3a 70 6f 6c ld have poll:pol
0b60: 6c 20 64 65 66 69 6e 65 64 20 6e 6f 77 2e 0a 28 l defined now..(
0b70: 74 65 73 74 20 22 4d 61 6b 65 20 61 20 72 61 6e test "Make a ran
0b80: 64 6f 6d 20 73 74 72 69 6e 67 22 20 32 20 28 73 dom string" 2 (s
0b90: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 73 65 tring-length (se
0ba0: 73 73 69 6f 6e 3a 6d 61 6b 65 2d 72 61 6e 64 2d ssion:make-rand-
0bb0: 73 74 72 69 6e 67 20 32 29 29 29 0a 28 74 65 73 string 2))).(tes
0bc0: 74 20 22 43 72 65 61 74 65 20 61 6e 20 65 6e 63 t "Create an enc
0bd0: 72 79 70 74 65 64 20 70 61 73 73 77 6f 72 64 20 rypted password
0be0: 75 73 69 6e 67 20 44 45 53 20 28 62 61 63 6b 77 using DES (backw
0bf0: 61 72 64 73 20 63 6f 6d 70 61 74 29 22 20 22 61 ards compat)" "a
0c00: 62 51 39 4b 59 2e 4b 66 72 59 72 63 22 20 28 73 bQ9KY.KfrYrc" (s
0c10: 3a 63 72 79 70 74 2d 70 61 73 73 77 64 20 22 66 :crypt-passwd "f
0c20: 6f 6f 22 20 22 61 62 22 29 29 0a 28 74 65 73 74 oo" "ab")).(test
0c30: 20 22 43 72 65 61 74 65 20 61 6e 20 65 6e 63 72 "Create an encr
0c40: 79 70 74 65 64 20 70 61 73 73 77 6f 72 64 20 75 ypted password u
0c50: 73 69 6e 67 20 42 6c 6f 77 66 69 73 68 22 20 22 sing Blowfish" "
0c60: 24 32 61 24 31 32 24 47 79 6f 4b 48 58 2f 55 4f $2a$12$GyoKHX/UO
0c70: 78 4d 4c 47 74 77 64 53 54 72 37 45 4f 46 39 4b xMLGtwdSTr7EOF9K
0c80: 51 7a 6c 79 79 79 52 71 46 54 4b 78 31 59 76 4c QzlyyyRqFTKx1YvL
0c90: 41 33 73 4d 75 6b 62 56 34 57 42 43 22 20 28 73 A3sMukbV4WBC" (s
0ca0: 3a 63 72 79 70 74 2d 70 61 73 73 77 64 20 22 66 :crypt-passwd "f
0cb0: 6f 6f 22 20 22 24 32 61 24 31 32 24 47 79 6f 4b oo" "$2a$12$GyoK
0cc0: 48 58 2f 55 4f 78 4d 4c 47 74 77 64 53 54 72 37 HX/UOxMLGtwdSTr7
0cd0: 45 4f 22 29 29 0a 0a 28 74 65 73 74 20 22 73 3a EO"))..(test "s:
0ce0: 61 6e 79 2d 3e 73 74 72 69 6e 67 20 6f 6e 20 61 any->string on a
0cf0: 20 68 61 73 68 2d 74 61 62 6c 65 22 20 22 23 3c hash-table" "#<
0d00: 68 61 73 68 2d 74 61 62 6c 65 3e 22 20 28 73 3a hash-table>" (s:
0d10: 61 6e 79 2d 3e 73 74 72 69 6e 67 20 28 6d 61 6b any->string (mak
0d20: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
0d30: 0a 28 64 65 66 69 6e 65 20 73 65 6c 65 63 74 2d .(define select-
0d40: 6c 69 73 74 0a 20 20 27 28 28 61 20 62 20 63 29 list. '((a b c)
0d50: 28 64 20 28 65 20 66 20 67 29 28 68 20 69 20 6a (d (e f g)(h i j
0d60: 20 23 74 29 29 29 29 0a 28 64 65 66 69 6e 65 20 #t)))).(define
0d70: 72 65 73 75 6c 74 20 27 28 22 3c 53 45 4c 45 43 result '("<SELEC
0d80: 54 20 6e 61 6d 65 3d 5c 22 65 66 67 5c 22 3e 22 T name=\"efg\">"
0d90: 20 0a 09 09 20 28 28 28 22 3c 4f 50 54 49 4f 4e ... ((("<OPTION
0da0: 20 6c 61 62 65 6c 3d 5c 22 61 5c 22 20 76 61 6c label=\"a\" val
0db0: 75 65 3d 5c 22 62 5c 22 3e 63 3c 2f 4f 50 54 49 ue=\"b\">c</OPTI
0dc0: 4f 4e 3e 22 29 20 0a 09 09 20 20 20 28 22 3c 4f ON>") ... ("<O
0dd0: 50 54 47 52 4f 55 50 20 6c 61 62 65 6c 3d 64 22 PTGROUP label=d"
0de0: 20 0a 09 09 20 20 20 20 28 22 3c 4f 50 54 49 4f ... ("<OPTIO
0df0: 4e 20 6c 61 62 65 6c 3d 5c 22 65 5c 22 20 76 61 N label=\"e\" va
0e00: 6c 75 65 3d 5c 22 66 5c 22 3e 67 3c 2f 4f 50 54 lue=\"f\">g</OPT
0e10: 49 4f 4e 3e 22 29 0a 09 09 20 20 20 20 28 22 3c ION>")... ("<
0e20: 4f 50 54 49 4f 4e 20 20 73 65 6c 65 63 74 65 64 OPTION selected
0e30: 20 6c 61 62 65 6c 3d 5c 22 68 5c 22 20 76 61 6c label=\"h\" val
0e40: 75 65 3d 5c 22 69 5c 22 3e 6a 3c 2f 4f 50 54 49 ue=\"i\">j</OPTI
0e50: 4f 4e 3e 22 29 20 0a 09 09 20 20 20 20 22 3c 2f ON>") ... "</
0e60: 4f 50 54 47 52 4f 55 50 3e 22 29 29 29 0a 09 09 OPTGROUP>")))...
0e70: 20 22 3c 2f 53 45 4c 45 43 54 3e 22 29 29 0a 0a "</SELECT>"))..
0e80: 28 74 65 73 74 20 22 53 65 6c 65 63 74 20 6c 69 (test "Select li
0e90: 73 74 22 20 72 65 73 75 6c 74 20 28 73 3a 73 65 st" result (s:se
0ea0: 6c 65 63 74 20 73 65 6c 65 63 74 2d 6c 69 73 74 lect select-list
0eb0: 20 27 6e 61 6d 65 20 22 65 66 67 22 29 29 0a 0a 'name "efg"))..
0ec0: 3b 3b 20 54 65 73 74 20 6d 6f 64 75 6c 65 73 0a ;; Test modules.
0ed0: 0a 28 74 65 73 74 20 22 6d 69 73 63 3a 6e 6f 6e .(test "misc:non
0ee0: 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 5c 22 5c -zero-string \"\
0ef0: 22 22 20 23 66 20 28 6d 69 73 63 3a 6e 6f 6e 2d "" #f (misc:non-
0f00: 7a 65 72 6f 2d 73 74 72 69 6e 67 20 22 22 29 29 zero-string ""))
0f10: 0a 28 74 65 73 74 20 22 6d 69 73 63 3a 6e 6f 6e .(test "misc:non
0f20: 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 23 66 22 -zero-string #f"
0f30: 20 23 66 20 28 6d 69 73 63 3a 6e 6f 6e 2d 7a 65 #f (misc:non-ze
0f40: 72 6f 2d 73 74 72 69 6e 67 20 23 66 29 29 0a 28 ro-string #f)).(
0f50: 74 65 73 74 20 22 6d 69 73 63 3a 6e 6f 6e 2d 7a test "misc:non-z
0f60: 65 72 6f 2d 73 74 72 69 6e 67 20 27 62 6c 61 68 ero-string 'blah
0f70: 22 20 23 66 20 28 6d 69 73 63 3a 6e 6f 6e 2d 7a " #f (misc:non-z
0f80: 65 72 6f 2d 73 74 72 69 6e 67 20 27 62 6c 61 68 ero-string 'blah
0f90: 29 29 0a 0a 3b 3b 20 66 6f 72 6d 73 0a 28 64 65 ))..;; forms.(de
0fa0: 66 69 6e 65 20 66 6f 72 6d 20 23 66 29 0a 28 74 fine form #f).(t
0fb0: 65 73 74 20 22 6d 61 6b 65 20 3c 66 6f 72 6d 64 est "make <formd
0fc0: 61 74 3e 22 20 23 74 20 28 6c 65 74 20 28 28 66 at>" #t (let ((f
0fd0: 20 28 6d 61 6b 65 2d 66 6f 72 6d 64 61 74 3a 66 (make-formdat:f
0fe0: 6f 72 6d 64 61 74 29 29 29 0a 09 09 09 20 20 20 ormdat)))....
0ff0: 20 28 73 65 74 21 20 66 6f 72 6d 20 66 29 0a 09 (set! form f)..
1000: 09 09 20 20 20 20 23 74 29 29 0a 28 74 65 73 74 .. #t)).(test
1010: 20 22 66 6f 72 6d 64 61 74 3a 20 73 65 74 21 2f "formdat: set!/
1020: 67 65 74 22 20 22 59 65 70 21 22 20 28 62 65 67 get" "Yep!" (beg
1030: 69 6e 0a 09 09 09 09 20 20 20 28 66 6f 72 6d 64 in..... (formd
1040: 61 74 3a 73 65 74 21 20 66 6f 72 6d 20 22 62 6c at:set! form "bl
1050: 61 68 22 20 22 59 65 70 21 22 29 0a 09 09 09 09 ah" "Yep!").....
1060: 20 20 20 28 66 6f 72 6d 64 61 74 3a 67 65 74 20 (formdat:get
1070: 20 66 6f 72 6d 20 22 62 6c 61 68 22 29 29 29 0a form "blah"))).
1080: 0a 28 74 65 73 74 20 22 73 3a 73 74 72 69 6e 67 .(test "s:string
1090: 2d 3e 70 67 69 6e 74 22 20 20 20 31 32 33 20 28 ->pgint" 123 (
10a0: 73 3a 61 6e 79 2d 3e 70 67 69 6e 74 20 22 31 32 s:any->pgint "12
10b0: 33 22 29 29 0a 28 74 65 73 74 20 22 73 3a 69 6c 3")).(test "s:il
10c0: 6c 65 67 61 6c 2d 70 67 69 6e 74 20 28 6c 65 67 legal-pgint (leg
10d0: 61 6c 29 22 20 20 20 20 20 20 20 20 23 66 20 28 al)" #f (
10e0: 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 s:illegal-pgint
10f0: 31 30 31 31 29 29 0a 28 74 65 73 74 20 22 73 3a 1011)).(test "s:
1100: 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 28 69 illegal-pgint (i
1110: 6c 6c 65 67 61 6c 20 62 69 67 29 22 20 20 20 31 llegal big)" 1
1120: 20 28 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e (s:illegal-pgin
1130: 74 20 20 39 39 39 39 39 39 39 39 39 39 29 29 0a t 9999999999)).
1140: 28 74 65 73 74 20 22 73 3a 69 6c 6c 65 67 61 6c (test "s:illegal
1150: 70 67 69 6e 74 20 28 69 6c 6c 65 67 61 6c 20 73 pgint (illegal s
1160: 6d 61 6c 6c 29 22 20 2d 31 20 28 73 3a 69 6c 6c mall)" -1 (s:ill
1170: 65 67 61 6c 2d 70 67 69 6e 74 20 2d 39 39 39 39 egal-pgint -9999
1180: 39 39 39 39 39 39 29 29 0a 0a 3b 3b 20 54 68 65 999999))..;; The
1190: 20 74 77 69 6b 69 20 6d 6f 64 75 6c 65 0a 0a 3b twiki module..;
11a0: 3b 20 63 6c 65 61 6e 20 75 70 0a 28 73 79 73 74 ; clean up.(syst
11b0: 65 6d 20 22 72 6d 20 2d 72 66 20 74 77 69 6b 69 em "rm -rf twiki
11c0: 73 2f 2a 22 29 0a 28 6c 6f 61 64 20 22 6d 6f 64 s/*").(load "mod
11d0: 75 6c 65 73 2f 74 77 69 6b 69 2f 74 77 69 6b 69 ules/twiki/twiki
11e0: 2d 6d 6f 64 2e 73 63 6d 22 29 0a 28 64 65 66 69 -mod.scm").(defi
11f0: 6e 65 20 6b 65 79 73 20 28 6c 69 73 74 20 22 62 ne keys (list "b
1200: 6c 61 68 22 20 31 20 27 6e 61 64 61 29 29 0a 28 lah" 1 'nada)).(
1210: 74 65 73 74 20 22 74 77 69 6b 69 3a 6b 65 79 73 test "twiki:keys
1220: 2d 3e 6b 65 79 22 20 20 22 62 6c 61 68 20 31 20 ->key" "blah 1
1230: 6e 61 64 61 22 20 28 74 77 69 6b 69 3a 6b 65 79 nada" (twiki:key
1240: 73 2d 3e 6b 65 79 20 6b 65 79 73 29 29 0a 28 64 s->key keys)).(d
1250: 65 66 69 6e 65 20 6b 65 79 20 28 74 77 69 6b 69 efine key (twiki
1260: 3a 6b 65 79 73 2d 3e 6b 65 79 20 6b 65 79 73 29 :keys->key keys)
1270: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 64 62 2a )..(define *tdb*
1280: 20 23 66 29 0a 28 74 65 73 74 20 22 74 77 69 6b #f).(test "twik
1290: 69 3a 6f 70 65 6e 2d 64 62 22 20 20 20 23 74 20 i:open-db" #t
12a0: 28 6c 65 74 20 28 28 64 62 20 28 74 77 69 6b 69 (let ((db (twiki
12b0: 3a 6f 70 65 6e 2d 64 62 20 6b 65 79 29 29 29 0a :open-db key))).
12c0: 09 09 09 20 20 20 20 20 28 73 65 74 21 20 2a 74 ... (set! *t
12d0: 64 62 2a 20 64 62 29 0a 09 09 09 20 20 20 20 20 db* db)....
12e0: 28 69 66 20 2a 74 64 62 2a 20 23 74 20 23 66 29 (if *tdb* #t #f)
12f0: 29 29 0a 28 64 65 66 69 6e 65 20 77 69 6b 69 20 )).(define wiki
1300: 28 6d 61 6b 65 2d 74 77 69 6b 69 3a 77 69 6b 69 (make-twiki:wiki
1310: 29 29 0a 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 )).(twiki:wiki-s
1320: 65 74 2d 77 69 64 21 20 77 69 6b 69 20 31 29 0a et-wid! wiki 1).
1330: 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d (twiki:wiki-set-
1340: 6e 61 6d 65 21 20 77 69 6b 69 20 22 6d 61 69 6e name! wiki "main
1350: 22 29 0a 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 ").(twiki:wiki-s
1360: 65 74 2d 70 65 72 6d 73 21 20 77 69 6b 69 20 27 et-perms! wiki '
1370: 28 72 20 77 29 29 0a 0a 28 74 65 73 74 20 22 74 (r w))..(test "t
1380: 77 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 22 20 wiki:dat->html"
1390: 27 28 22 48 65 6c 6c 6f 22 20 22 3c 42 52 3e 22 '("Hello" "<BR>"
13a0: 29 20 28 74 77 69 6b 69 3a 64 61 74 2d 3e 68 74 ) (twiki:dat->ht
13b0: 6d 6c 20 22 48 65 6c 6c 6f 22 20 77 69 6b 69 29 ml "Hello" wiki)
13c0: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 6b ).(test "twiki:k
13d0: 65 79 73 2d 3e 66 6e 61 6d 65 22 20 27 28 22 74 eys->fname" '("t
13e0: 77 69 6b 69 73 2f 59 6d 78 68 61 2f 43 41 78 49 wikis/Ymxha/CAxI
13f0: 47 2f 35 68 5a 47 45 22 20 22 59 6d 78 68 61 43 G/5hZGE" "YmxhaC
1400: 41 78 49 47 35 68 5a 47 45 5f 22 29 20 3b 3b 20 AxIG5hZGE_") ;;
1410: 28 22 74 77 69 6b 69 73 2f 64 39 39 61 32 64 65 ("twikis/d99a2de
1420: 39 2f 36 38 30 38 34 39 33 62 2f 32 33 37 37 30 9/6808493b/23770
1430: 66 37 30 22 20 22 64 39 39 61 32 64 65 39 36 38 f70" "d99a2de968
1440: 30 38 34 39 33 62 32 33 37 37 30 66 37 30 63 37 08493b23770f70c7
1450: 36 64 66 66 65 34 22 29 0a 20 20 20 20 20 20 28 6dffe4"). (
1460: 74 77 69 6b 69 3a 6b 65 79 2d 3e 66 6e 61 6d 65 twiki:key->fname
1470: 20 6b 65 79 29 29 0a 0a 28 74 65 73 74 20 22 74 key))..(test "t
1480: 77 69 6b 69 3a 6e 61 6d 65 2d 3e 77 69 64 22 20 wiki:name->wid"
1490: 20 20 20 20 31 20 20 20 20 20 28 74 77 69 6b 69 1 (twiki
14a0: 3a 6e 61 6d 65 2d 3e 77 69 64 20 2a 74 64 62 2a :name->wid *tdb*
14b0: 20 22 6d 61 69 6e 22 29 29 0a 28 74 65 73 74 20 "main")).(test
14c0: 22 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c "twiki:get-tiddl
14d0: 65 72 73 2d 62 79 2d 6e 75 6d 22 20 27 28 29 20 ers-by-num" '()
14e0: 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c (twiki:get-tiddl
14f0: 65 72 73 2d 62 79 2d 6e 75 6d 20 20 2a 74 64 62 ers-by-num *tdb
1500: 2a 20 30 20 28 6c 69 73 74 20 31 20 32 20 33 29 * 0 (list 1 2 3)
1510: 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )).(test "twiki:
1520: 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d get-tiddlers-by-
1530: 6e 61 6d 65 22 20 27 28 29 20 28 74 77 69 6b 69 name" '() (twiki
1540: 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 :get-tiddlers-by
1550: 2d 6e 61 6d 65 20 2a 74 64 62 2a 20 30 20 22 4d -name *tdb* 0 "M
1560: 61 69 6e 4d 65 6e 75 22 29 29 0a 28 74 65 73 74 ainMenu")).(test
1570: 20 22 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 "twiki:get-tidd
1580: 6c 65 72 73 22 20 20 27 28 29 20 20 28 74 77 69 lers" '() (twi
1590: 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 20 ki:get-tiddlers
15a0: 2a 74 64 62 2a 20 30 20 28 6c 69 73 74 20 22 4d *tdb* 0 (list "M
15b0: 61 69 6e 4d 65 6e 75 22 29 29 29 0a 28 74 65 73 ainMenu"))).(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 22 20 20 27 28 29 20 20 28 74 77 dlers" '() (tw
15e0: 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 iki:get-tiddlers
15f0: 20 2a 74 64 62 2a 20 30 20 28 6c 69 73 74 20 22 *tdb* 0 (list "
1600: 4d 61 69 6e 4d 65 6e 75 22 20 22 41 6e 6f 74 68 MainMenu" "Anoth
1610: 65 72 4f 6e 65 22 29 29 29 0a 28 74 65 73 74 20 erOne"))).(test
1620: 22 74 77 69 6b 69 3a 77 69 6b 69 22 20 22 3c 54 "twiki:wiki" "<T
1630: 41 42 4c 45 3e 22 20 20 20 20 20 28 63 61 72 20 ABLE>" (car
1640: 28 74 77 69 6b 69 3a 77 69 6b 69 20 22 6d 61 69 (twiki:wiki "mai
1650: 6e 22 20 28 6c 69 73 74 20 22 62 6c 61 68 22 20 n" (list "blah"
1660: 31 20 27 6e 61 64 61 29 29 29 29 0a 28 74 65 73 1 'nada)))).(tes
1670: 74 20 22 74 77 69 6b 69 3a 76 69 65 77 22 20 20 t "twiki:view"
1680: 22 3c 44 49 56 20 63 6c 61 73 73 3d 5c 22 6e 6f "<DIV class=\"no
1690: 64 65 5c 22 3e 22 20 28 63 61 72 20 28 74 77 69 de\">" (car (twi
16a0: 6b 69 3a 76 69 65 77 20 22 22 20 22 22 20 30 20 ki:view "" "" 0
16b0: 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 6d (twiki:tiddler-m
16c0: 61 6b 65 29 20 77 69 6b 69 29 29 29 0a 0a 28 74 ake) wiki)))..(t
16d0: 65 73 74 20 22 73 3a 74 64 22 20 20 20 20 20 20 est "s:td"
16e0: 20 20 20 20 20 20 20 20 27 28 22 3c 54 44 3e 22 '("<TD>"
16f0: 20 28 28 29 29 20 22 3c 2f 54 44 3e 22 29 20 28 (()) "</TD>") (
1700: 73 3a 74 64 20 27 28 29 29 29 0a 3b 3b 20 28 74 s:td '())).;; (t
1710: 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 74 est "twiki:get-t
1720: 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 22 iddlers-by-name"
1730: 20 27 28 29 20 28 74 77 69 6b 69 3a 67 65 74 2d '() (twiki:get-
1740: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 61 6d 65 tiddlers-by-name
1750: 20 31 20 22 66 72 65 64 22 29 29 0a 28 74 65 73 1 "fred")).(tes
1760: 74 20 22 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 t "twiki:tiddler
1770: 2d 6e 61 6d 65 2d 3e 69 64 22 20 31 20 28 74 77 -name->id" 1 (tw
1780: 69 6b 69 3a 74 69 64 64 6c 65 72 2d 6e 61 6d 65 iki:tiddler-name
1790: 2d 3e 69 64 20 2a 74 64 62 2a 20 22 4d 61 69 6e ->id *tdb* "Main
17a0: 4d 65 6e 75 22 29 29 0a 28 74 65 73 74 20 22 73 Menu")).(test "s
17b0: 3a 73 65 74 21 20 61 20 76 61 72 20 74 6f 20 23 :set! a var to #
17c0: 66 22 20 20 20 20 20 22 22 0a 20 20 20 20 20 20 f" "".
17d0: 28 62 65 67 69 6e 20 28 73 3a 73 65 74 21 20 22 (begin (s:set! "
17e0: 42 4c 41 48 22 20 23 66 29 0a 09 20 20 20 20 20 BLAH" #f)..
17f0: 28 73 3a 67 65 74 20 22 42 4c 41 48 22 29 29 29 (s:get "BLAH")))
1800: 20 3b 3b 20 64 6f 6e 27 74 20 6b 6e 6f 77 20 69 ;; don't know i
1810: 66 20 74 68 69 73 20 6f 6e 65 20 6d 61 6b 65 73 f this one makes
1820: 20 73 65 6e 73 65 2e 20 53 65 74 74 69 6e 67 20 sense. Setting
1830: 74 6f 20 23 66 20 73 68 6f 75 6c 64 20 72 65 61 to #f should rea
1840: 6c 6c 79 20 64 65 6c 65 74 65 20 74 68 65 20 76 lly delete the v
1850: 61 6c 75 65 0a 28 74 65 73 74 20 22 74 77 69 6b alue.(test "twik
1860: 69 3a 73 61 76 65 2d 64 61 74 22 20 20 20 20 20 i:save-dat"
1870: 20 20 20 20 20 20 32 20 20 20 20 20 20 20 20 28 2 (
1880: 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 20 2a twiki:save-dat *
1890: 74 64 62 2a 20 22 64 61 74 22 20 30 29 29 0a 28 tdb* "dat" 0)).(
18a0: 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d test "twiki:get-
18b0: 64 61 74 22 20 20 20 20 20 20 20 20 20 20 20 20 dat"
18c0: 22 64 61 74 22 20 20 20 20 28 74 77 69 6b 69 3a "dat" (twiki:
18d0: 67 65 74 2d 64 61 74 20 2a 74 64 62 2a 20 32 29 get-dat *tdb* 2)
18e0: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 ).(test "twiki:g
18f0: 65 74 2d 64 61 74 22 20 20 20 20 20 20 20 20 20 et-dat"
1900: 20 20 20 23 66 20 20 20 20 20 20 20 28 74 77 69 #f (twi
1910: 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 62 2a ki:get-dat *tdb*
1920: 20 35 29 29 0a 3b 3b 20 28 74 65 73 74 20 22 74 5)).;; (test "t
1930: 77 69 6b 69 3a 67 65 74 2d 64 61 74 22 20 20 20 wiki:get-dat"
1940: 20 20 20 23 66 20 20 20 20 28 74 77 69 6b 69 3a #f (twiki:
1950: 67 65 74 2d 64 61 74 20 2a 74 64 62 2a 20 23 66 get-dat *tdb* #f
1960: 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a )).(test "twiki:
1970: 73 61 76 65 2d 74 69 64 64 6c 65 72 22 20 20 20 save-tiddler"
1980: 20 20 20 20 23 74 20 20 20 20 20 20 20 28 74 77 #t (tw
1990: 69 6b 69 3a 73 61 76 65 2d 74 69 64 64 6c 65 72 iki:save-tiddler
19a0: 20 2a 74 64 62 2a 20 22 68 65 61 64 69 6e 67 22 *tdb* "heading"
19b0: 20 22 62 6f 64 79 22 20 22 74 61 67 73 22 20 6b "body" "tags" k
19c0: 65 79 20 30 29 29 0a 3b 3b 20 28 74 65 73 74 20 ey 0)).;; (test
19d0: 22 74 77 69 6b 69 3a 73 61 76 65 2d 63 75 72 72 "twiki:save-curr
19e0: 2d 74 69 64 64 6c 65 72 22 20 20 23 66 20 20 20 -tiddler" #f
19f0: 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d (twiki:save-
1a00: 63 75 72 72 2d 74 69 64 64 6c 65 72 20 2a 74 64 curr-tiddler *td
1a10: 62 2a 20 31 29 29 0a 28 74 65 73 74 20 22 74 77 b* 1)).(test "tw
1a20: 69 6b 69 3a 65 64 69 74 2d 74 77 69 64 64 6c 65 iki:edit-twiddle
1a30: 72 22 20 20 20 20 20 20 23 74 20 20 20 20 20 20 r" #t
1a40: 20 28 6c 69 73 74 3f 20 28 74 77 69 6b 69 3a 65 (list? (twiki:e
1a50: 64 69 74 2d 74 69 64 64 6c 65 72 20 2a 74 64 62 dit-tiddler *tdb
1a60: 2a 20 6b 65 79 20 30 20 30 29 29 29 0a 28 74 65 * key 0 0))).(te
1a70: 73 74 20 22 74 77 69 6b 69 3a 6d 61 69 6e 74 5f st "twiki:maint_
1a80: 61 72 65 61 22 20 20 20 20 20 20 20 20 20 22 3c area" "<
1a90: 44 49 56 3e 22 20 20 28 63 61 72 20 28 74 77 69 DIV>" (car (twi
1aa0: 6b 69 3a 6d 61 69 6e 74 5f 61 72 65 61 20 2a 74 ki:maint_area *t
1ab0: 64 62 2a 20 31 20 6b 65 79 20 77 69 6b 69 29 29 db* 1 key wiki))
1ac0: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 70 ).(test "twiki:p
1ad0: 69 63 5f 6d 67 6d 74 22 20 20 20 20 20 20 20 20 ic_mgmt"
1ae0: 20 20 20 22 3c 44 49 56 3e 22 20 20 28 63 61 72 "<DIV>" (car
1af0: 20 28 74 77 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 (twiki:pic_mgmt
1b00: 20 2a 74 64 62 2a 20 31 20 6b 65 79 29 29 29 0a *tdb* 1 key))).
1b10: 0a 3b 3b 20 67 65 74 20 61 20 62 6c 6f 62 20 6a .;; get a blob j
1b20: 70 67 20 74 6f 20 70 72 6f 63 65 73 73 0a 28 64 pg to process.(d
1b30: 65 66 69 6e 65 20 69 6e 70 32 20 28 6f 70 65 6e efine inp2 (open
1b40: 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 -input-file "tes
1b50: 74 73 2f 6b 69 61 74 6f 61 2e 70 6e 67 22 29 29 ts/kiatoa.png"))
1b60: 0a 28 64 65 66 69 6e 65 20 64 61 74 20 20 28 73 .(define dat (s
1b70: 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 28 72 65 61 tring->blob (rea
1b80: 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 32 d-string #f inp2
1b90: 29 29 29 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 ))).(close-input
1ba0: 2d 70 6f 72 74 20 69 6e 70 32 29 0a 0a 0a 28 74 -port inp2)...(t
1bb0: 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 2d est "twiki:save-
1bc0: 70 69 63 22 20 20 20 20 20 20 20 20 20 20 20 23 pic" #
1bd0: 74 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a 73 t (twiki:s
1be0: 61 76 65 2d 70 69 63 20 2a 74 64 62 2a 20 28 6c ave-pic *tdb* (l
1bf0: 69 73 74 20 22 6d 79 70 69 63 2e 6a 70 67 22 20 ist "mypic.jpg"
1c00: 22 69 6d 61 67 65 2f 6a 70 65 67 22 20 64 61 74 "image/jpeg" dat
1c10: 29 20 30 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 ) 0)) ;; (string
1c20: 2d 3e 62 6c 6f 62 20 22 74 65 73 74 69 6e 67 20 ->blob "testing
1c30: 65 68 21 22 29 29 29 29 20 0a 3b 3b 20 28 74 65 eh!")))) .;; (te
1c40: 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 2d 70 st "twiki:save-p
1c50: 69 63 2d 66 72 6f 6d 2d 66 6f 72 6d 22 20 23 66 ic-from-form" #f
1c60: 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a 73 61 (twiki:sa
1c70: 76 65 2d 70 69 63 2d 66 72 6f 6d 2d 66 6f 72 6d ve-pic-from-form
1c80: 20 2a 74 64 62 2a 20 31 29 29 0a 0a 3b 3b 20 6d *tdb* 1))..;; m
1c90: 6f 72 65 20 74 65 73 74 73 20 6f 6e 20 64 61 74 ore tests on dat
1ca0: 73 0a 0a 28 64 65 66 69 6e 65 20 64 61 74 20 23 s..(define dat #
1cb0: 66 29 0a 28 6c 65 74 20 28 28 69 6e 70 20 28 6f f).(let ((inp (o
1cc0: 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 pen-input-file "
1cd0: 74 65 73 74 73 2f 6b 69 61 74 6f 61 2e 70 6e 67 tests/kiatoa.png
1ce0: 22 29 29 29 0a 20 20 28 73 65 74 21 20 64 61 74 "))). (set! dat
1cf0: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 (read-string #f
1d00: 20 69 6e 70 29 29 0a 20 20 28 63 6c 6f 73 65 2d inp)). (close-
1d10: 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 29 input-port inp))
1d20: 0a 28 75 73 65 20 6d 64 35 29 0a 28 64 65 66 69 .(use md5).(defi
1d30: 6e 65 20 64 61 74 2d 6d 64 35 20 28 6d 64 35 3a ne dat-md5 (md5:
1d40: 64 69 67 65 73 74 20 64 61 74 29 29 0a 28 74 65 digest dat)).(te
1d50: 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 2d 64 st "twiki:save-d
1d60: 61 74 20 28 62 69 6e 61 72 79 29 22 20 34 20 20 at (binary)" 4
1d70: 20 20 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 (twiki:sav
1d80: 65 2d 64 61 74 20 2a 74 64 62 2a 20 64 61 74 20 e-dat *tdb* dat
1d90: 31 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 1)).(test "twiki
1da0: 3a 67 65 74 2d 64 61 74 20 28 62 69 6e 61 72 79 :get-dat (binary
1db0: 29 22 20 20 64 61 74 2d 6d 64 35 20 20 28 6c 65 )" dat-md5 (le
1dc0: 74 20 28 28 64 20 28 74 77 69 6b 69 3a 67 65 74 t ((d (twiki:get
1dd0: 2d 64 61 74 20 2a 74 64 62 2a 20 34 29 29 29 0a -dat *tdb* 4))).
1de0: 09 09 09 09 09 20 20 20 28 6d 64 35 3a 64 69 67 ..... (md5:dig
1df0: 65 73 74 20 64 29 29 29 0a 3b 3b 20 66 6f 72 6d est d))).;; form
1e00: 73 0a 3b 3b 20 28 64 65 66 69 6e 65 20 69 6e 70 s.;; (define inp
1e10: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c (open-input-fil
1e20: 65 20 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 e "tests/example
1e30: 2e 70 6f 73 74 2e 69 6e 22 29 29 0a 3b 3b 20 28 .post.in")).;; (
1e40: 64 65 66 69 6e 65 20 64 61 74 20 28 72 65 61 64 define dat (read
1e50: 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 29 29 -string #f inp))
1e60: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 64 61 74 73 .;; (define dats
1e70: 74 72 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 tr (open-input-s
1e80: 74 72 69 6e 67 20 64 61 74 29 29 0a 0a 3b 3b 20 tring dat))..;;
1e90: 62 69 6e 61 72 79 20 69 6e 70 75 74 73 0a 28 64 binary inputs.(d
1ea0: 65 66 69 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d efine inp (open-
1eb0: 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 input-file "test
1ec0: 73 2f 65 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 62 s/example.post.b
1ed0: 69 6e 61 72 79 2e 69 6e 22 29 29 0a 28 64 65 66 inary.in")).(def
1ee0: 69 6e 65 20 64 61 74 20 23 66 29 0a 0a 28 74 65 ine dat #f)..(te
1ef0: 73 74 20 22 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 st "formdat:load
1f00: 2d 61 6c 6c 2d 70 6f 72 74 20 6d 75 6c 74 69 70 -all-port multip
1f10: 61 72 74 22 20 23 74 20 28 6c 65 74 20 28 28 69 art" #t (let ((i
1f20: 64 61 74 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 dat (formdat:loa
1f30: 64 2d 61 6c 6c 2d 70 6f 72 74 20 69 6e 70 29 29 d-all-port inp))
1f40: 29 0a 09 09 09 09 20 20 20 28 73 65 74 21 20 64 )..... (set! d
1f50: 61 74 20 69 64 61 74 29 0a 09 09 09 09 20 20 20 at idat).....
1f60: 23 74 29 29 0a 28 74 65 73 74 20 22 66 6f 72 6d #t)).(test "form
1f70: 64 61 74 3a 6b 65 79 73 22 20 27 28 70 69 63 74 dat:keys" '(pict
1f80: 75 72 65 2d 6e 61 6d 65 20 69 6e 70 75 74 2d 70 ure-name input-p
1f90: 69 63 74 75 72 65 20 22 22 20 73 75 62 6d 69 74 icture "" submit
1fa0: 2d 70 69 63 74 75 72 65 29 20 28 66 6f 72 6d 64 -picture) (formd
1fb0: 61 74 3a 6b 65 79 73 20 64 61 74 29 29 0a 0a 28 at:keys dat))..(
1fc0: 64 65 66 69 6e 65 20 69 6e 70 20 28 6f 70 65 6e define inp (open
1fd0: 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 -input-file "tes
1fe0: 74 73 2f 65 78 61 6d 70 6c 65 2e 70 6f 73 74 2e ts/example.post.
1ff0: 69 6e 22 29 29 0a 28 74 65 73 74 20 22 66 6f 72 in")).(test "for
2000: 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f mdat:load-all-po
2010: 72 74 20 73 69 6e 67 6c 65 20 70 61 72 74 22 20 rt single part"
2020: 23 74 20 28 6c 65 74 20 28 28 69 64 61 74 20 28 #t (let ((idat (
2030: 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c formdat:load-all
2040: 2d 70 6f 72 74 20 69 6e 70 29 29 29 0a 09 09 09 -port inp)))....
2050: 09 20 20 20 28 73 65 74 21 20 64 61 74 20 69 64 . (set! dat id
2060: 61 74 29 0a 09 09 09 09 20 20 20 23 74 29 29 0a at)..... #t)).
2070: 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 3a 6b (test "formdat:k
2080: 65 79 73 22 20 27 28 65 6d 61 69 6c 2d 61 64 64 eys" '(email-add
2090: 72 65 73 73 20 66 6f 72 6d 2d 6e 61 6d 65 20 70 ress form-name p
20a0: 61 73 73 77 6f 72 64 29 20 28 66 6f 72 6d 64 61 assword) (formda
20b0: 74 3a 6b 65 79 73 20 64 61 74 29 29 0a 0a 28 63 t:keys dat))..(c
20c0: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
20d0: 69 6e 70 29 0a inp).