Artifact
f61402872452cf4e40b0434f503de09df6d78410:
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 54 68 69 /csi -q ..;; Thi
0020: 73 20 63 75 72 72 65 6e 74 6c 79 20 72 65 71 75 s currently requ
0030: 69 72 65 73 20 74 68 61 74 20 74 68 65 20 73 74 ires that the st
0040: 6d 6c 20 63 6f 64 65 20 69 73 20 61 76 61 69 6c ml code is avail
0050: 61 62 6c 65 20 69 6e 20 61 20 70 61 72 61 6c 6c able in a parall
0060: 65 6c 20 64 69 72 65 63 74 6f 72 79 2e 0a 0a 28 el directory...(
0070: 75 73 65 20 74 65 73 74 29 0a 28 69 66 20 28 66 use test).(if (f
0080: 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 74 65 73 ile-exists? "tes
0090: 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 t.db"). (begi
00a0: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 n. (print "
00b0: 52 65 6d 6f 76 69 6e 67 20 6f 6c 64 20 74 65 73 Removing old tes
00c0: 74 2e 64 62 22 29 0a 20 20 20 20 20 20 28 73 79 t.db"). (sy
00d0: 73 74 65 6d 20 22 72 6d 20 2d 66 20 74 65 73 74 stem "rm -f test
00e0: 2e 64 62 22 29 29 29 0a 0a 28 6c 6f 61 64 20 22 .db")))..(load "
00f0: 2e 2e 2f 73 74 6d 6c 2f 6d 69 73 63 2d 73 74 6d ../stml/misc-stm
0100: 6c 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e l.scm").(load ".
0110: 2e 2f 73 74 6d 6c 2f 66 6f 72 6d 64 61 74 2e 73 ./stml/formdat.s
0120: 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e 2e 2f 73 cm").(load "../s
0130: 74 6d 6c 2f 73 74 6d 6c 2e 73 63 6d 22 29 0a 28 tml/stml.scm").(
0140: 6c 6f 61 64 20 22 2e 2e 2f 73 74 6d 6c 2f 73 65 load "../stml/se
0150: 73 73 69 6f 6e 2e 73 63 6d 22 29 0a 28 6c 6f 61 ssion.scm").(loa
0160: 64 20 22 2e 2e 2f 73 74 6d 6c 2f 73 71 6c 74 62 d "../stml/sqltb
0170: 6c 2e 73 63 6d 22 29 0a 28 6c 6f 61 64 20 22 2e l.scm").(load ".
0180: 2e 2f 73 74 6d 6c 2f 68 74 6d 6c 2d 66 69 6c 74 ./stml/html-filt
0190: 65 72 2e 73 63 6d 22 29 20 3b 3b 20 72 65 71 75 er.scm") ;; requ
01a0: 69 72 65 64 20 66 6f 72 20 73 3a 73 70 6c 69 74 ired for s:split
01b0: 2d 73 74 72 69 6e 67 20 0a 28 6c 6f 61 64 20 22 -string .(load "
01c0: 2e 2e 2f 73 74 6d 6c 2f 64 62 69 2e 73 63 6d 22 ../stml/dbi.scm"
01d0: 29 0a 28 6c 6f 61 64 20 22 2e 2e 2f 73 74 6d 6c ).(load "../stml
01e0: 2f 6b 65 79 73 74 6f 72 65 2e 73 63 6d 22 29 0a /keystore.scm").
01f0: 28 6c 6f 61 64 20 22 2e 2e 2f 73 74 6d 6c 2f 73 (load "../stml/s
0200: 75 67 61 72 2e 73 63 6d 22 29 0a 0a 3b 3b 20 63 ugar.scm")..;; c
0210: 72 65 61 74 65 20 61 20 73 65 73 73 69 6f 6e 20 reate a session
0220: 74 6f 20 77 6f 72 6b 20 77 69 74 68 22 29 0a 28 to work with").(
0230: 73 65 74 65 6e 76 20 22 52 45 51 55 45 53 54 5f setenv "REQUEST_
0240: 55 52 49 22 20 22 2f 73 74 6d 6c 72 75 6e 3f 61 URI" "/stmlrun?a
0250: 63 74 69 6f 6e 3d 6d 61 69 6e 74 2e 6e 61 64 61 ction=maint.nada
0260: 22 29 0a 28 73 65 74 65 6e 76 20 22 53 43 52 49 ").(setenv "SCRI
0270: 50 54 5f 4e 41 4d 45 22 20 22 2f 63 67 69 2d 62 PT_NAME" "/cgi-b
0280: 69 6e 2f 73 74 6d 6c 72 75 6e 22 29 0a 28 73 65 in/stmlrun").(se
0290: 74 65 6e 76 20 22 50 41 54 48 5f 49 4e 46 4f 22 tenv "PATH_INFO"
02a0: 20 22 2f 6d 61 69 6e 74 22 29 0a 28 73 65 74 65 "/maint").(sete
02b0: 6e 76 20 22 51 55 45 52 59 5f 53 54 52 49 4e 47 nv "QUERY_STRING
02c0: 22 20 22 61 63 74 69 6f 6e 3d 6d 61 69 6e 74 2e " "action=maint.
02d0: 6e 61 64 61 22 29 0a 28 73 65 74 65 6e 76 20 22 nada").(setenv "
02e0: 53 45 52 56 45 52 5f 4e 41 4d 45 22 20 22 6c 6f SERVER_NAME" "lo
02f0: 63 61 6c 68 6f 73 74 22 29 0a 28 73 65 74 65 6e calhost").(seten
0300: 76 20 22 52 45 51 55 45 53 54 5f 4d 45 54 48 4f v "REQUEST_METHO
0310: 44 22 20 22 47 45 54 22 29 0a 3b 3b 20 28 64 65 D" "GET").;; (de
0320: 66 69 6e 65 20 73 65 73 73 69 6f 6e 2d 6e 61 6d fine session-nam
0330: 65 20 22 70 66 4e 4f 65 71 55 48 6b 4a 32 36 42 e "pfNOeqUHkJ26B
0340: 70 55 36 79 34 39 49 4e 22 29 20 3b 3b 20 65 6e pU6y49IN") ;; en
0350: 73 75 72 65 20 74 68 69 73 20 73 65 73 73 69 6f sure this sessio
0360: 6e 20 61 6c 72 65 61 64 79 20 65 78 69 73 74 73 n already exists
0370: 0a 3b 3b 20 28 73 65 74 65 6e 76 20 22 48 54 54 .;; (setenv "HTT
0380: 50 5f 43 4f 4f 4b 49 45 22 20 28 73 74 72 69 6e P_COOKIE" (strin
0390: 67 2d 61 70 70 65 6e 64 20 22 73 65 73 73 69 6f g-append "sessio
03a0: 6e 5f 6b 65 79 3d 22 20 73 65 73 73 69 6f 6e 2d n_key=" session-
03b0: 6e 61 6d 65 29 29 20 3b 3b 20 74 6f 30 39 69 70 name)) ;; to09ip
03c0: 46 4a 39 5f 32 4b 58 54 39 36 62 32 66 39 51 22 FJ9_2KXT96b2f9Q"
03d0: 29 0a 0a 28 6c 6f 61 64 20 22 2e 2e 2f 73 74 6d )..(load "../stm
03e0: 6c 2f 73 65 74 75 70 2e 73 63 6d 22 29 0a 3b 3b l/setup.scm").;;
03f0: 20 28 74 65 73 74 20 28 73 74 72 69 6e 67 2d 61 (test (string-a
0400: 70 70 65 6e 64 20 22 53 65 73 73 69 6f 6e 20 73 ppend "Session s
0410: 65 74 20 74 6f 20 65 78 69 73 74 69 6e 67 20 73 et to existing s
0420: 65 73 73 69 6f 6e 20 22 20 73 65 73 73 69 6f 6e ession " session
0430: 2d 6e 61 6d 65 29 0a 3b 3b 20 20 20 20 20 20 20 -name).;;
0440: 73 65 73 73 69 6f 6e 2d 6e 61 6d 65 20 28 73 6c session-name (sl
0450: 6f 74 2d 72 65 66 20 73 3a 73 65 73 73 69 6f 6e ot-ref s:session
0460: 20 27 73 65 73 73 69 6f 6e 2d 6b 65 79 29 29 0a 'session-key)).
0470: 0a 28 73 3a 76 61 6c 69 64 61 74 65 2d 69 6e 70 .(s:validate-inp
0480: 75 74 73 29 0a 0a 3b 3b 20 74 65 73 74 20 73 65 uts)..;; test se
0490: 73 73 69 6f 6e 20 76 61 72 69 61 62 6c 65 73 0a ssion variables.
04a0: 0a 3b 3b 20 6c 61 7a 79 20 73 74 75 66 66 0a 28 .;; lazy stuff.(
04b0: 64 65 66 69 6e 65 20 2a 63 6f 6e 6e 2a 20 28 73 define *conn* (s
04c0: 6c 6f 74 2d 72 65 66 20 73 3a 73 65 73 73 69 6f lot-ref s:sessio
04d0: 6e 20 27 63 6f 6e 6e 29 29 0a 0a 3b 3b 20 73 65 n 'conn))..;; se
04e0: 74 75 70 20 74 61 62 6c 65 73 0a 28 6c 6f 61 64 tup tables.(load
04f0: 20 22 6d 6f 64 65 6c 73 2f 6d 61 69 6e 74 2e 73 "models/maint.s
0500: 63 6d 22 29 0a 28 74 65 73 74 20 22 43 72 65 61 cm").(test "Crea
0510: 74 65 20 74 61 62 6c 65 73 22 20 23 74 20 28 3e te tables" #t (>
0520: 20 28 6d 61 69 6e 74 3a 75 70 64 61 74 65 2d 74 (maint:update-t
0530: 61 62 6c 65 73 29 0a 09 09 09 20 20 20 20 30 29 ables).... 0)
0540: 29 0a 0a 3b 3b 20 74 65 73 74 20 70 65 72 73 6f )..;; test perso
0550: 6e 0a 28 6c 65 74 20 28 28 66 68 20 28 6f 70 65 n.(let ((fh (ope
0560: 6e 2d 69 6e 70 75 74 2d 70 69 70 65 20 22 6c 73 n-input-pipe "ls
0570: 20 6d 6f 64 65 6c 73 2f 2a 2e 73 63 6d 22 29 29 models/*.scm"))
0580: 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 ). (let loop ((
0590: 6c 20 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 l (read-line fh)
05a0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
05b0: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 29 29 (eof-object? l))
05c0: 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a . (begin.
05d0: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
05e0: 20 22 6c 6f 61 64 69 6e 67 20 22 20 6c 29 0a 20 "loading " l).
05f0: 20 20 20 20 20 20 20 20 20 28 6c 6f 61 64 20 6c (load l
0600: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f ). (loo
0610: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 p (read-line fh)
0620: 29 29 29 29 0a 20 20 28 63 6c 6f 73 65 2d 69 6e )))). (close-in
0630: 70 75 74 2d 70 6f 72 74 20 66 68 29 29 0a 0a 28 put-port fh))..(
0640: 6c 65 74 20 28 28 66 68 20 28 6f 70 65 6e 2d 69 let ((fh (open-i
0650: 6e 70 75 74 2d 70 69 70 65 20 22 66 69 6e 64 20 nput-pipe "find
0660: 70 61 67 65 73 20 2d 6e 61 6d 65 20 63 6f 6e 74 pages -name cont
0670: 72 6f 6c 2e 73 63 6d 22 29 29 29 20 3b 3b 20 6c rol.scm"))) ;; l
0680: 73 20 70 61 67 65 73 2f 2a 2f 63 6f 6e 74 72 6f s pages/*/contro
0690: 6c 2e 73 63 6d 22 29 29 29 0a 20 20 28 6c 65 74 l.scm"))). (let
06a0: 20 6c 6f 6f 70 20 28 28 6c 20 28 72 65 61 64 2d loop ((l (read-
06b0: 6c 69 6e 65 20 66 68 29 29 29 0a 20 20 20 20 28 line fh))). (
06c0: 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a if (not (eof-obj
06d0: 65 63 74 3f 20 6c 29 29 0a 20 20 20 20 20 20 20 ect? l)).
06e0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
06f0: 20 20 28 70 72 69 6e 74 20 22 6c 6f 61 64 69 6e (print "loadin
0700: 67 20 22 20 6c 29 0a 20 20 20 20 20 20 20 20 20 g " l).
0710: 20 28 6c 6f 61 64 20 6c 29 0a 20 20 20 20 20 20 (load l).
0720: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read-
0730: 6c 69 6e 65 20 66 68 29 29 29 29 29 0a 20 20 28 line fh))))). (
0740: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
0750: 20 66 68 29 29 0a 0a 28 6c 65 74 20 28 28 66 68 fh))..(let ((fh
0760: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 70 69 70 (open-input-pip
0770: 65 20 22 6c 73 20 70 61 67 65 73 2f 2a 2f 76 69 e "ls pages/*/vi
0780: 65 77 2e 73 63 6d 22 29 29 29 0a 20 20 28 6c 65 ew.scm"))). (le
0790: 74 20 6c 6f 6f 70 20 28 28 6c 20 28 72 65 61 64 t loop ((l (read
07a0: 2d 6c 69 6e 65 20 66 68 29 29 29 0a 20 20 20 20 -line fh))).
07b0: 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 (if (not (eof-ob
07c0: 6a 65 63 74 3f 20 6c 29 29 0a 20 20 20 20 20 20 ject? l)).
07d0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
07e0: 20 20 20 28 70 72 69 6e 74 20 22 6c 6f 61 64 69 (print "loadi
07f0: 6e 67 20 22 20 6c 29 0a 20 20 20 20 20 20 20 20 ng " l).
0800: 20 20 28 6c 6f 61 64 20 6c 29 0a 20 20 20 20 20 (load l).
0810: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read
0820: 2d 6c 69 6e 65 20 66 68 29 29 29 29 29 0a 20 20 -line fh))))).
0830: 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 (close-input-por
0840: 74 20 66 68 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d t fh))..;;======
0850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0890: 0a 3b 3b 20 4d 61 69 6e 74 0a 3b 3b 3d 3d 3d 3d .;; Maint.;;====
08a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08e0: 3d 3d 0a 3b 3b 20 0a 28 6c 6f 61 64 20 22 6d 6f ==.;; .(load "mo
08f0: 64 65 6c 73 2f 6d 61 69 6e 74 2e 73 63 6d 22 29 dels/maint.scm")
0900: 0a 0a 28 74 65 73 74 20 22 55 70 64 61 74 65 20 ..(test "Update
0910: 74 61 62 6c 65 73 22 20 20 20 23 74 20 20 20 20 tables" #t
0920: 20 20 20 20 20 20 20 20 20 20 20 20 28 3e 20 28 (> (
0930: 6d 61 69 6e 74 3a 75 70 64 61 74 65 2d 74 61 62 maint:update-tab
0940: 6c 65 73 29 29 29 20 3b 3b 20 20 2a 63 6f 6e 6e les))) ;; *conn
0950: 2a 20 32 20 22 75 73 22 29 20 30 29 29 0a 28 74 * 2 "us") 0)).(t
0960: 65 73 74 20 22 41 64 64 20 75 73 65 72 22 20 20 est "Add user"
0970: 20 20 20 20 20 20 22 6d 61 74 74 40 6b 69 61 74 "matt@kiat
0980: 6f 61 2e 63 6f 6d 22 20 28 76 65 63 74 6f 72 2d oa.com" (vector-
0990: 72 65 66 20 28 70 65 72 73 6f 6e 3a 73 65 74 2d ref (person:set-
09a0: 70 61 73 73 77 6f 72 64 20 22 6d 61 74 74 40 6b password "matt@k
09b0: 69 61 74 6f 61 2e 63 6f 6d 22 20 22 50 61 73 73 iatoa.com" "Pass
09c0: 77 6f 72 64 22 29 20 32 29 29 0a 28 74 65 73 74 word") 2)).(test
09d0: 20 22 41 75 74 68 65 6e 74 69 63 61 74 65 22 20 "Authenticate"
09e0: 20 20 20 22 6d 61 74 74 40 6b 69 61 74 6f 61 2e "matt@kiatoa.
09f0: 63 6f 6d 22 20 28 76 65 63 74 6f 72 2d 72 65 66 com" (vector-ref
0a00: 20 28 70 65 72 73 6f 6e 3a 61 75 74 68 65 6e 74 (person:authent
0a10: 69 63 61 74 65 20 22 6d 61 74 74 40 6b 69 61 74 icate "matt@kiat
0a20: 6f 61 2e 63 6f 6d 22 20 22 50 61 73 73 77 6f 72 oa.com" "Passwor
0a30: 64 22 29 20 32 29 29 0a 28 74 65 73 74 20 22 56 d") 2)).(test "V
0a40: 61 6c 69 64 61 74 65 20 69 6e 70 75 74 73 22 20 alidate inputs"
0a50: 23 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 #t
0a60: 20 20 28 6e 65 77 5f 61 63 63 6f 75 6e 74 3a 76 (new_account:v
0a70: 61 6c 69 64 61 74 65 2d 69 6e 70 75 74 73 20 22 alidate-inputs "
0a80: 50 61 73 73 77 6f 72 64 22 20 22 50 61 73 73 77 Password" "Passw
0a90: 6f 72 64 22 20 22 6d 61 74 74 40 6b 69 61 74 6f ord" "matt@kiato
0aa0: 61 2e 63 6f 6d 22 20 22 6d 61 74 74 40 6b 69 61 a.com" "matt@kia
0ab0: 74 6f 61 2e 63 6f 6d 22 29 29 0a 0a toa.com"))..