Artifact 7deafec4802d0f5a5757ac4dc3ebf3bf6d54128a:
- File
tests/test.scm
— part of check-in
[1b5a5d3a6e]
at
2016-10-20 17:53:01
on branch crypt
— Replace external openssl call with "crypt" egg.
The OpenSSL call was using the old UNIX crypt DES password hashing, which is very weak. Crypt will default to a more sensible mechanism (Blowfish, but in the future could transparently switch).
Old passwords will continue to work, because the crypt egg detects DES salts and happily hashes them. When creating new passwords, they will be hashed using the modern algorithm.
The OpenSSL call passed the password to the shell, so an onlooker on the server could see it in plaintext. It also neglected to escape the password for the shell, resulting in a command injection vulnerability. (user: sjamaan, size: 8378) [annotate] [blame] [check-ins using]
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 63 6d 22 29 0a 28 6c 6f cookie.scm").(lo
0200: 61 64 20 22 2e 2f 6d 69 73 63 2d 73 74 6d 6c 2e ad "./misc-stml.
0210: 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2f 66 scm").(load "./f
0220: 6f 72 6d 64 61 74 2e 73 63 6d 22 29 0a 28 6c 6f ormdat.scm").(lo
0230: 61 64 20 22 2e 2f 73 74 6d 6c 2e 73 63 6d 22 29 ad "./stml.scm")
0240: 0a 28 6c 6f 61 64 20 22 2e 2f 73 65 73 73 69 6f .(load "./sessio
0250: 6e 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e n.scm").(load ".
0260: 2f 73 71 6c 74 62 6c 2e 73 63 6d 22 29 0a 28 6c /sqltbl.scm").(l
0270: 6f 61 64 20 22 2e 2f 68 74 6d 6c 2d 66 69 6c 74 oad "./html-filt
0280: 65 72 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 er.scm").(load "
0290: 2e 2f 6b 65 79 73 74 6f 72 65 2e 73 63 6d 22 29 ./keystore.scm")
02a0: 0a 0a 3b 3b 20 54 65 73 74 20 74 68 65 20 70 72 ..;; Test the pr
02b0: 69 6d 69 74 69 76 65 20 64 62 69 20 69 6e 74 65 imitive dbi inte
02c0: 72 66 61 63 65 0a 0a 28 73 79 73 74 65 6d 20 22 rface..(system "
02d0: 72 6d 20 2d 66 20 74 65 73 74 73 2f 74 65 73 74 rm -f tests/test
02e0: 2e 64 62 22 29 0a 28 64 65 66 69 6e 65 20 64 62 .db").(define db
02f0: 20 28 64 62 69 3a 6f 70 65 6e 20 27 73 71 6c 69 (dbi:open 'sqli
0300: 74 65 33 20 27 28 28 64 62 6e 61 6d 65 20 2e 20 te3 '((dbname .
0310: 22 74 65 73 74 73 2f 74 65 73 74 2e 64 62 22 29 "tests/test.db")
0320: 29 29 29 0a 28 64 62 69 3a 65 78 65 63 20 64 62 ))).(dbi:exec db
0330: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 66 "CREATE TABLE f
0340: 6f 6f 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 oo(id INTEGER PR
0350: 49 4d 41 52 59 20 4b 45 59 2c 6e 61 6d 65 20 54 IMARY KEY,name T
0360: 45 58 54 29 3b 22 29 0a 28 64 62 69 3a 65 78 65 EXT);").(dbi:exe
0370: 63 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 c db "INSERT INT
0380: 4f 20 66 6f 6f 28 6e 61 6d 65 29 20 56 41 4c 55 O foo(name) VALU
0390: 45 53 28 3f 29 3b 22 20 22 4d 61 74 74 22 29 0a ES(?);" "Matt").
03a0: 28 64 62 69 3a 66 6f 72 2d 65 61 63 68 2d 72 6f (dbi:for-each-ro
03b0: 77 20 0a 20 28 6c 61 6d 62 64 61 20 28 74 75 70 w . (lambda (tup
03c0: 6c 65 29 0a 20 20 20 28 70 72 69 6e 74 20 28 76 le). (print (v
03d0: 65 63 74 6f 72 2d 72 65 66 20 74 75 70 6c 65 20 ector-ref tuple
03e0: 30 29 20 22 20 22 20 28 76 65 63 74 6f 72 2d 72 0) " " (vector-r
03f0: 65 66 20 74 75 70 6c 65 20 31 29 29 29 0a 20 64 ef tuple 1))). d
0400: 62 20 22 53 45 4c 45 43 54 20 2a 20 46 52 4f 4d b "SELECT * FROM
0410: 20 66 6f 6f 3b 22 29 0a 28 74 65 73 74 20 22 64 foo;").(test "d
0420: 62 69 3a 67 65 74 2d 6f 6e 65 22 20 22 4d 61 74 bi:get-one" "Mat
0430: 74 22 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 20 t" (dbi:get-one
0440: 64 62 20 22 53 45 4c 45 43 54 20 6e 61 6d 65 20 db "SELECT name
0450: 46 52 4f 4d 20 66 6f 6f 20 57 48 45 52 45 20 6e FROM foo WHERE n
0460: 61 6d 65 3d 27 4d 61 74 74 27 3b 22 29 29 0a 0a ame='Matt';"))..
0470: 3b 3b 20 6b 65 79 73 74 6f 72 65 0a 28 64 62 69 ;; keystore.(dbi
0480: 3a 65 78 65 63 20 64 62 20 22 43 52 45 41 54 45 :exec db "CREATE
0490: 20 54 41 42 4c 45 20 6d 65 74 61 64 61 74 61 20 TABLE metadata
04a0: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
04b0: 41 52 59 20 4b 45 59 2c 6b 65 79 20 54 45 58 54 ARY KEY,key TEXT
04c0: 2c 76 61 6c 75 65 20 54 45 58 54 29 3b 22 29 0a ,value TEXT);").
04d0: 0a 28 6b 65 79 73 74 6f 72 65 3a 73 65 74 21 20 .(keystore:set!
04e0: 64 62 20 22 53 43 48 45 4d 41 2d 56 45 52 53 49 db "SCHEMA-VERSI
04f0: 4f 4e 22 20 31 2e 32 29 0a 28 74 65 73 74 20 22 ON" 1.2).(test "
0500: 4b 65 79 73 74 6f 72 65 20 67 65 74 22 20 22 31 Keystore get" "1
0510: 2e 32 22 20 20 28 6b 65 79 73 74 6f 72 65 3a 67 .2" (keystore:g
0520: 65 74 20 20 64 62 20 22 53 43 48 45 4d 41 2d 56 et db "SCHEMA-V
0530: 45 52 53 49 4f 4e 22 29 29 0a 28 6b 65 79 73 74 ERSION")).(keyst
0540: 6f 72 65 3a 64 65 6c 21 20 64 62 20 22 53 43 48 ore:del! db "SCH
0550: 45 4d 41 2d 56 45 52 53 49 4f 4e 22 29 20 0a 28 EMA-VERSION") .(
0560: 74 65 73 74 20 22 4b 65 79 73 74 6f 72 65 20 67 test "Keystore g
0570: 65 74 20 64 65 6c 65 74 65 64 22 20 23 66 20 28 et deleted" #f (
0580: 6b 65 79 73 74 6f 72 65 3a 67 65 74 20 64 62 20 keystore:get db
0590: 22 53 43 48 45 4d 41 2d 56 45 52 53 49 4f 4e 22 "SCHEMA-VERSION"
05a0: 29 29 0a 0a 28 73 79 73 74 65 6d 20 22 72 6d 20 ))..(system "rm
05b0: 2d 66 20 74 65 73 74 73 2f 74 65 73 74 2e 64 62 -f tests/test.db
05c0: 22 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 ")..;; create a
05d0: 73 65 73 73 69 6f 6e 20 74 6f 20 77 6f 72 6b 20 session to work
05e0: 77 69 74 68 22 29 0a 28 73 65 74 65 6e 76 20 22 with").(setenv "
05f0: 52 45 51 55 45 53 54 5f 55 52 49 22 20 22 2f 73 REQUEST_URI" "/s
0600: 74 6d 6c 72 75 6e 3f 61 63 74 69 6f 6e 3d 74 65 tmlrun?action=te
0610: 73 74 2e 74 65 73 74 22 29 0a 28 73 65 74 65 6e st.test").(seten
0620: 76 20 22 53 43 52 49 50 54 5f 4e 41 4d 45 22 20 v "SCRIPT_NAME"
0630: 22 2f 63 67 69 2d 62 69 6e 2f 73 74 6d 6c 72 75 "/cgi-bin/stmlru
0640: 6e 22 29 0a 28 73 65 74 65 6e 76 20 22 50 41 54 n").(setenv "PAT
0650: 48 5f 49 4e 46 4f 22 20 22 2f 74 65 73 74 22 29 H_INFO" "/test")
0660: 0a 28 73 65 74 65 6e 76 20 22 51 55 45 52 59 5f .(setenv "QUERY_
0670: 53 54 52 49 4e 47 22 20 22 61 63 74 69 6f 6e 3d STRING" "action=
0680: 74 65 73 74 2e 74 65 73 74 22 29 0a 28 73 65 74 test.test").(set
0690: 65 6e 76 20 22 53 45 52 56 45 52 5f 4e 41 4d 45 env "SERVER_NAME
06a0: 22 20 22 6c 6f 63 61 6c 68 6f 73 74 22 29 0a 28 " "localhost").(
06b0: 73 65 74 65 6e 76 20 22 52 45 51 55 45 53 54 5f setenv "REQUEST_
06c0: 4d 45 54 48 4f 44 22 20 22 47 45 54 22 29 0a 0a METHOD" "GET")..
06d0: 28 6c 6f 61 64 20 22 2e 2f 73 65 74 75 70 2e 73 (load "./setup.s
06e0: 63 6d 22 29 0a 0a 28 73 3a 76 61 6c 69 64 61 74 cm")..(s:validat
06f0: 65 2d 69 6e 70 75 74 73 29 0a 0a 3b 3b 20 74 65 e-inputs)..;; te
0700: 73 74 20 73 65 73 73 69 6f 6e 20 76 61 72 69 61 st session varia
0710: 62 6c 65 73 0a 0a 28 73 65 73 73 69 6f 6e 3a 67 bles..(session:g
0720: 65 74 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f et-vars s:sessio
0730: 6e 29 0a 28 64 65 66 69 6e 65 20 6e 61 64 61 20 n).(define nada
0740: 22 61 6e 64 6e 6e 64 68 68 73 68 61 61 73 22 29 "andnndhhshaas")
0750: 0a 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d .(s:session-var-
0760: 73 65 74 21 20 22 6e 69 63 6b 22 20 6e 61 64 61 set! "nick" nada
0770: 29 0a 28 74 65 73 74 20 22 53 65 73 73 69 6f 6e ).(test "Session
0780: 20 76 61 72 20 73 65 74 2f 67 65 74 22 20 6e 61 var set/get" na
0790: 64 61 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d 76 da (s:session-v
07a0: 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 0a ar-get "nick")).
07b0: 28 70 72 69 6e 74 20 22 67 6f 74 20 68 65 72 65 (print "got here
07c0: 22 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 ").(session:save
07d0: 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 -vars s:session)
07e0: 0a 28 73 65 73 73 69 6f 6e 3a 67 65 74 2d 76 61 .(session:get-va
07f0: 72 73 20 20 73 3a 73 65 73 73 69 6f 6e 29 0a 28 rs s:session).(
0800: 74 65 73 74 20 22 53 65 73 73 69 6f 6e 20 76 61 test "Session va
0810: 72 20 73 65 74 2f 67 65 74 20 61 66 74 65 72 20 r set/get after
0820: 73 61 76 65 2f 67 65 74 22 20 6e 61 64 61 20 28 save/get" nada (
0830: 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 2d 67 65 s:session-var-ge
0840: 74 20 22 6e 69 63 6b 22 29 29 0a 28 73 65 73 73 t "nick")).(sess
0850: 69 6f 6e 3a 64 65 6c 21 20 73 3a 73 65 73 73 69 ion:del! s:sessi
0860: 6f 6e 20 22 2a 73 65 73 73 69 6f 6e 76 61 72 73 on "*sessionvars
0870: 2a 22 20 22 6e 69 63 6b 22 29 0a 28 74 65 73 74 *" "nick").(test
0880: 20 22 53 65 73 73 69 6f 6e 20 76 61 72 20 64 65 "Session var de
0890: 6c 22 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l"
08a0: 20 20 20 20 20 20 23 66 20 20 20 28 73 3a 73 65 #f (s:se
08b0: 73 73 69 6f 6e 2d 76 61 72 2d 67 65 74 20 22 6e ssion-var-get "n
08c0: 69 63 6b 22 29 29 0a 28 73 65 73 73 69 6f 6e 3a ick")).(session:
08d0: 73 61 76 65 2d 76 61 72 73 20 73 3a 73 65 73 73 save-vars s:sess
08e0: 69 6f 6e 29 0a 28 73 65 73 73 69 6f 6e 3a 67 65 ion).(session:ge
08f0: 74 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e t-vars s:session
0900: 29 0a 28 73 3a 73 65 73 73 69 6f 6e 2d 76 61 72 ).(s:session-var
0910: 2d 73 65 74 21 20 22 6e 69 63 6b 22 20 6e 61 64 -set! "nick" nad
0920: 61 29 0a 28 73 65 73 73 69 6f 6e 3a 73 61 76 65 a).(session:save
0930: 2d 76 61 72 73 20 73 3a 73 65 73 73 69 6f 6e 29 -vars s:session)
0940: 0a 0a 3b 3b 20 28 74 65 73 74 20 22 53 65 73 73 ..;; (test "Sess
0950: 69 6f 6e 20 76 61 72 20 64 65 6c 22 20 20 20 20 ion var del"
0960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0970: 23 66 20 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d #f (s:session-
0980: 76 61 72 2d 67 65 74 20 22 6e 69 63 6b 22 29 29 var-get "nick"))
0990: 0a 0a 3b 3b 20 74 65 73 74 20 70 65 72 73 6f 6e ..;; test person
09a0: 0a 0a 28 6c 6f 61 64 20 22 2e 2f 74 65 73 74 73 ..(load "./tests
09b0: 2f 6d 6f 64 65 6c 73 2f 74 65 73 74 2e 73 63 6d /models/test.scm
09c0: 22 29 0a 0a 28 70 72 69 6e 74 20 22 53 65 73 73 ")..(print "Sess
09d0: 69 6f 6e 20 6b 65 79 20 69 73 20 22 20 28 73 64 ion key is " (sd
09e0: 61 74 2d 67 65 74 2d 73 65 73 73 69 6f 6e 2d 6b at-get-session-k
09f0: 65 79 20 73 3a 73 65 73 73 69 6f 6e 29 29 0a 0a ey s:session))..
0a00: 28 74 65 73 74 20 22 44 65 6c 65 74 65 20 73 65 (test "Delete se
0a10: 73 73 69 6f 6e 22 20 23 74 20 28 73 3a 64 65 6c ssion" #t (s:del
0a20: 65 74 65 2d 73 65 73 73 69 6f 6e 29 29 0a 0a 28 ete-session))..(
0a30: 6c 65 74 20 28 28 66 68 20 28 6f 70 65 6e 2d 69 let ((fh (open-i
0a40: 6e 70 75 74 2d 70 69 70 65 20 22 6c 73 20 2e 2f nput-pipe "ls ./
0a50: 74 65 73 74 73 2f 70 61 67 65 73 2f 2a 2f 63 6f tests/pages/*/co
0a60: 6e 74 72 6f 6c 2e 73 63 6d 22 29 29 29 0a 20 20 ntrol.scm"))).
0a70: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 20 28 72 (let loop ((l (r
0a80: 65 61 64 2d 6c 69 6e 65 20 66 68 29 29 29 0a 20 ead-line fh))).
0a90: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 (if (not (eof
0aa0: 2d 6f 62 6a 65 63 74 3f 20 6c 29 29 0a 20 20 20 -object? l)).
0ab0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
0ac0: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 ;; (print
0ad0: 22 6c 6f 61 64 69 6e 67 20 22 20 6c 29 0a 20 20 "loading " l).
0ae0: 20 20 20 20 20 20 20 20 28 6c 6f 61 64 20 6c 29 (load l)
0af0: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 . (loop
0b00: 20 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 29 (read-line fh))
0b10: 29 29 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e 70 ))). (close-inp
0b20: 75 74 2d 70 6f 72 74 20 66 68 29 29 0a 0a 3b 3b ut-port fh))..;;
0b30: 20 53 68 6f 75 6c 64 20 68 61 76 65 20 70 6f 6c Should have pol
0b40: 6c 3a 70 6f 6c 6c 20 64 65 66 69 6e 65 64 20 6e l:poll defined n
0b50: 6f 77 2e 0a 28 74 65 73 74 20 22 4d 61 6b 65 20 ow..(test "Make
0b60: 61 20 72 61 6e 64 6f 6d 20 73 74 72 69 6e 67 22 a random string"
0b70: 20 32 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 2 (string-lengt
0b80: 68 20 28 73 65 73 73 69 6f 6e 3a 6d 61 6b 65 2d h (session:make-
0b90: 72 61 6e 64 2d 73 74 72 69 6e 67 20 32 29 29 29 rand-string 2)))
0ba0: 0a 28 74 65 73 74 20 22 43 72 65 61 74 65 20 61 .(test "Create a
0bb0: 6e 20 65 6e 63 72 79 70 74 65 64 20 70 61 73 73 n encrypted pass
0bc0: 77 6f 72 64 20 75 73 69 6e 67 20 44 45 53 20 28 word using DES (
0bd0: 62 61 63 6b 77 61 72 64 73 20 63 6f 6d 70 61 74 backwards compat
0be0: 29 22 20 22 61 62 51 39 4b 59 2e 4b 66 72 59 72 )" "abQ9KY.KfrYr
0bf0: 63 22 20 28 73 3a 63 72 79 70 74 2d 70 61 73 73 c" (s:crypt-pass
0c00: 77 64 20 22 66 6f 6f 22 20 22 61 62 22 29 29 0a wd "foo" "ab")).
0c10: 28 74 65 73 74 20 22 43 72 65 61 74 65 20 61 6e (test "Create an
0c20: 20 65 6e 63 72 79 70 74 65 64 20 70 61 73 73 77 encrypted passw
0c30: 6f 72 64 20 75 73 69 6e 67 20 42 6c 6f 77 66 69 ord using Blowfi
0c40: 73 68 22 20 22 24 32 61 24 31 32 24 47 79 6f 4b sh" "$2a$12$GyoK
0c50: 48 58 2f 55 4f 78 4d 4c 47 74 77 64 53 54 72 37 HX/UOxMLGtwdSTr7
0c60: 45 4f 46 39 4b 51 7a 6c 79 79 79 52 71 46 54 4b EOF9KQzlyyyRqFTK
0c70: 78 31 59 76 4c 41 33 73 4d 75 6b 62 56 34 57 42 x1YvLA3sMukbV4WB
0c80: 43 22 20 28 73 3a 63 72 79 70 74 2d 70 61 73 73 C" (s:crypt-pass
0c90: 77 64 20 22 66 6f 6f 22 20 22 24 32 61 24 31 32 wd "foo" "$2a$12
0ca0: 24 47 79 6f 4b 48 58 2f 55 4f 78 4d 4c 47 74 77 $GyoKHX/UOxMLGtw
0cb0: 64 53 54 72 37 45 4f 22 29 29 0a 0a 28 74 65 73 dSTr7EO"))..(tes
0cc0: 74 20 22 73 3a 61 6e 79 2d 3e 73 74 72 69 6e 67 t "s:any->string
0cd0: 20 6f 6e 20 61 20 68 61 73 68 2d 74 61 62 6c 65 on a hash-table
0ce0: 22 20 22 23 3c 68 61 73 68 2d 74 61 62 6c 65 3e " "#<hash-table>
0cf0: 22 20 28 73 3a 61 6e 79 2d 3e 73 74 72 69 6e 67 " (s:any->string
0d00: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0d10: 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 65 e)))..(define se
0d20: 6c 65 63 74 2d 6c 69 73 74 0a 20 20 27 28 28 61 lect-list. '((a
0d30: 20 62 20 63 29 28 64 20 28 65 20 66 20 67 29 28 b c)(d (e f g)(
0d40: 68 20 69 20 6a 20 23 74 29 29 29 29 0a 28 64 65 h i j #t)))).(de
0d50: 66 69 6e 65 20 72 65 73 75 6c 74 20 27 28 22 3c fine result '("<
0d60: 53 45 4c 45 43 54 20 6e 61 6d 65 3d 5c 22 65 66 SELECT name=\"ef
0d70: 67 5c 22 3e 22 20 0a 09 09 20 28 28 28 22 3c 4f g\">" ... ((("<O
0d80: 50 54 49 4f 4e 20 6c 61 62 65 6c 3d 5c 22 61 5c PTION label=\"a\
0d90: 22 20 76 61 6c 75 65 3d 5c 22 62 5c 22 3e 63 3c " value=\"b\">c<
0da0: 2f 4f 50 54 49 4f 4e 3e 22 29 20 0a 09 09 20 20 /OPTION>") ...
0db0: 20 28 22 3c 4f 50 54 47 52 4f 55 50 20 6c 61 62 ("<OPTGROUP lab
0dc0: 65 6c 3d 64 22 20 0a 09 09 20 20 20 20 28 22 3c el=d" ... ("<
0dd0: 4f 50 54 49 4f 4e 20 6c 61 62 65 6c 3d 5c 22 65 OPTION label=\"e
0de0: 5c 22 20 76 61 6c 75 65 3d 5c 22 66 5c 22 3e 67 \" value=\"f\">g
0df0: 3c 2f 4f 50 54 49 4f 4e 3e 22 29 0a 09 09 20 20 </OPTION>")...
0e00: 20 20 28 22 3c 4f 50 54 49 4f 4e 20 20 73 65 6c ("<OPTION sel
0e10: 65 63 74 65 64 20 6c 61 62 65 6c 3d 5c 22 68 5c ected label=\"h\
0e20: 22 20 76 61 6c 75 65 3d 5c 22 69 5c 22 3e 6a 3c " value=\"i\">j<
0e30: 2f 4f 50 54 49 4f 4e 3e 22 29 20 0a 09 09 20 20 /OPTION>") ...
0e40: 20 20 22 3c 2f 4f 50 54 47 52 4f 55 50 3e 22 29 "</OPTGROUP>")
0e50: 29 29 0a 09 09 20 22 3c 2f 53 45 4c 45 43 54 3e ))... "</SELECT>
0e60: 22 29 29 0a 0a 28 74 65 73 74 20 22 53 65 6c 65 "))..(test "Sele
0e70: 63 74 20 6c 69 73 74 22 20 72 65 73 75 6c 74 20 ct list" result
0e80: 28 73 3a 73 65 6c 65 63 74 20 73 65 6c 65 63 74 (s:select select
0e90: 2d 6c 69 73 74 20 27 6e 61 6d 65 20 22 65 66 67 -list 'name "efg
0ea0: 22 29 29 0a 0a 3b 3b 20 54 65 73 74 20 6d 6f 64 "))..;; Test mod
0eb0: 75 6c 65 73 0a 0a 28 74 65 73 74 20 22 6d 69 73 ules..(test "mis
0ec0: 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e c:non-zero-strin
0ed0: 67 20 5c 22 5c 22 22 20 23 66 20 28 6d 69 73 63 g \"\"" #f (misc
0ee0: 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 :non-zero-string
0ef0: 20 22 22 29 29 0a 28 74 65 73 74 20 22 6d 69 73 "")).(test "mis
0f00: 63 3a 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e c:non-zero-strin
0f10: 67 20 23 66 22 20 23 66 20 28 6d 69 73 63 3a 6e g #f" #f (misc:n
0f20: 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 23 on-zero-string #
0f30: 66 29 29 0a 28 74 65 73 74 20 22 6d 69 73 63 3a f)).(test "misc:
0f40: 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 non-zero-string
0f50: 27 62 6c 61 68 22 20 23 66 20 28 6d 69 73 63 3a 'blah" #f (misc:
0f60: 6e 6f 6e 2d 7a 65 72 6f 2d 73 74 72 69 6e 67 20 non-zero-string
0f70: 27 62 6c 61 68 29 29 0a 0a 3b 3b 20 66 6f 72 6d 'blah))..;; form
0f80: 73 0a 28 64 65 66 69 6e 65 20 66 6f 72 6d 20 23 s.(define form #
0f90: 66 29 0a 28 74 65 73 74 20 22 6d 61 6b 65 20 3c f).(test "make <
0fa0: 66 6f 72 6d 64 61 74 3e 22 20 23 74 20 28 6c 65 formdat>" #t (le
0fb0: 74 20 28 28 66 20 28 6d 61 6b 65 2d 66 6f 72 6d t ((f (make-form
0fc0: 64 61 74 3a 66 6f 72 6d 64 61 74 29 29 29 0a 09 dat:formdat)))..
0fd0: 09 09 20 20 20 20 28 73 65 74 21 20 66 6f 72 6d .. (set! form
0fe0: 20 66 29 0a 09 09 09 20 20 20 20 23 74 29 29 0a f).... #t)).
0ff0: 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 3a 20 (test "formdat:
1000: 73 65 74 21 2f 67 65 74 22 20 22 59 65 70 21 22 set!/get" "Yep!"
1010: 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 28 (begin..... (
1020: 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 66 6f 72 formdat:set! for
1030: 6d 20 22 62 6c 61 68 22 20 22 59 65 70 21 22 29 m "blah" "Yep!")
1040: 0a 09 09 09 09 20 20 20 28 66 6f 72 6d 64 61 74 ..... (formdat
1050: 3a 67 65 74 20 20 66 6f 72 6d 20 22 62 6c 61 68 :get form "blah
1060: 22 29 29 29 0a 0a 28 74 65 73 74 20 22 73 3a 73 ")))..(test "s:s
1070: 74 72 69 6e 67 2d 3e 70 67 69 6e 74 22 20 20 20 tring->pgint"
1080: 31 32 33 20 28 73 3a 61 6e 79 2d 3e 70 67 69 6e 123 (s:any->pgin
1090: 74 20 22 31 32 33 22 29 29 0a 28 74 65 73 74 20 t "123")).(test
10a0: 22 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 "s:illegal-pgint
10b0: 20 28 6c 65 67 61 6c 29 22 20 20 20 20 20 20 20 (legal)"
10c0: 20 23 66 20 28 73 3a 69 6c 6c 65 67 61 6c 2d 70 #f (s:illegal-p
10d0: 67 69 6e 74 20 31 30 31 31 29 29 0a 28 74 65 73 gint 1011)).(tes
10e0: 74 20 22 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 t "s:illegal-pgi
10f0: 6e 74 20 28 69 6c 6c 65 67 61 6c 20 62 69 67 29 nt (illegal big)
1100: 22 20 20 20 31 20 28 73 3a 69 6c 6c 65 67 61 6c " 1 (s:illegal
1110: 2d 70 67 69 6e 74 20 20 39 39 39 39 39 39 39 39 -pgint 99999999
1120: 39 39 29 29 0a 28 74 65 73 74 20 22 73 3a 69 6c 99)).(test "s:il
1130: 6c 65 67 61 6c 70 67 69 6e 74 20 28 69 6c 6c 65 legalpgint (ille
1140: 67 61 6c 20 73 6d 61 6c 6c 29 22 20 2d 31 20 28 gal small)" -1 (
1150: 73 3a 69 6c 6c 65 67 61 6c 2d 70 67 69 6e 74 20 s:illegal-pgint
1160: 2d 39 39 39 39 39 39 39 39 39 39 29 29 0a 0a 3b -9999999999))..;
1170: 3b 20 54 68 65 20 74 77 69 6b 69 20 6d 6f 64 75 ; The twiki modu
1180: 6c 65 0a 0a 3b 3b 20 63 6c 65 61 6e 20 75 70 0a le..;; clean up.
1190: 28 73 79 73 74 65 6d 20 22 72 6d 20 2d 72 66 20 (system "rm -rf
11a0: 74 77 69 6b 69 73 2f 2a 22 29 0a 28 6c 6f 61 64 twikis/*").(load
11b0: 20 22 6d 6f 64 75 6c 65 73 2f 74 77 69 6b 69 2f "modules/twiki/
11c0: 74 77 69 6b 69 2d 6d 6f 64 2e 73 63 6d 22 29 0a twiki-mod.scm").
11d0: 28 64 65 66 69 6e 65 20 6b 65 79 73 20 28 6c 69 (define keys (li
11e0: 73 74 20 22 62 6c 61 68 22 20 31 20 27 6e 61 64 st "blah" 1 'nad
11f0: 61 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 a)).(test "twiki
1200: 3a 6b 65 79 73 2d 3e 6b 65 79 22 20 20 22 62 6c :keys->key" "bl
1210: 61 68 20 31 20 6e 61 64 61 22 20 28 74 77 69 6b ah 1 nada" (twik
1220: 69 3a 6b 65 79 73 2d 3e 6b 65 79 20 6b 65 79 73 i:keys->key keys
1230: 29 29 0a 28 64 65 66 69 6e 65 20 6b 65 79 20 28 )).(define key (
1240: 74 77 69 6b 69 3a 6b 65 79 73 2d 3e 6b 65 79 20 twiki:keys->key
1250: 6b 65 79 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 keys))..(define
1260: 2a 74 64 62 2a 20 23 66 29 0a 28 74 65 73 74 20 *tdb* #f).(test
1270: 22 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 22 20 "twiki:open-db"
1280: 20 20 23 74 20 28 6c 65 74 20 28 28 64 62 20 28 #t (let ((db (
1290: 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 20 6b 65 twiki:open-db ke
12a0: 79 29 29 29 0a 09 09 09 20 20 20 20 20 28 73 65 y))).... (se
12b0: 74 21 20 2a 74 64 62 2a 20 64 62 29 0a 09 09 09 t! *tdb* db)....
12c0: 20 20 20 20 20 28 69 66 20 2a 74 64 62 2a 20 23 (if *tdb* #
12d0: 74 20 23 66 29 29 29 0a 28 64 65 66 69 6e 65 20 t #f))).(define
12e0: 77 69 6b 69 20 28 6d 61 6b 65 2d 74 77 69 6b 69 wiki (make-twiki
12f0: 3a 77 69 6b 69 29 29 0a 28 74 77 69 6b 69 3a 77 :wiki)).(twiki:w
1300: 69 6b 69 2d 73 65 74 2d 77 69 64 21 20 77 69 6b iki-set-wid! wik
1310: 69 20 31 29 0a 28 74 77 69 6b 69 3a 77 69 6b 69 i 1).(twiki:wiki
1320: 2d 73 65 74 2d 6e 61 6d 65 21 20 77 69 6b 69 20 -set-name! wiki
1330: 22 6d 61 69 6e 22 29 0a 28 74 77 69 6b 69 3a 77 "main").(twiki:w
1340: 69 6b 69 2d 73 65 74 2d 70 65 72 6d 73 21 20 77 iki-set-perms! w
1350: 69 6b 69 20 27 28 72 20 77 29 29 0a 0a 28 74 65 iki '(r w))..(te
1360: 73 74 20 22 74 77 69 6b 69 3a 64 61 74 2d 3e 68 st "twiki:dat->h
1370: 74 6d 6c 22 20 27 28 22 48 65 6c 6c 6f 22 20 22 tml" '("Hello" "
1380: 3c 42 52 3e 22 29 20 28 74 77 69 6b 69 3a 64 61 <BR>") (twiki:da
1390: 74 2d 3e 68 74 6d 6c 20 22 48 65 6c 6c 6f 22 20 t->html "Hello"
13a0: 77 69 6b 69 29 29 0a 28 74 65 73 74 20 22 74 77 wiki)).(test "tw
13b0: 69 6b 69 3a 6b 65 79 73 2d 3e 66 6e 61 6d 65 22 iki:keys->fname"
13c0: 20 27 28 22 74 77 69 6b 69 73 2f 59 6d 78 68 61 '("twikis/Ymxha
13d0: 2f 43 41 78 49 47 2f 35 68 5a 47 45 22 20 22 59 /CAxIG/5hZGE" "Y
13e0: 6d 78 68 61 43 41 78 49 47 35 68 5a 47 45 5f 22 mxhaCAxIG5hZGE_"
13f0: 29 20 3b 3b 20 28 22 74 77 69 6b 69 73 2f 64 39 ) ;; ("twikis/d9
1400: 39 61 32 64 65 39 2f 36 38 30 38 34 39 33 62 2f 9a2de9/6808493b/
1410: 32 33 37 37 30 66 37 30 22 20 22 64 39 39 61 32 23770f70" "d99a2
1420: 64 65 39 36 38 30 38 34 39 33 62 32 33 37 37 30 de96808493b23770
1430: 66 37 30 63 37 36 64 66 66 65 34 22 29 0a 20 20 f70c76dffe4").
1440: 20 20 20 20 28 74 77 69 6b 69 3a 6b 65 79 2d 3e (twiki:key->
1450: 66 6e 61 6d 65 20 6b 65 79 29 29 0a 0a 28 74 65 fname key))..(te
1460: 73 74 20 22 74 77 69 6b 69 3a 6e 61 6d 65 2d 3e st "twiki:name->
1470: 77 69 64 22 20 20 20 20 20 31 20 20 20 20 20 28 wid" 1 (
1480: 74 77 69 6b 69 3a 6e 61 6d 65 2d 3e 77 69 64 20 twiki:name->wid
1490: 2a 74 64 62 2a 20 22 6d 61 69 6e 22 29 29 0a 28 *tdb* "main")).(
14a0: 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d test "twiki:get-
14b0: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d 22 tiddlers-by-num"
14c0: 20 27 28 29 20 28 74 77 69 6b 69 3a 67 65 74 2d '() (twiki:get-
14d0: 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d 20 tiddlers-by-num
14e0: 20 2a 74 64 62 2a 20 30 20 28 6c 69 73 74 20 31 *tdb* 0 (list 1
14f0: 20 32 20 33 29 29 29 0a 28 74 65 73 74 20 22 74 2 3))).(test "t
1500: 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 wiki:get-tiddler
1510: 73 2d 62 79 2d 6e 61 6d 65 22 20 27 28 29 20 28 s-by-name" '() (
1520: 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 twiki:get-tiddle
1530: 72 73 2d 62 79 2d 6e 61 6d 65 20 2a 74 64 62 2a rs-by-name *tdb*
1540: 20 30 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 0a 0 "MainMenu")).
1550: 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 74 (test "twiki:get
1560: 2d 74 69 64 64 6c 65 72 73 22 20 20 27 28 29 20 -tiddlers" '()
1570: 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 (twiki:get-tidd
1580: 6c 65 72 73 20 2a 74 64 62 2a 20 30 20 28 6c 69 lers *tdb* 0 (li
1590: 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22 29 29 29 st "MainMenu")))
15a0: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 67 65 .(test "twiki:ge
15b0: 74 2d 74 69 64 64 6c 65 72 73 22 20 20 27 28 29 t-tiddlers" '()
15c0: 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 (twiki:get-tid
15d0: 64 6c 65 72 73 20 2a 74 64 62 2a 20 30 20 28 6c dlers *tdb* 0 (l
15e0: 69 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22 20 22 ist "MainMenu" "
15f0: 41 6e 6f 74 68 65 72 4f 6e 65 22 29 29 29 0a 28 AnotherOne"))).(
1600: 74 65 73 74 20 22 74 77 69 6b 69 3a 77 69 6b 69 test "twiki:wiki
1610: 22 20 22 3c 54 41 42 4c 45 3e 22 20 20 20 20 20 " "<TABLE>"
1620: 28 63 61 72 20 28 74 77 69 6b 69 3a 77 69 6b 69 (car (twiki:wiki
1630: 20 22 6d 61 69 6e 22 20 28 6c 69 73 74 20 22 62 "main" (list "b
1640: 6c 61 68 22 20 31 20 27 6e 61 64 61 29 29 29 29 lah" 1 'nada))))
1650: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 76 69 .(test "twiki:vi
1660: 65 77 22 20 20 22 3c 44 49 56 20 63 6c 61 73 73 ew" "<DIV class
1670: 3d 5c 22 6e 6f 64 65 5c 22 3e 22 20 28 63 61 72 =\"node\">" (car
1680: 20 28 74 77 69 6b 69 3a 76 69 65 77 20 22 22 20 (twiki:view ""
1690: 22 22 20 30 20 28 74 77 69 6b 69 3a 74 69 64 64 "" 0 (twiki:tidd
16a0: 6c 65 72 2d 6d 61 6b 65 29 20 77 69 6b 69 29 29 ler-make) wiki))
16b0: 29 0a 0a 28 74 65 73 74 20 22 73 3a 74 64 22 20 )..(test "s:td"
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 22 '("
16d0: 3c 54 44 3e 22 20 28 28 29 29 20 22 3c 2f 54 44 <TD>" (()) "</TD
16e0: 3e 22 29 20 28 73 3a 74 64 20 27 28 29 29 29 0a >") (s:td '())).
16f0: 3b 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 3a ;; (test "twiki:
1700: 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d get-tiddlers-by-
1710: 6e 61 6d 65 22 20 27 28 29 20 28 74 77 69 6b 69 name" '() (twiki
1720: 3a 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 :get-tiddlers-by
1730: 2d 6e 61 6d 65 20 31 20 22 66 72 65 64 22 29 29 -name 1 "fred"))
1740: 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 74 69 .(test "twiki:ti
1750: 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e 69 64 22 20 ddler-name->id"
1760: 31 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 1 (twiki:tiddler
1770: 2d 6e 61 6d 65 2d 3e 69 64 20 2a 74 64 62 2a 20 -name->id *tdb*
1780: 22 4d 61 69 6e 4d 65 6e 75 22 29 29 0a 28 74 65 "MainMenu")).(te
1790: 73 74 20 22 73 3a 73 65 74 21 20 61 20 76 61 72 st "s:set! a var
17a0: 20 74 6f 20 23 66 22 20 20 20 20 20 22 22 0a 20 to #f" "".
17b0: 20 20 20 20 20 28 62 65 67 69 6e 20 28 73 3a 73 (begin (s:s
17c0: 65 74 21 20 22 42 4c 41 48 22 20 23 66 29 0a 09 et! "BLAH" #f)..
17d0: 20 20 20 20 20 28 73 3a 67 65 74 20 22 42 4c 41 (s:get "BLA
17e0: 48 22 29 29 29 20 3b 3b 20 64 6f 6e 27 74 20 6b H"))) ;; don't k
17f0: 6e 6f 77 20 69 66 20 74 68 69 73 20 6f 6e 65 20 now if this one
1800: 6d 61 6b 65 73 20 73 65 6e 73 65 2e 20 53 65 74 makes sense. Set
1810: 74 69 6e 67 20 74 6f 20 23 66 20 73 68 6f 75 6c ting to #f shoul
1820: 64 20 72 65 61 6c 6c 79 20 64 65 6c 65 74 65 20 d really delete
1830: 74 68 65 20 76 61 6c 75 65 0a 28 74 65 73 74 20 the value.(test
1840: 22 74 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 22 "twiki:save-dat"
1850: 20 20 20 20 20 20 20 20 20 20 20 32 20 20 20 20 2
1860: 20 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d (twiki:save-
1870: 64 61 74 20 2a 74 64 62 2a 20 22 64 61 74 22 20 dat *tdb* "dat"
1880: 30 29 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 0)).(test "twiki
1890: 3a 67 65 74 2d 64 61 74 22 20 20 20 20 20 20 20 :get-dat"
18a0: 20 20 20 20 20 22 64 61 74 22 20 20 20 20 28 74 "dat" (t
18b0: 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 wiki:get-dat *td
18c0: 62 2a 20 32 29 29 0a 28 74 65 73 74 20 22 74 77 b* 2)).(test "tw
18d0: 69 6b 69 3a 67 65 74 2d 64 61 74 22 20 20 20 20 iki:get-dat"
18e0: 20 20 20 20 20 20 20 20 23 66 20 20 20 20 20 20 #f
18f0: 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 (twiki:get-dat
1900: 2a 74 64 62 2a 20 35 29 29 0a 3b 3b 20 28 74 65 *tdb* 5)).;; (te
1910: 73 74 20 22 74 77 69 6b 69 3a 67 65 74 2d 64 61 st "twiki:get-da
1920: 74 22 20 20 20 20 20 20 23 66 20 20 20 20 28 74 t" #f (t
1930: 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 wiki:get-dat *td
1940: 62 2a 20 23 66 29 29 0a 28 74 65 73 74 20 22 74 b* #f)).(test "t
1950: 77 69 6b 69 3a 73 61 76 65 2d 74 69 64 64 6c 65 wiki:save-tiddle
1960: 72 22 20 20 20 20 20 20 20 23 74 20 20 20 20 20 r" #t
1970: 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 74 69 (twiki:save-ti
1980: 64 64 6c 65 72 20 2a 74 64 62 2a 20 22 68 65 61 ddler *tdb* "hea
1990: 64 69 6e 67 22 20 22 62 6f 64 79 22 20 22 74 61 ding" "body" "ta
19a0: 67 73 22 20 6b 65 79 20 30 29 29 0a 3b 3b 20 28 gs" key 0)).;; (
19b0: 74 65 73 74 20 22 74 77 69 6b 69 3a 73 61 76 65 test "twiki:save
19c0: 2d 63 75 72 72 2d 74 69 64 64 6c 65 72 22 20 20 -curr-tiddler"
19d0: 23 66 20 20 20 20 20 20 20 28 74 77 69 6b 69 3a #f (twiki:
19e0: 73 61 76 65 2d 63 75 72 72 2d 74 69 64 64 6c 65 save-curr-tiddle
19f0: 72 20 2a 74 64 62 2a 20 31 29 29 0a 28 74 65 73 r *tdb* 1)).(tes
1a00: 74 20 22 74 77 69 6b 69 3a 65 64 69 74 2d 74 77 t "twiki:edit-tw
1a10: 69 64 64 6c 65 72 22 20 20 20 20 20 20 23 74 20 iddler" #t
1a20: 20 20 20 20 20 20 28 6c 69 73 74 3f 20 28 74 77 (list? (tw
1a30: 69 6b 69 3a 65 64 69 74 2d 74 69 64 64 6c 65 72 iki:edit-tiddler
1a40: 20 2a 74 64 62 2a 20 6b 65 79 20 30 20 30 29 29 *tdb* key 0 0))
1a50: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 6d ).(test "twiki:m
1a60: 61 69 6e 74 5f 61 72 65 61 22 20 20 20 20 20 20 aint_area"
1a70: 20 20 20 22 3c 44 49 56 3e 22 20 20 28 63 61 72 "<DIV>" (car
1a80: 20 28 74 77 69 6b 69 3a 6d 61 69 6e 74 5f 61 72 (twiki:maint_ar
1a90: 65 61 20 2a 74 64 62 2a 20 31 20 6b 65 79 20 77 ea *tdb* 1 key w
1aa0: 69 6b 69 29 29 29 0a 28 74 65 73 74 20 22 74 77 iki))).(test "tw
1ab0: 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 22 20 20 20 iki:pic_mgmt"
1ac0: 20 20 20 20 20 20 20 20 22 3c 44 49 56 3e 22 20 "<DIV>"
1ad0: 20 28 63 61 72 20 28 74 77 69 6b 69 3a 70 69 63 (car (twiki:pic
1ae0: 5f 6d 67 6d 74 20 2a 74 64 62 2a 20 31 20 6b 65 _mgmt *tdb* 1 ke
1af0: 79 29 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20 62 y)))..;; get a b
1b00: 6c 6f 62 20 6a 70 67 20 74 6f 20 70 72 6f 63 65 lob jpg to proce
1b10: 73 73 0a 28 64 65 66 69 6e 65 20 69 6e 70 32 20 ss.(define inp2
1b20: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 (open-input-file
1b30: 20 22 74 65 73 74 73 2f 6b 69 61 74 6f 61 2e 70 "tests/kiatoa.p
1b40: 6e 67 22 29 29 0a 28 64 65 66 69 6e 65 20 64 61 ng")).(define da
1b50: 74 20 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f 62 t (string->blob
1b60: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 (read-string #f
1b70: 20 69 6e 70 32 29 29 29 0a 28 63 6c 6f 73 65 2d inp2))).(close-
1b80: 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 32 29 input-port inp2)
1b90: 0a 0a 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a ...(test "twiki:
1ba0: 73 61 76 65 2d 70 69 63 22 20 20 20 20 20 20 20 save-pic"
1bb0: 20 20 20 20 23 74 20 20 20 20 20 20 20 28 74 77 #t (tw
1bc0: 69 6b 69 3a 73 61 76 65 2d 70 69 63 20 2a 74 64 iki:save-pic *td
1bd0: 62 2a 20 28 6c 69 73 74 20 22 6d 79 70 69 63 2e b* (list "mypic.
1be0: 6a 70 67 22 20 22 69 6d 61 67 65 2f 6a 70 65 67 jpg" "image/jpeg
1bf0: 22 20 64 61 74 29 20 30 29 29 20 3b 3b 20 28 73 " dat) 0)) ;; (s
1c00: 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 22 74 65 73 tring->blob "tes
1c10: 74 69 6e 67 20 65 68 21 22 29 29 29 29 20 0a 3b ting eh!")))) .;
1c20: 3b 20 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 ; (test "twiki:s
1c30: 61 76 65 2d 70 69 63 2d 66 72 6f 6d 2d 66 6f 72 ave-pic-from-for
1c40: 6d 22 20 23 66 20 20 20 20 20 20 20 28 74 77 69 m" #f (twi
1c50: 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 72 6f 6d ki:save-pic-from
1c60: 2d 66 6f 72 6d 20 2a 74 64 62 2a 20 31 29 29 0a -form *tdb* 1)).
1c70: 0a 3b 3b 20 6d 6f 72 65 20 74 65 73 74 73 20 6f .;; more tests o
1c80: 6e 20 64 61 74 73 0a 0a 28 64 65 66 69 6e 65 20 n dats..(define
1c90: 64 61 74 20 23 66 29 0a 28 6c 65 74 20 28 28 69 dat #f).(let ((i
1ca0: 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 np (open-input-f
1cb0: 69 6c 65 20 22 74 65 73 74 73 2f 6b 69 61 74 6f ile "tests/kiato
1cc0: 61 2e 70 6e 67 22 29 29 29 0a 20 20 28 73 65 74 a.png"))). (set
1cd0: 21 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 ! dat (read-stri
1ce0: 6e 67 20 23 66 20 69 6e 70 29 29 0a 20 20 28 63 ng #f inp)). (c
1cf0: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
1d00: 69 6e 70 29 29 0a 28 75 73 65 20 6d 64 35 29 0a inp)).(use md5).
1d10: 28 64 65 66 69 6e 65 20 64 61 74 2d 6d 64 35 20 (define dat-md5
1d20: 28 6d 64 35 3a 64 69 67 65 73 74 20 64 61 74 29 (md5:digest dat)
1d30: 29 0a 28 74 65 73 74 20 22 74 77 69 6b 69 3a 73 ).(test "twiki:s
1d40: 61 76 65 2d 64 61 74 20 28 62 69 6e 61 72 79 29 ave-dat (binary)
1d50: 22 20 34 20 20 20 20 20 20 20 20 28 74 77 69 6b " 4 (twik
1d60: 69 3a 73 61 76 65 2d 64 61 74 20 2a 74 64 62 2a i:save-dat *tdb*
1d70: 20 64 61 74 20 31 29 29 0a 28 74 65 73 74 20 22 dat 1)).(test "
1d80: 74 77 69 6b 69 3a 67 65 74 2d 64 61 74 20 28 62 twiki:get-dat (b
1d90: 69 6e 61 72 79 29 22 20 20 64 61 74 2d 6d 64 35 inary)" dat-md5
1da0: 20 20 28 6c 65 74 20 28 28 64 20 28 74 77 69 6b (let ((d (twik
1db0: 69 3a 67 65 74 2d 64 61 74 20 2a 74 64 62 2a 20 i:get-dat *tdb*
1dc0: 34 29 29 29 0a 09 09 09 09 09 20 20 20 28 6d 64 4)))...... (md
1dd0: 35 3a 64 69 67 65 73 74 20 64 29 29 29 0a 3b 3b 5:digest d))).;;
1de0: 20 66 6f 72 6d 73 0a 3b 3b 20 28 64 65 66 69 6e forms.;; (defin
1df0: 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 e inp (open-inpu
1e00: 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 78 t-file "tests/ex
1e10: 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 29 ample.post.in"))
1e20: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 64 61 74 20 .;; (define dat
1e30: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 (read-string #f
1e40: 69 6e 70 29 29 0a 3b 3b 20 28 64 65 66 69 6e 65 inp)).;; (define
1e50: 20 64 61 74 73 74 72 20 28 6f 70 65 6e 2d 69 6e datstr (open-in
1e60: 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 29 29 put-string dat))
1e70: 0a 0a 3b 3b 20 62 69 6e 61 72 79 20 69 6e 70 75 ..;; binary inpu
1e80: 74 73 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 28 ts.(define inp (
1e90: 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 open-input-file
1ea0: 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 "tests/example.p
1eb0: 6f 73 74 2e 62 69 6e 61 72 79 2e 69 6e 22 29 29 ost.binary.in"))
1ec0: 0a 28 64 65 66 69 6e 65 20 64 61 74 20 23 66 29 .(define dat #f)
1ed0: 0a 0a 28 74 65 73 74 20 22 66 6f 72 6d 64 61 74 ..(test "formdat
1ee0: 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 6d :load-all-port m
1ef0: 75 6c 74 69 70 61 72 74 22 20 23 74 20 28 6c 65 ultipart" #t (le
1f00: 74 20 28 28 69 64 61 74 20 28 66 6f 72 6d 64 61 t ((idat (formda
1f10: 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 t:load-all-port
1f20: 69 6e 70 29 29 29 0a 09 09 09 09 20 20 20 28 73 inp)))..... (s
1f30: 65 74 21 20 64 61 74 20 69 64 61 74 29 0a 09 09 et! dat idat)...
1f40: 09 09 20 20 20 23 74 29 29 0a 28 74 65 73 74 20 .. #t)).(test
1f50: 22 66 6f 72 6d 64 61 74 3a 6b 65 79 73 22 20 27 "formdat:keys" '
1f60: 28 70 69 63 74 75 72 65 2d 6e 61 6d 65 20 69 6e (picture-name in
1f70: 70 75 74 2d 70 69 63 74 75 72 65 20 22 22 20 73 put-picture "" s
1f80: 75 62 6d 69 74 2d 70 69 63 74 75 72 65 29 20 28 ubmit-picture) (
1f90: 66 6f 72 6d 64 61 74 3a 6b 65 79 73 20 64 61 74 formdat:keys dat
1fa0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 ))..(define inp
1fb0: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 (open-input-file
1fc0: 20 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e "tests/example.
1fd0: 70 6f 73 74 2e 69 6e 22 29 29 0a 28 74 65 73 74 post.in")).(test
1fe0: 20 22 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 "formdat:load-a
1ff0: 6c 6c 2d 70 6f 72 74 20 73 69 6e 67 6c 65 20 70 ll-port single p
2000: 61 72 74 22 20 23 74 20 28 6c 65 74 20 28 28 69 art" #t (let ((i
2010: 64 61 74 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 dat (formdat:loa
2020: 64 2d 61 6c 6c 2d 70 6f 72 74 20 69 6e 70 29 29 d-all-port inp))
2030: 29 0a 09 09 09 09 20 20 20 28 73 65 74 21 20 64 )..... (set! d
2040: 61 74 20 69 64 61 74 29 0a 09 09 09 09 20 20 20 at idat).....
2050: 23 74 29 29 0a 28 74 65 73 74 20 22 66 6f 72 6d #t)).(test "form
2060: 64 61 74 3a 6b 65 79 73 22 20 27 28 65 6d 61 69 dat:keys" '(emai
2070: 6c 2d 61 64 64 72 65 73 73 20 66 6f 72 6d 2d 6e l-address form-n
2080: 61 6d 65 20 70 61 73 73 77 6f 72 64 29 20 28 66 ame password) (f
2090: 6f 72 6d 64 61 74 3a 6b 65 79 73 20 64 61 74 29 ormdat:keys dat)
20a0: 29 0a 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d )..(close-input-
20b0: 70 6f 72 74 20 69 6e 70 29 0a port inp).