Artifact
427854d9108776c09976d7aab109f21c1db683d8:
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 37 2d 32 30 31 31 2c 20 4d 61 74 74 68 65 77 20 7-2011, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 64 65 PURPOSE...;; (de
0150: 63 6c 61 72 65 20 28 75 6e 69 74 20 66 6f 72 6d clare (unit form
0160: 64 61 74 29 29 0a 0a 28 6d 6f 64 75 6c 65 20 66 dat))..(module f
0170: 6f 72 6d 64 61 74 0a 20 20 20 20 2a 0a 0a 28 69 ormdat. *..(i
0180: 6d 70 6f 72 74 20 63 68 69 63 6b 65 6e 20 73 63 mport chicken sc
0190: 68 65 6d 65 20 64 61 74 61 2d 73 74 72 75 63 74 heme data-struct
01a0: 75 72 65 73 20 65 78 74 72 61 73 20 73 72 66 69 ures extras srfi
01b0: 2d 31 33 20 70 6f 72 74 73 20 29 0a 28 75 73 65 -13 ports ).(use
01c0: 20 68 74 6d 6c 2d 66 69 6c 74 65 72 29 0a 0a 28 html-filter)..(
01d0: 75 73 65 20 72 65 67 65 78 29 0a 28 72 65 71 75 use regex).(requ
01e0: 69 72 65 2d 65 78 74 65 6e 73 69 6f 6e 20 73 72 ire-extension sr
01f0: 66 69 2d 36 39 29 0a 0a 28 64 65 66 69 6e 65 20 fi-69)..(define
0200: 66 6f 72 6d 64 61 74 3a 2a 64 65 62 75 67 2a 20 formdat:*debug*
0210: 23 66 29 0a 0a 3b 3b 20 4f 6c 64 20 64 61 74 61 #f)..;; Old data
0220: 20 66 6f 72 6d 61 74 20 77 61 73 20 73 6f 6d 65 format was some
0230: 74 68 69 6e 67 20 6c 69 6b 65 20 74 68 69 73 2e thing like this.
0240: 20 42 55 54 21 20 0a 3b 3b 20 46 6f 72 6d 73 20 BUT! .;; Forms
0250: 64 6f 20 6e 6f 74 20 68 61 76 65 20 6e 61 6d 65 do not have name
0260: 73 20 73 6f 20 74 68 65 20 68 69 65 72 61 72 63 s so the hierarc
0270: 79 20 69 73 0a 3b 3b 20 75 6e 6e 65 63 65 73 73 y is.;; unnecess
0280: 61 72 79 20 28 49 20 74 68 69 6e 6b 29 0a 3b 3b ary (I think).;;
0290: 0a 3b 3b 20 68 61 73 68 74 61 62 6c 65 0a 3b 3b .;; hashtable.;;
02a0: 20 20 20 7c 2d 66 6f 72 6d 6e 61 6d 65 20 2d 2d |-formname --
02b0: 3e 20 3c 66 6f 72 6d 64 61 74 3e 20 27 66 6f 72 > <formdat> 'for
02c0: 6d 2d 6e 61 6d 65 3d 66 6f 72 6d 6e 61 6d 65 0a m-name=formname.
02d0: 3b 3b 20 20 20 7c 20 20 20 20 20 20 20 20 20 20 ;; |
02e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 66 'f
02f0: 6f 72 6d 2d 64 61 74 61 3d 68 61 73 68 74 61 62 orm-data=hashtab
0300: 6c 65 0a 3b 3b 20 20 20 7c 20 20 20 20 20 20 20 le.;; |
0310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0330: 7c 20 6e 61 6d 65 20 3d 3e 20 76 61 6c 75 65 0a | name => value.
0340: 3b 3b 0a 3b 3b 20 4e 65 77 20 64 61 74 61 20 66 ;;.;; New data f
0350: 6f 72 6d 61 74 20 69 73 20 6f 6e 6c 79 20 74 68 ormat is only th
0360: 65 20 3c 66 6f 72 6d 64 61 74 3e 20 70 6f 72 74 e <formdat> port
0370: 69 6f 6e 20 66 72 6f 6d 20 61 62 6f 76 65 0a 0a ion from above..
0380: 3b 3b 20 28 64 65 66 69 6e 65 2d 63 6c 61 73 73 ;; (define-class
0390: 20 3c 66 6f 72 6d 64 61 74 3e 20 28 29 0a 3b 3b <formdat> ().;;
03a0: 20 20 20 20 28 66 6f 72 6d 2d 64 61 74 61 0a 3b (form-data.;
03b0: 3b 20 20 20 20 29 29 0a 28 64 65 66 69 6e 65 20 ; )).(define
03c0: 28 6d 61 6b 65 2d 66 6f 72 6d 64 61 74 3a 66 6f (make-formdat:fo
03d0: 72 6d 64 61 74 29 28 76 65 63 74 6f 72 20 28 6d rmdat)(vector (m
03e0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
03f0: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
0400: 20 28 66 6f 72 6d 64 61 74 3a 66 6f 72 6d 64 61 (formdat:formda
0410: 74 2d 67 65 74 2d 64 61 74 61 20 20 20 76 65 63 t-get-data vec
0420: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
0430: 20 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e vec 0)).(defin
0440: 65 2d 69 6e 6c 69 6e 65 20 28 66 6f 72 6d 64 61 e-inline (formda
0450: 74 3a 66 6f 72 6d 64 61 74 2d 73 65 74 2d 64 61 t:formdat-set-da
0460: 74 61 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 ta! vec val)(ve
0470: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 20 ctor-set! vec 0
0480: 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 val))..(define (
0490: 66 6f 72 6d 64 61 74 3a 69 6e 69 74 69 61 6c 69 formdat:initiali
04a0: 7a 65 20 73 65 6c 66 29 0a 20 20 28 66 6f 72 6d ze self). (form
04b0: 64 61 74 3a 66 6f 72 6d 64 61 74 2d 73 65 74 2d dat:formdat-set-
04c0: 64 61 74 61 21 20 73 65 6c 66 20 28 6d 61 6b 65 data! self (make
04d0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 0a -hash-table)))..
04e0: 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 (define (formdat
04f0: 3a 67 65 74 20 73 65 6c 66 20 6b 65 79 29 0a 20 :get self key).
0500: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
0510: 2f 64 65 66 61 75 6c 74 20 0a 20 20 20 28 66 6f /default . (fo
0520: 72 6d 64 61 74 3a 66 6f 72 6d 64 61 74 2d 67 65 rmdat:formdat-ge
0530: 74 2d 64 61 74 61 20 73 65 6c 66 29 0a 20 20 20 t-data self).
0540: 28 63 6f 6e 64 20 0a 20 20 20 20 28 28 73 79 6d (cond . ((sym
0550: 62 6f 6c 3f 20 6b 65 79 29 20 6b 65 79 29 0a 20 bol? key) key).
0560: 20 20 20 28 28 73 74 72 69 6e 67 3f 20 6b 65 79 ((string? key
0570: 29 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f ) (string->symbo
0580: 6c 20 6b 65 79 29 29 0a 20 20 20 20 28 65 6c 73 l key)). (els
0590: 65 20 6b 65 79 29 29 0a 20 20 20 23 66 29 29 0a e key)). #f)).
05a0: 0a 3b 3b 20 63 68 61 6e 67 65 20 74 6f 20 63 6f .;; change to co
05b0: 6e 76 65 72 74 20 64 61 74 61 20 74 6f 20 6c 69 nvert data to li
05c0: 73 74 20 61 6e 64 20 61 70 70 65 6e 64 20 76 61 st and append va
05d0: 6c 20 69 66 20 61 6c 72 65 61 64 79 20 65 78 69 l if already exi
05e0: 73 74 73 0a 3b 3b 20 6f 72 20 69 73 20 61 20 6c sts.;; or is a l
05f0: 69 73 74 0a 28 64 65 66 69 6e 65 20 28 66 6f 72 ist.(define (for
0600: 6d 64 61 74 3a 73 65 74 21 20 73 65 6c 66 20 6b mdat:set! self k
0610: 65 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 28 ey val). (let (
0620: 28 70 72 65 76 2d 76 61 6c 20 28 66 6f 72 6d 64 (prev-val (formd
0630: 61 74 3a 67 65 74 20 73 65 6c 66 20 6b 65 79 29 at:get self key)
0640: 29 0a 20 20 20 20 20 20 20 20 28 68 74 20 20 20 ). (ht
0650: 20 20 20 20 28 66 6f 72 6d 64 61 74 3a 66 6f 72 (formdat:for
0660: 6d 64 61 74 2d 67 65 74 2d 64 61 74 61 20 73 65 mdat-get-data se
0670: 6c 66 29 29 29 0a 20 20 20 20 28 69 66 20 70 72 lf))). (if pr
0680: 65 76 2d 76 61 6c 0a 20 20 20 20 20 20 20 20 28 ev-val. (
0690: 69 66 20 28 6c 69 73 74 3f 20 70 72 65 76 2d 76 if (list? prev-v
06a0: 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 al).
06b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
06c0: 20 68 74 20 6b 65 79 20 28 63 6f 6e 73 20 76 61 ht key (cons va
06d0: 6c 20 70 72 65 76 2d 76 61 6c 29 29 0a 20 20 20 l prev-val)).
06e0: 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 (hash-t
06f0: 61 62 6c 65 2d 73 65 74 21 20 68 74 20 6b 65 79 able-set! ht key
0700: 20 28 6c 69 73 74 20 76 61 6c 20 70 72 65 76 2d (list val prev-
0710: 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 28 val))). (
0720: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
0730: 68 74 20 6b 65 79 20 76 61 6c 29 29 0a 20 20 20 ht key val)).
0740: 20 73 65 6c 66 29 29 0a 0a 28 64 65 66 69 6e 65 self))..(define
0750: 20 28 66 6f 72 6d 64 61 74 3a 6b 65 79 73 20 73 (formdat:keys s
0760: 65 6c 66 29 0a 20 20 28 68 61 73 68 2d 74 61 62 elf). (hash-tab
0770: 6c 65 2d 6b 65 79 73 20 28 66 6f 72 6d 64 61 74 le-keys (formdat
0780: 3a 66 6f 72 6d 64 61 74 2d 67 65 74 2d 64 61 74 :formdat-get-dat
0790: 61 20 73 65 6c 66 29 29 29 0a 0a 28 64 65 66 69 a self)))..(defi
07a0: 6e 65 20 28 66 6f 72 6d 64 61 74 3a 70 72 69 6e ne (formdat:prin
07b0: 74 61 6c 6c 20 73 65 6c 66 20 70 72 69 6e 74 70 tall self printp
07c0: 72 6f 63 29 0a 20 20 28 70 72 69 6e 74 70 72 6f roc). (printpro
07d0: 63 20 22 66 6f 72 6d 64 61 74 3a 70 72 69 6e 74 c "formdat:print
07e0: 61 6c 6c 20 22 20 28 66 6f 72 6d 64 61 74 3a 6b all " (formdat:k
07f0: 65 79 73 20 73 65 6c 66 29 29 0a 20 20 28 66 6f eys self)). (fo
0800: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
0810: 6b 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 k).. (print
0820: 70 72 6f 63 20 6b 20 22 20 3d 3e 20 22 20 28 66 proc k " => " (f
0830: 6f 72 6d 64 61 74 3a 67 65 74 20 73 65 6c 66 20 ormdat:get self
0840: 6b 29 29 29 0a 09 20 20 20 20 28 66 6f 72 6d 64 k))).. (formd
0850: 61 74 3a 6b 65 79 73 20 73 65 6c 66 29 29 29 0a at:keys self))).
0860: 0a 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 .(define (formda
0870: 74 3a 61 6c 6c 2d 3e 73 74 72 69 6e 67 73 20 73 t:all->strings s
0880: 65 6c 66 29 0a 20 20 28 6c 65 74 20 28 28 72 65 elf). (let ((re
0890: 73 20 27 28 29 29 29 0a 20 20 20 20 28 66 6f 72 s '())). (for
08a0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
08b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
08c0: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
08d0: 6e 73 20 28 63 6f 6e 63 20 6b 20 22 3d 3e 22 20 ns (conc k "=>"
08e0: 28 66 6f 72 6d 64 61 74 3a 67 65 74 20 73 65 6c (formdat:get sel
08f0: 66 20 6b 29 29 20 72 65 73 29 29 29 0a 20 20 20 f k)) res))).
0900: 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 6d (form
0910: 64 61 74 3a 6b 65 79 73 20 73 65 6c 66 29 29 0a dat:keys self)).
0920: 20 20 20 20 20 20 20 20 72 65 73 29 29 0a 0a 3b res))..;
0930: 3b 20 63 61 6c 6c 20 77 69 74 68 20 2a 6f 6e 65 ; call with *one
0940: 2a 20 6f 66 20 74 68 65 20 6c 69 73 74 73 20 69 * of the lists i
0950: 6e 20 74 68 65 20 6c 69 73 74 20 6f 66 20 6c 69 n the list of li
0960: 73 74 73 20 63 72 65 61 74 65 64 20 62 79 20 43 sts created by C
0970: 47 49 3a 75 72 6c 2d 75 6e 71 75 6f 74 65 0a 28 GI:url-unquote.(
0980: 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a define (formdat:
0990: 6c 6f 61 64 20 73 65 6c 66 20 66 6f 72 6d 6c 69 load self formli
09a0: 73 74 29 0a 20 20 28 6c 65 74 20 28 28 68 74 20 st). (let ((ht
09b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 (for
09c0: 6d 64 61 74 3a 66 6f 72 6d 64 61 74 2d 67 65 74 mdat:formdat-get
09d0: 2d 64 61 74 61 20 73 65 6c 66 29 29 29 0a 20 20 -data self))).
09e0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 6f 72 (if (null? for
09f0: 6d 6c 69 73 74 29 20 73 65 6c 66 20 3b 3b 20 6e mlist) self ;; n
0a00: 6f 20 76 61 6c 75 65 73 20 70 72 6f 76 69 64 65 o values provide
0a10: 64 2c 20 72 65 74 75 72 6e 20 73 65 6c 66 20 66 d, return self f
0a20: 6f 72 20 6e 6f 20 67 6f 6f 64 20 72 65 61 73 6f or no good reaso
0a30: 6e 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c n. (let l
0a40: 6f 6f 70 20 28 28 68 65 61 64 20 28 63 61 72 20 oop ((head (car
0a50: 66 6f 72 6d 6c 69 73 74 29 29 0a 20 20 20 20 20 formlist)).
0a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 (t
0a70: 61 69 6c 20 28 63 64 72 20 66 6f 72 6d 6c 69 73 ail (cdr formlis
0a80: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 t))). (
0a90: 6c 65 74 20 28 28 6b 65 79 20 28 63 61 72 20 68 let ((key (car h
0aa0: 65 61 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 ead)).
0ab0: 20 20 20 20 20 20 28 76 61 6c 20 28 63 64 72 20 (val (cdr
0ac0: 68 65 61 64 29 29 29 0a 20 20 20 20 20 20 20 20 head))).
0ad0: 20 20 20 20 3b 3b 20 28 65 72 72 3a 6c 6f 67 20 ;; (err:log
0ae0: 22 6b 65 79 3d 22 20 6b 65 79 20 22 20 76 61 6c "key=" key " val
0af0: 3d 22 20 76 61 6c 29 0a 09 20 20 20 20 28 69 66 =" val).. (if
0b00: 20 28 3e 20 28 6c 65 6e 67 74 68 20 76 61 6c 29 (> (length val)
0b10: 20 31 29 0a 09 09 28 66 6f 72 6d 64 61 74 3a 73 1)...(formdat:s
0b20: 65 74 21 20 73 65 6c 66 20 6b 65 79 20 76 61 6c et! self key val
0b30: 29 0a 09 09 28 66 6f 72 6d 64 61 74 3a 73 65 74 )...(formdat:set
0b40: 21 20 73 65 6c 66 20 6b 65 79 20 28 63 61 72 20 ! self key (car
0b50: 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 val))).
0b60: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
0b70: 69 6c 29 20 73 65 6c 66 20 20 20 3b 3b 20 77 65 il) self ;; we
0b80: 20 61 72 65 20 64 6f 6e 65 0a 20 20 20 20 20 20 are done.
0b90: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
0ba0: 28 63 61 72 20 74 61 69 6c 29 28 63 64 72 20 74 (car tail)(cdr t
0bb0: 61 69 6c 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 ail))))))))..;;
0bc0: 67 65 74 20 74 68 65 20 68 65 61 64 65 72 20 66 get the header f
0bd0: 72 6f 6d 20 64 61 74 73 74 72 0a 28 64 65 66 69 rom datstr.(defi
0be0: 6e 65 20 28 66 6f 72 6d 64 61 74 3a 72 65 61 64 ne (formdat:read
0bf0: 2d 68 65 61 64 65 72 20 64 61 74 73 74 72 29 20 -header datstr)
0c00: 3b 3b 20 64 61 74 73 74 72 20 69 73 20 61 6e 20 ;; datstr is an
0c10: 69 6e 70 75 74 20 73 74 72 69 6e 67 20 70 6f 72 input string por
0c20: 74 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 t. (let loop ((
0c30: 68 73 20 28 72 65 61 64 2d 6c 69 6e 65 20 64 61 hs (read-line da
0c40: 74 73 74 72 29 29 0a 09 20 20 20 20 20 28 68 65 tstr)).. (he
0c50: 61 64 65 72 20 27 28 29 29 29 0a 20 20 20 20 28 ader '())). (
0c60: 69 66 20 28 6f 72 20 28 65 6f 66 2d 6f 62 6a 65 if (or (eof-obje
0c70: 63 74 3f 20 68 73 29 0a 09 20 20 20 20 28 73 74 ct? hs).. (st
0c80: 72 69 6e 67 3d 3f 20 68 73 20 22 22 29 29 0a 09 ring=? hs ""))..
0c90: 68 65 61 64 65 72 0a 09 28 6c 6f 6f 70 20 28 72 header..(loop (r
0ca0: 65 61 64 2d 6c 69 6e 65 20 64 61 74 73 74 72 29 ead-line datstr)
0cb0: 28 61 70 70 65 6e 64 20 68 65 61 64 65 72 20 28 (append header (
0cc0: 6c 69 73 74 20 68 73 29 29 29 29 29 29 0a 0a 3b list hs))))))..;
0cd0: 3b 20 67 65 74 20 74 68 65 20 64 61 74 61 20 75 ; get the data u
0ce0: 70 20 74 6f 20 74 68 65 20 6e 65 78 74 20 6b 65 p to the next ke
0cf0: 79 2e 20 69 66 20 74 68 65 72 65 20 69 73 20 6e y. if there is n
0d00: 6f 20 6b 65 79 20 74 68 65 6e 20 72 65 74 75 72 o key then retur
0d10: 6e 20 23 66 0a 3b 3b 20 72 65 74 75 72 6e 20 28 n #f.;; return (
0d20: 64 61 74 20 72 65 6d 64 61 74 29 0a 28 64 65 66 dat remdat).(def
0d30: 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a 72 65 61 ine (formdat:rea
0d40: 64 2d 64 61 74 20 64 61 74 20 6b 65 79 29 0a 20 d-dat dat key).
0d50: 20 28 6c 65 74 20 28 28 69 6e 64 65 78 20 28 73 (let ((index (s
0d60: 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 6b ubstring-index k
0d70: 65 79 20 64 61 74 29 29 29 20 3b 3b 20 28 73 74 ey dat))) ;; (st
0d80: 72 69 6e 67 2d 73 65 61 72 63 68 2d 70 6f 73 69 ring-search-posi
0d90: 74 69 6f 6e 73 20 6b 65 79 20 64 61 74 29 29 29 tions key dat)))
0da0: 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f . (if (or (no
0db0: 74 20 69 6e 64 65 78 29 0a 09 20 20 20 20 28 6e t index).. (n
0dc0: 75 6c 6c 3f 20 69 6e 64 65 78 29 29 20 3b 3b 20 ull? index)) ;;
0dd0: 74 68 65 20 6b 65 79 20 77 61 73 20 6e 6f 74 20 the key was not
0de0: 66 6f 75 6e 64 0a 09 23 66 0a 09 28 6c 65 74 2a found..#f..(let*
0df0: 20 28 28 64 61 74 73 74 72 20 28 6f 70 65 6e 2d ((datstr (open-
0e00: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 input-string dat
0e10: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 75 )).. (resu
0e20: 6c 74 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 lt (read-string
0e30: 28 63 61 61 72 20 69 6e 64 65 78 29 20 64 61 74 (caar index) dat
0e40: 73 74 72 29 29 0a 09 20 20 20 20 20 20 20 28 72 str)).. (r
0e50: 65 6d 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 emdat (read-stri
0e60: 6e 67 20 23 66 20 64 61 74 73 74 72 29 29 29 0a ng #f datstr))).
0e70: 09 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d . (close-input-
0e80: 70 6f 72 74 20 64 61 74 73 74 72 29 0a 09 20 20 port datstr)..
0e90: 28 6c 69 73 74 20 72 65 73 75 6c 74 20 72 65 6d (list result rem
0ea0: 64 61 74 29 29 29 29 29 0a 0a 20 3b 3b 20 69 6e dat))))).. ;; in
0eb0: 70 20 69 73 20 70 6f 72 74 20 74 6f 20 72 65 61 p is port to rea
0ec0: 64 20 64 61 74 61 20 66 72 6f 6d 2c 20 6d 61 78 d data from, max
0ed0: 73 69 7a 65 20 69 73 20 6d 61 78 20 64 61 74 61 size is max data
0ee0: 20 61 6c 6c 6f 77 65 64 20 74 6f 20 72 65 61 64 allowed to read
0ef0: 20 28 74 6f 74 61 6c 29 0a 28 64 65 66 69 6e 65 (total).(define
0f00: 20 28 66 6f 72 6d 64 61 74 3a 64 61 74 2d 3e 6c (formdat:dat->l
0f10: 69 73 74 20 69 6e 70 20 6d 61 78 73 69 7a 65 20 ist inp maxsize
0f20: 23 21 6b 65 79 20 28 64 65 62 75 67 2d 70 6f 72 #!key (debug-por
0f30: 74 20 23 66 29 29 0a 20 20 3b 3b 20 72 65 61 64 t #f)). ;; read
0f40: 20 31 4d 65 67 20 63 68 75 6e 6b 73 20 66 72 6f 1Meg chunks fro
0f50: 6d 20 74 68 65 20 69 6e 70 75 74 20 70 6f 72 74 m the input port
0f60: 2e 20 49 66 20 61 20 62 6c 6f 63 6b 20 69 73 20 . If a block is
0f70: 6e 6f 74 20 63 6f 6d 70 6c 65 74 65 0a 20 20 3b not complete. ;
0f80: 3b 20 74 61 63 6b 20 6f 6e 20 74 68 65 20 6e 65 ; tack on the ne
0f90: 78 74 20 31 4d 65 67 20 63 68 75 6e 6b 20 61 73 xt 1Meg chunk as
0fa0: 20 6e 65 65 64 65 64 2e 20 53 65 74 20 75 70 20 needed. Set up
0fb0: 73 6f 20 74 68 65 20 68 65 61 64 65 72 20 69 73 so the header is
0fc0: 20 61 6c 77 61 79 73 0a 20 20 3b 3b 20 61 74 20 always. ;; at
0fd0: 74 68 65 20 62 65 67 69 6e 6e 69 6e 67 20 6f 66 the beginning of
0fe0: 20 74 68 65 20 63 68 75 6e 6b 0a 20 20 3b 3b 2d the chunk. ;;-
0ff0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1000: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 32 39 39 33 ------------2993
1010: 32 30 32 34 34 31 31 35 30 32 33 32 33 33 33 32 2024411502323332
1020: 31 33 36 32 31 34 39 37 33 0a 20 20 3b 3b 43 6f 136214973. ;;Co
1030: 6e 74 65 6e 74 2d 44 69 73 70 6f 73 69 74 69 6f ntent-Dispositio
1040: 6e 3a 20 66 6f 72 6d 2d 64 61 74 61 3b 20 6e 61 n: form-data; na
1050: 6d 65 3d 22 69 6e 70 75 74 2d 70 69 63 74 75 72 me="input-pictur
1060: 65 22 3b 20 66 69 6c 65 6e 61 6d 65 3d 22 62 72 e"; filename="br
1070: 65 61 64 66 72 75 69 74 2e 6a 70 67 22 0a 20 20 eadfruit.jpg".
1080: 3b 3b 43 6f 6e 74 65 6e 74 2d 54 79 70 65 3a 20 ;;Content-Type:
1090: 69 6d 61 67 65 2f 6a 70 65 67 0a 20 20 28 6c 65 image/jpeg. (le
10a0: 74 20 6c 6f 6f 70 20 28 28 64 61 74 20 28 72 65 t loop ((dat (re
10b0: 61 64 2d 73 74 72 69 6e 67 20 31 30 30 30 30 30 ad-string 100000
10c0: 30 20 69 6e 70 29 29 0a 09 20 20 20 20 20 28 72 0 inp)).. (r
10d0: 65 73 20 27 28 29 29 0a 09 20 20 20 20 20 28 73 es '()).. (s
10e0: 69 7a 20 30 29 29 0a 20 20 20 20 28 69 66 20 64 iz 0)). (if d
10f0: 65 62 75 67 2d 70 6f 72 74 20 28 66 6f 72 6d 61 ebug-port (forma
1100: 74 20 64 65 62 75 67 2d 70 6f 72 74 20 22 64 61 t debug-port "da
1110: 74 3a 20 7e 41 5c 6e 22 20 64 61 74 29 29 0a 20 t: ~A\n" dat)).
1120: 20 20 20 28 69 66 20 64 65 62 75 67 2d 70 6f 72 (if debug-por
1130: 74 20 28 66 6f 72 6d 61 74 20 64 65 62 75 67 2d t (format debug-
1140: 70 6f 72 74 20 22 65 6f 66 3a 20 7e 41 5c 6e 22 port "eof: ~A\n"
1150: 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 28 72 (eof-object? (r
1160: 65 61 64 20 69 6e 70 29 29 29 29 0a 20 20 20 20 ead inp)))).
1170: 0a 20 20 20 20 28 69 66 20 28 3e 20 73 69 7a 20 . (if (> siz
1180: 6d 61 78 73 69 7a 65 29 0a 09 28 62 65 67 69 6e maxsize)..(begin
1190: 0a 09 20 20 28 70 72 69 6e 74 20 22 44 41 54 41 .. (print "DATA
11a0: 20 54 4f 4f 20 42 49 47 22 29 0a 09 20 20 72 65 TOO BIG").. re
11b0: 73 29 0a 09 28 6c 65 74 2a 20 28 28 64 61 74 73 s)..(let* ((dats
11c0: 74 72 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 tr (open-input-s
11d0: 74 72 69 6e 67 20 64 61 74 29 29 0a 09 20 20 20 tring dat))..
11e0: 20 20 20 20 28 68 65 61 64 65 72 20 28 66 6f 72 (header (for
11f0: 6d 64 61 74 3a 72 65 61 64 2d 68 65 61 64 65 72 mdat:read-header
1200: 20 64 61 74 73 74 72 29 29 0a 09 20 20 20 20 20 datstr))..
1210: 20 20 28 6b 65 79 20 20 20 20 28 69 66 20 28 6e (key (if (n
1220: 6f 74 20 28 6e 75 6c 6c 3f 20 68 65 61 64 65 72 ot (null? header
1230: 29 29 28 63 61 72 20 68 65 61 64 65 72 29 20 23 ))(car header) #
1240: 66 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 6d f)).. (rem
1250: 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 6e 67 dat (read-string
1260: 20 23 66 20 64 61 74 73 74 72 29 29 20 20 20 20 #f datstr))
1270: 20 20 20 20 20 20 3b 3b 20 75 73 65 64 20 69 6e ;; used in
1280: 20 6e 65 78 74 20 6c 69 6e 65 2c 20 64 69 73 63 next line, disc
1290: 61 72 64 20 69 66 20 67 6f 74 20 64 61 74 61 2c ard if got data,
12a0: 20 65 6c 73 65 20 72 65 76 65 72 74 20 74 6f 0a else revert to.
12b0: 09 20 20 20 20 20 20 20 28 61 6c 6c 64 61 74 20 . (alldat
12c0: 28 69 66 20 6b 65 79 20 28 66 6f 72 6d 64 61 74 (if key (formdat
12d0: 3a 72 65 61 64 2d 64 61 74 20 72 65 6d 64 61 74 :read-dat remdat
12e0: 20 6b 65 79 29 20 23 66 29 29 20 20 20 20 3b 3b key) #f)) ;;
12f0: 20 74 72 79 20 74 6f 20 65 78 74 72 61 63 74 20 try to extract
1300: 74 68 65 20 64 61 74 61 0a 09 20 20 20 20 20 20 the data..
1310: 20 28 74 68 73 64 61 74 20 28 69 66 20 61 6c 6c (thsdat (if all
1320: 64 61 74 20 28 63 61 72 20 61 6c 6c 64 61 74 29 dat (car alldat)
1330: 20 20 23 66 29 29 20 20 20 20 20 3b 3b 20 74 68 #f)) ;; th
1340: 65 20 64 61 74 61 0a 09 20 20 20 20 20 20 20 28 e data.. (
1350: 6e 65 77 64 61 74 20 28 69 66 20 61 6c 6c 64 61 newdat (if allda
1360: 74 20 28 63 61 64 72 20 61 6c 6c 64 61 74 29 20 t (cadr alldat)
1370: 23 66 29 29 20 20 20 20 20 3b 3b 20 6c 65 66 74 #f)) ;; left
1380: 20 6f 76 65 72 20 64 61 74 61 2c 20 6d 75 73 74 over data, must
1390: 20 70 72 6f 63 65 73 73 20 2e 2e 2e 0a 09 20 20 process .....
13a0: 20 20 20 20 20 28 74 68 73 72 65 73 20 28 6c 69 (thsres (li
13b0: 73 74 20 68 65 61 64 65 72 20 74 68 73 64 61 74 st header thsdat
13c0: 29 29 20 20 20 20 20 20 20 20 20 20 20 20 20 3b )) ;
13d0: 3b 20 73 70 65 63 75 6c 61 74 69 76 65 6c 79 20 ; speculatively
13e0: 63 6f 6e 73 74 72 75 63 74 20 72 65 73 75 6c 74 construct result
13f0: 73 0a 09 20 20 20 20 20 20 20 28 6e 65 77 72 65 s.. (newre
1400: 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c s (append res (l
1410: 69 73 74 20 74 68 73 72 65 73 29 29 29 29 20 20 ist thsres))))
1420: 20 20 20 20 3b 3b 20 73 70 65 63 75 6c 61 74 69 ;; speculati
1430: 76 65 6c 79 20 63 6f 6e 73 74 72 75 63 74 20 72 vely construct r
1440: 65 73 75 6c 74 73 0a 09 20 20 28 63 6c 6f 73 65 esults.. (close
1450: 2d 69 6e 70 75 74 2d 70 6f 72 74 20 64 61 74 73 -input-port dats
1460: 74 72 29 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 tr).. (cond..
1470: 20 3b 3b 20 65 69 74 68 65 72 20 6e 6f 20 68 65 ;; either no he
1480: 61 64 65 72 20 6f 72 20 73 69 6e 67 6c 65 20 69 ader or single i
1490: 6e 70 75 74 0a 09 20 20 20 28 28 61 6e 64 20 28 nput.. ((and (
14a0: 6e 6f 74 20 61 6c 6c 64 61 74 29 0a 09 09 20 28 not alldat)... (
14b0: 6f 72 20 28 6e 75 6c 6c 3f 20 68 65 61 64 65 72 or (null? header
14c0: 29 0a 09 09 20 20 20 20 20 28 6e 6f 74 20 28 73 )... (not (s
14d0: 74 72 69 6e 67 2d 6d 61 74 63 68 20 66 6f 72 6d tring-match form
14e0: 64 61 74 3a 64 65 6c 69 6d 2d 70 61 74 74 2d 72 dat:delim-patt-r
14f0: 65 78 20 28 63 61 72 20 68 65 61 64 65 72 29 29 ex (car header))
1500: 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 ))).. ;; (pri
1510: 6e 74 20 22 47 6f 74 20 68 65 72 65 22 29 0a 09 nt "Got here")..
1520: 20 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 (cons (list
1530: 68 65 61 64 65 72 20 22 22 29 20 72 65 73 29 29 header "") res))
1540: 20 3b 3b 20 6e 6f 74 65 20 75 73 65 20 68 65 61 ;; note use hea
1550: 64 65 72 20 61 73 20 64 61 74 20 61 6e 64 20 75 der as dat and u
1560: 73 65 20 22 22 20 61 73 20 68 65 61 64 65 72 3f se "" as header?
1570: 3f 3f 3f 0a 09 20 20 20 3b 3b 20 64 69 64 6e 27 ???.. ;; didn'
1580: 74 20 66 69 6e 64 20 65 6e 64 20 6b 65 79 20 69 t find end key i
1590: 6e 20 74 68 69 73 20 62 6c 6f 63 6b 0a 09 20 20 n this block..
15a0: 20 28 28 6e 6f 74 20 61 6c 6c 64 61 74 29 0a 09 ((not alldat)..
15b0: 20 20 20 20 28 6c 65 74 20 28 28 6d 6f 72 64 61 (let ((morda
15c0: 74 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 t (read-string 1
15d0: 30 30 30 30 30 30 20 69 6e 70 29 29 29 0a 09 20 000000 inp)))..
15e0: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
15f0: 3d 3f 20 6d 6f 72 64 61 74 20 22 22 29 20 3b 3b =? mordat "") ;;
1600: 20 74 68 65 72 65 20 69 73 20 6e 6f 20 6d 6f 72 there is no mor
1610: 65 20 64 61 74 61 2c 20 64 69 73 63 61 72 64 20 e data, discard
1620: 72 65 73 75 6c 74 73 20 61 6e 64 20 75 73 65 20 results and use
1630: 72 65 6d 64 61 74 20 61 73 20 64 61 74 61 2c 20 remdat as data,
1640: 74 68 69 73 20 69 6e 70 75 74 20 69 73 20 62 72 this input is br
1650: 6f 6b 65 6e 0a 09 09 20 20 28 63 6f 6e 73 20 28 oken... (cons (
1660: 6c 69 73 74 20 68 65 61 64 65 72 20 72 65 6d 64 list header remd
1670: 61 74 29 20 72 65 73 29 0a 09 09 20 20 28 6c 6f at) res)... (lo
1680: 6f 70 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e op (string-appen
1690: 64 20 64 61 74 20 6d 6f 72 64 61 74 29 20 72 65 d dat mordat) re
16a0: 73 20 28 2b 20 73 69 7a 20 32 30 30 30 30 30 30 s (+ siz 2000000
16b0: 29 29 29 29 29 20 3b 3b 20 61 64 64 20 74 68 65 ))))) ;; add the
16c0: 20 65 78 74 72 61 20 31 30 30 30 30 30 30 0a 09 extra 1000000..
16d0: 20 20 20 28 61 6c 6c 64 61 74 20 3b 3b 20 67 6f (alldat ;; go
16e0: 74 20 64 61 74 61 2c 20 64 6f 6e 27 74 20 61 74 t data, don't at
16f0: 74 65 6d 70 74 20 74 6f 20 63 68 65 63 6b 20 69 tempt to check i
1700: 66 20 74 68 65 72 65 20 69 73 20 6d 6f 72 65 2c f there is more,
1710: 20 6a 75 73 74 20 6c 6f 6f 70 20 61 6e 64 20 72 just loop and r
1720: 65 6c 79 20 6f 6e 20 28 6e 6f 74 20 61 6c 6c 64 ely on (not alld
1730: 61 74 29 20 74 6f 20 67 65 74 20 6d 6f 72 65 20 at) to get more
1740: 64 61 74 61 0a 09 20 20 20 20 28 6c 6f 6f 70 20 data.. (loop
1750: 6e 65 77 64 61 74 20 6e 65 77 72 65 73 20 28 2b newdat newres (+
1760: 20 73 69 7a 20 31 30 30 30 30 30 30 29 29 29 29 siz 1000000))))
1770: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 66 6f ))))..(define fo
1780: 72 6d 64 61 74 3a 62 69 6e 2d 64 61 74 61 2d 64 rmdat:bin-data-d
1790: 69 73 70 2d 72 65 78 20 28 72 65 67 65 78 70 20 isp-rex (regexp
17a0: 22 5e 43 6f 6e 74 65 6e 74 2d 44 69 73 70 6f 73 "^Content-Dispos
17b0: 69 74 69 6f 6e 3a 5c 5c 73 2b 66 6f 72 6d 2d 64 ition:\\s+form-d
17c0: 61 74 61 3b 22 29 29 0a 28 64 65 66 69 6e 65 20 ata;")).(define
17d0: 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 61 74 61 formdat:bin-data
17e0: 2d 6e 61 6d 65 2d 72 65 78 20 28 72 65 67 65 78 -name-rex (regex
17f0: 70 20 22 5c 5c 57 6e 61 6d 65 3d 5c 22 28 5b 5e p "\\Wname=\"([^
1800: 5c 22 5d 2b 29 5c 22 22 29 29 0a 28 64 65 66 69 \"]+)\"")).(defi
1810: 6e 65 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 66 ne formdat:bin-f
1820: 69 6c 65 2d 6e 61 6d 65 2d 72 65 78 20 28 72 65 ile-name-rex (re
1830: 67 65 78 70 20 22 5c 5c 57 66 69 6c 65 6e 61 6d gexp "\\Wfilenam
1840: 65 3d 5c 22 28 5b 5e 5c 22 5d 2b 29 5c 22 22 29 e=\"([^\"]+)\"")
1850: 29 0a 28 64 65 66 69 6e 65 20 66 6f 72 6d 64 61 ).(define formda
1860: 74 3a 62 69 6e 2d 66 69 6c 65 2d 74 79 70 65 2d t:bin-file-type-
1870: 72 65 78 20 28 72 65 67 65 78 70 20 22 43 6f 6e rex (regexp "Con
1880: 74 65 6e 74 2d 54 79 70 65 3a 5c 5c 73 2b 28 5b tent-Type:\\s+([
1890: 5e 5c 5c 73 5d 2b 29 22 29 29 0a 28 64 65 66 69 ^\\s]+)")).(defi
18a0: 6e 65 20 66 6f 72 6d 64 61 74 3a 64 65 6c 69 6d ne formdat:delim
18b0: 2d 70 61 74 74 2d 72 65 78 20 20 20 20 28 72 65 -patt-rex (re
18c0: 67 65 78 70 20 22 5e 5c 5c 2d 2b 5b 30 2d 39 5d gexp "^\\-+[0-9]
18d0: 2b 5c 5c 2d 2a 24 22 29 29 0a 0a 3b 3b 20 72 65 +\\-*$"))..;; re
18e0: 74 75 72 6e 73 20 61 20 68 61 73 68 20 77 69 74 turns a hash wit
18f0: 68 20 65 6e 74 72 69 65 73 20 66 6f 72 20 61 6c h entries for al
1900: 6c 20 66 6f 72 6d 73 20 2d 20 63 6f 75 6c 64 20 l forms - could
1910: 77 65 6c 6c 20 75 73 65 20 61 20 70 72 6f 70 6c well use a propl
1920: 69 73 74 3f 0a 28 64 65 66 69 6e 65 20 28 66 6f ist?.(define (fo
1930: 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 29 0a rmdat:load-all).
1940: 20 20 28 6c 65 74 20 28 28 72 65 71 75 65 73 74 (let ((request
1950: 2d 6d 65 74 68 6f 64 20 28 67 65 74 2d 65 6e 76 -method (get-env
1960: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
1970: 65 20 22 52 45 51 55 45 53 54 5f 4d 45 54 48 4f e "REQUEST_METHO
1980: 44 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 D"))). (if (a
1990: 6e 64 20 72 65 71 75 65 73 74 2d 6d 65 74 68 6f nd request-metho
19a0: 64 0a 09 20 20 20 20 20 28 73 74 72 69 6e 67 3d d.. (string=
19b0: 3f 20 72 65 71 75 65 73 74 2d 6d 65 74 68 6f 64 ? request-method
19c0: 20 22 50 4f 53 54 22 29 29 0a 09 28 66 6f 72 6d "POST"))..(form
19d0: 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 dat:load-all-por
19e0: 74 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 t (current-input
19f0: 2d 70 6f 72 74 29 29 29 29 29 0a 0a 3b 3b 20 28 -port)))))..;; (
1a00: 73 3a 70 72 6f 63 65 73 73 2d 63 67 69 2d 69 6e s:process-cgi-in
1a10: 70 75 74 20 28 63 61 61 61 72 20 64 61 74 29 29 put (caaar dat))
1a20: 0a 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 .(define (formda
1a30: 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 6f 72 74 20 t:load-all-port
1a40: 69 6e 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 66 inp). (let* ((f
1a50: 6f 72 6d 64 61 74 20 20 20 20 20 20 20 20 28 6d ormdat (m
1a60: 61 6b 65 2d 66 6f 72 6d 64 61 74 3a 66 6f 72 6d ake-formdat:form
1a70: 64 61 74 29 29 0a 09 20 28 64 65 62 75 67 70 20 dat)).. (debugp
1a80: 20 20 20 20 20 20 20 20 23 66 29 29 0a 09 09 09 #f))....
1a90: 20 3b 3b 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 ;; (open-output
1aa0: 2d 66 69 6c 65 20 28 63 6f 6e 63 20 22 2f 74 6d -file (conc "/tm
1ab0: 70 2f 64 65 6c 6d 65 2d 22 20 28 63 75 72 72 65 p/delme-" (curre
1ac0: 6e 74 2d 75 73 65 72 2d 69 64 29 20 22 2e 6c 6f nt-user-id) ".lo
1ad0: 67 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 77 g")))). ;; (w
1ae0: 72 69 74 65 2d 73 74 72 69 6e 67 20 28 72 65 61 rite-string (rea
1af0: 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 29 d-string #f inp)
1b00: 20 23 66 20 64 65 62 75 67 70 29 20 20 3b 3b 20 #f debugp) ;;
1b10: 64 65 73 74 72 6f 79 73 20 61 6c 6c 20 64 61 74 destroys all dat
1b20: 61 21 0a 20 20 20 20 28 66 6f 72 6d 64 61 74 3a a!. (formdat:
1b30: 69 6e 69 74 69 61 6c 69 7a 65 20 66 6f 72 6d 64 initialize formd
1b40: 61 74 29 0a 20 20 20 20 28 6c 65 74 20 28 28 61 at). (let ((a
1b50: 6c 6c 64 61 74 73 20 28 66 6f 72 6d 64 61 74 3a lldats (formdat:
1b60: 64 61 74 2d 3e 6c 69 73 74 20 69 6e 70 20 31 30 dat->list inp 10
1b70: 65 36 20 64 65 62 75 67 2d 70 6f 72 74 3a 20 64 e6 debug-port: d
1b80: 65 62 75 67 70 29 29 29 0a 20 20 20 20 20 20 0a ebugp))). .
1b90: 20 20 20 20 20 20 28 69 66 20 64 65 62 75 67 70 (if debugp
1ba0: 20 28 66 6f 72 6d 61 74 20 64 65 62 75 67 70 20 (format debugp
1bb0: 22 66 6f 72 6d 64 61 74 20 3a 20 61 6c 6c 64 61 "formdat : allda
1bc0: 74 73 3a 20 7e 41 5c 6e 22 20 61 6c 6c 64 61 74 ts: ~A\n" alldat
1bd0: 73 29 29 0a 0a 20 20 20 20 20 20 28 6c 65 74 20 s)).. (let
1be0: 28 28 66 69 72 73 74 69 74 65 6d 20 20 20 28 63 ((firstitem (c
1bf0: 61 72 20 61 6c 6c 64 61 74 73 29 29 0a 09 20 20 ar alldats))..
1c00: 20 20 28 6d 75 6c 74 69 70 61 73 73 20 23 66 29 (multipass #f)
1c10: 29 20 0a 09 28 69 66 20 28 61 6e 64 20 28 6e 6f ) ..(if (and (no
1c20: 74 20 28 6e 75 6c 6c 3f 20 66 69 72 73 74 69 74 t (null? firstit
1c30: 65 6d 29 29 0a 09 09 20 28 6e 6f 74 20 28 6e 75 em))... (not (nu
1c40: 6c 6c 3f 20 28 63 61 72 20 66 69 72 73 74 69 74 ll? (car firstit
1c50: 65 6d 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 em)))).. (if
1c60: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 66 6f (string-match fo
1c70: 72 6d 64 61 74 3a 64 65 6c 69 6d 2d 70 61 74 74 rmdat:delim-patt
1c80: 2d 72 65 78 20 28 63 61 61 72 20 66 69 72 73 74 -rex (caar first
1c90: 69 74 65 6d 29 29 0a 09 09 28 73 65 74 21 20 6d item))...(set! m
1ca0: 75 6c 74 69 70 61 73 73 20 23 74 29 29 29 0a 09 ultipass #t)))..
1cb0: 28 69 66 20 6d 75 6c 74 69 70 61 73 73 0a 09 20 (if multipass..
1cc0: 20 20 20 3b 3b 20 68 61 6e 64 6c 65 20 6d 75 6c ;; handle mul
1cd0: 74 69 2d 70 61 72 74 20 66 6f 72 6d 0a 09 20 20 ti-part form..
1ce0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
1cf0: 62 64 61 20 28 64 61 74 6c 73 74 29 0a 09 09 09 bda (datlst)....
1d00: 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 20 28 (let* ((header (
1d10: 66 6f 72 6d 64 61 74 3a 65 78 74 72 61 63 74 2d formdat:extract-
1d20: 68 65 61 64 65 72 2d 69 6e 66 6f 20 28 63 61 72 header-info (car
1d30: 20 64 61 74 6c 73 74 29 29 29 0a 09 09 09 20 20 datlst)))....
1d40: 20 20 20 20 20 28 6e 61 6d 65 20 20 20 28 69 66 (name (if
1d50: 20 28 61 73 73 6f 63 20 27 6e 61 6d 65 20 68 65 (assoc 'name he
1d60: 61 64 65 72 29 0a 09 09 09 09 09 20 20 20 28 73 ader)...... (s
1d70: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 63 tring->symbol (c
1d80: 61 64 72 20 28 61 73 73 6f 63 20 27 6e 61 6d 65 adr (assoc 'name
1d90: 20 68 65 61 64 65 72 29 29 29 0a 09 09 09 09 09 header)))......
1da0: 20 20 20 22 22 29 29 20 3b 3b 20 67 72 75 6d 62 "")) ;; grumb
1db0: 6c 65 0a 09 09 09 20 20 20 20 20 20 20 28 66 6e le.... (fn
1dc0: 61 6d 65 6c 20 20 28 61 73 73 6f 63 20 27 66 69 amel (assoc 'fi
1dd0: 6c 65 6e 61 6d 65 20 68 65 61 64 65 72 29 29 0a lename header)).
1de0: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 74 65 ... (conte
1df0: 6e 74 20 28 61 73 73 6f 63 20 27 63 6f 6e 74 65 nt (assoc 'conte
1e00: 6e 74 20 68 65 61 64 65 72 29 29 0a 09 09 09 20 nt header))....
1e10: 20 20 20 20 20 20 28 64 61 74 20 20 20 20 28 63 (dat (c
1e20: 61 64 72 20 64 61 74 6c 73 74 29 29 29 0a 09 09 adr datlst)))...
1e30: 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 68 65 . ;; (print "he
1e40: 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 20 22 ader: " header "
1e50: 20 6e 61 6d 65 3a 20 22 20 6e 61 6d 65 20 22 20 name: " name "
1e60: 66 6e 61 6d 65 6c 3a 20 22 20 66 6e 61 6d 65 6c fnamel: " fnamel
1e70: 20 22 20 63 6f 6e 74 65 6e 74 3a 20 22 20 63 6f " content: " co
1e80: 6e 74 65 6e 74 29 20 3b 3b 20 20 22 20 64 61 74 ntent) ;; " dat
1e90: 3a 20 22 20 28 64 61 74 29 0a 09 09 09 20 20 28 : " (dat).... (
1ea0: 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 66 6f 72 formdat:set! for
1eb0: 6d 64 61 74 20 0a 09 09 09 09 09 6e 61 6d 65 0a mdat ......name.
1ec0: 09 09 09 09 09 28 69 66 20 66 6e 61 6d 65 6c 20 .....(if fnamel
1ed0: 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 ...... (list
1ee0: 28 63 61 64 72 20 66 6e 61 6d 65 6c 29 0a 09 09 (cadr fnamel)...
1ef0: 09 09 09 09 20 20 28 69 66 20 63 6f 6e 74 65 6e .... (if conten
1f00: 74 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 63 t....... (c
1f10: 61 64 72 20 63 6f 6e 74 65 6e 74 29 0a 09 09 09 adr content)....
1f20: 09 09 09 20 20 20 20 20 20 22 75 6e 6b 6e 6f 77 ... "unknow
1f30: 6e 22 29 0a 09 09 09 09 09 09 20 20 28 73 74 72 n")....... (str
1f40: 69 6e 67 2d 3e 62 6c 6f 62 20 64 61 74 29 29 0a ing->blob dat)).
1f50: 09 09 09 09 09 20 20 20 20 64 61 74 29 29 29 29 ..... dat))))
1f60: 0a 09 09 20 20 20 20 20 20 61 6c 6c 64 61 74 73 ... alldats
1f70: 29 0a 09 20 20 20 20 3b 3b 20 68 61 6e 64 6c 65 ).. ;; handle
1f80: 20 73 69 6e 67 6c 65 20 70 61 72 74 20 66 6f 72 single part for
1f90: 6d 0a 09 20 20 20 20 3b 3b 20 09 28 69 66 20 28 m.. ;; .(if (
1fa0: 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 6e 61 6d and (string? nam
1fb0: 65 29 0a 09 20 20 20 20 3b 3b 20 09 09 20 20 20 e).. ;; ..
1fc0: 20 20 28 73 74 72 69 6e 67 3d 3f 20 6e 61 6d 65 (string=? name
1fd0: 20 22 22 29 29 20 3b 3b 20 74 68 69 73 20 69 73 "")) ;; this is
1fe0: 20 74 68 65 20 73 68 6f 72 74 20 66 6f 72 6d 20 the short form
1ff0: 69 6e 70 75 74 20 49 20 67 75 65 73 73 0a 09 20 input I guess..
2000: 20 20 20 3b 3b 20 09 09 28 6c 65 74 2a 20 28 28 ;; ..(let* ((
2010: 64 61 74 73 74 72 20 28 63 61 61 72 20 64 61 74 datstr (caar dat
2020: 6c 73 74 29 29 0a 09 20 20 20 20 3b 3b 20 09 09 lst)).. ;; ..
2030: 20 20 20 20 20 20 20 28 6d 75 6e 67 65 64 20 28 (munged (
2040: 73 3a 70 72 6f 63 65 73 73 2d 63 67 69 2d 69 6e s:process-cgi-in
2050: 70 75 74 20 64 61 74 73 74 72 29 29 29 0a 09 20 put datstr)))..
2060: 20 20 20 3b 3b 20 09 09 20 20 28 70 72 69 6e 74 ;; .. (print
2070: 20 22 64 61 74 73 74 72 3a 20 22 20 64 61 74 73 "datstr: " dats
2080: 74 72 20 22 20 6d 75 6e 67 65 64 3a 20 22 20 6d tr " munged: " m
2090: 75 6e 67 65 64 29 0a 09 20 20 20 20 28 69 66 20 unged).. (if
20a0: 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (and (not (null?
20b0: 20 61 6c 6c 64 61 74 73 29 29 0a 09 09 20 20 20 alldats))...
20c0: 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 63 (not (null? (c
20d0: 61 72 20 61 6c 6c 64 61 74 73 29 29 29 0a 09 09 ar alldats)))...
20e0: 20 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (not (null?
20f0: 20 28 63 61 61 72 20 61 6c 6c 64 61 74 73 29 29 (caar alldats))
2100: 29 29 0a 09 09 28 66 6f 72 6d 64 61 74 3a 6c 6f ))...(formdat:lo
2110: 61 64 20 66 6f 72 6d 64 61 74 20 20 28 73 3a 70 ad formdat (s:p
2120: 72 6f 63 65 73 73 2d 63 67 69 2d 69 6e 70 75 74 rocess-cgi-input
2130: 20 28 63 61 61 61 72 20 61 6c 6c 64 61 74 73 29 (caaar alldats)
2140: 29 29 29 29 20 3b 3b 20 6d 75 6e 67 65 64 29 29 )))) ;; munged))
2150: 0a 09 3b 3b 09 09 20 20 20 20 28 66 6f 72 6d 61 ..;;.. (forma
2160: 74 20 64 65 62 75 67 70 20 22 66 6f 72 6d 64 61 t debugp "formda
2170: 74 20 3a 20 6e 61 6d 65 3a 20 7e 41 20 63 6f 6e t : name: ~A con
2180: 74 65 6e 74 3a 20 7e 41 5c 6e 22 20 6e 61 6d 65 tent: ~A\n" name
2190: 20 63 6f 6e 74 65 6e 74 29 0a 09 28 69 66 20 64 content)..(if d
21a0: 65 62 75 67 70 20 28 63 6c 6f 73 65 2d 6f 75 74 ebugp (close-out
21b0: 70 75 74 2d 70 6f 72 74 20 64 65 62 75 67 70 29 put-port debugp)
21c0: 29 0a 09 66 6f 72 6d 64 61 74 29 29 29 29 0a 09 )..formdat))))..
21d0: 09 0a 23 7c 0a 28 64 65 66 69 6e 65 20 69 6e 70 ..#|.(define inp
21e0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c (open-input-fil
21f0: 65 20 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 e "tests/example
2200: 2e 70 6f 73 74 2e 69 6e 22 29 29 0a 28 64 65 66 .post.in")).(def
2210: 69 6e 65 20 64 61 74 20 28 72 65 61 64 2d 73 74 ine dat (read-st
2220: 72 69 6e 67 20 23 66 20 69 6e 70 29 29 0a 28 64 ring #f inp)).(d
2230: 65 66 69 6e 65 20 64 61 74 73 74 72 20 28 6f 70 efine datstr (op
2240: 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 en-input-string
2250: 64 61 74 29 29 0a 0a 3b 3b 20 6f 72 0a 0a 28 64 dat))..;; or..(d
2260: 65 66 69 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d efine inp (open-
2270: 69 6e 70 75 74 2d 66 69 6c 65 20 22 74 65 73 74 input-file "test
2280: 73 2f 65 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 62 s/example.post.b
2290: 69 6e 61 72 79 2e 69 6e 22 29 29 0a 28 64 65 66 inary.in")).(def
22a0: 69 6e 65 20 64 61 74 20 28 72 65 61 64 2d 73 74 ine dat (read-st
22b0: 72 69 6e 67 20 23 66 20 69 6e 70 29 29 0a 28 64 ring #f inp)).(d
22c0: 65 66 69 6e 65 20 64 61 74 73 74 72 20 28 6f 70 efine datstr (op
22d0: 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 en-input-string
22e0: 64 61 74 29 29 0a 0a 28 66 6f 72 6d 64 61 74 3a dat))..(formdat:
22f0: 72 65 61 64 2d 68 65 61 64 65 72 20 64 61 74 73 read-header dats
2300: 74 72 29 0a 0a 28 64 65 66 69 6e 65 20 64 61 74 tr)..(define dat
2310: 20 28 66 6f 72 6d 64 61 74 3a 64 61 74 2d 3e 6c (formdat:dat->l
2320: 69 73 74 20 69 6e 70 20 31 30 65 36 29 29 0a 28 ist inp 10e6)).(
2330: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
2340: 20 69 6e 70 29 0a 7c 23 0a 20 20 0a 28 64 65 66 inp).|#. .(def
2350: 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a 65 78 74 ine (formdat:ext
2360: 72 61 63 74 2d 68 65 61 64 65 72 2d 69 6e 66 6f ract-header-info
2370: 20 68 65 61 64 65 72 29 0a 20 20 28 69 66 20 28 header). (if (
2380: 6e 75 6c 6c 3f 20 68 65 61 64 65 72 29 0a 20 20 null? header).
2390: 20 20 20 20 27 28 29 0a 20 20 20 20 20 20 28 6c '(). (l
23a0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
23b0: 61 72 20 68 65 61 64 65 72 29 29 0a 09 09 20 28 ar header))... (
23c0: 74 61 6c 20 28 63 64 72 20 68 65 61 64 65 72 29 tal (cdr header)
23d0: 29 0a 09 09 20 28 72 65 73 20 27 28 29 29 29 0a )... (res '())).
23e0: 09 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 .(if (string-mat
23f0: 63 68 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 ch formdat:bin-d
2400: 61 74 61 2d 64 69 73 70 2d 72 65 78 20 68 65 64 ata-disp-rex hed
2410: 29 20 3b 3b 20 0a 09 20 20 20 20 28 6c 65 74 2a ) ;; .. (let*
2420: 20 28 28 64 61 74 61 2d 6e 61 6d 65 6d 20 28 73 ((data-namem (s
2430: 74 72 69 6e 67 2d 6d 61 74 63 68 20 66 6f 72 6d tring-match form
2440: 64 61 74 3a 62 69 6e 2d 64 61 74 61 2d 6e 61 6d dat:bin-data-nam
2450: 65 2d 72 65 78 20 68 65 64 29 29 0a 09 09 20 20 e-rex hed))...
2460: 20 28 66 69 6c 65 2d 6e 61 6d 65 6d 20 28 73 74 (file-namem (st
2470: 72 69 6e 67 2d 6d 61 74 63 68 20 66 6f 72 6d 64 ring-match formd
2480: 61 74 3a 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 at:bin-file-name
2490: 2d 72 65 78 20 68 65 64 29 29 0a 09 09 20 20 20 -rex hed))...
24a0: 28 64 61 74 61 2d 6e 61 6d 65 20 20 28 69 66 20 (data-name (if
24b0: 64 61 74 61 2d 6e 61 6d 65 6d 20 28 63 61 64 72 data-namem (cadr
24c0: 20 64 61 74 61 2d 6e 61 6d 65 6d 29 20 23 66 29 data-namem) #f)
24d0: 29 0a 09 09 20 20 20 28 74 68 69 73 20 20 20 20 )... (this
24e0: 20 20 20 28 69 66 20 66 69 6c 65 2d 6e 61 6d 65 (if file-name
24f0: 6d 0a 09 09 09 09 20 20 20 28 6c 69 73 74 20 28 m..... (list (
2500: 6c 69 73 74 20 27 6e 61 6d 65 20 64 61 74 61 2d list 'name data-
2510: 6e 61 6d 65 29 28 6c 69 73 74 20 27 66 69 6c 65 name)(list 'file
2520: 6e 61 6d 65 20 28 63 61 64 72 20 66 69 6c 65 2d name (cadr file-
2530: 6e 61 6d 65 6d 29 29 29 0a 09 09 09 09 20 20 20 namem))).....
2540: 28 6c 69 73 74 20 28 6c 69 73 74 20 27 6e 61 6d (list (list 'nam
2550: 65 20 64 61 74 61 2d 6e 61 6d 65 29 29 29 29 29 e data-name)))))
2560: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c .. (if (nul
2570: 6c 3f 20 74 61 6c 29 0a 09 09 20 20 28 61 70 70 l? tal)... (app
2580: 65 6e 64 20 72 65 73 20 74 68 69 73 29 0a 09 09 end res this)...
2590: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
25a0: 29 28 63 64 72 20 74 61 6c 29 28 61 70 70 65 6e )(cdr tal)(appen
25b0: 64 20 72 65 73 20 74 68 69 73 29 29 29 29 0a 09 d res this))))..
25c0: 20 20 20 20 28 6c 65 74 20 28 28 63 6f 6e 74 65 (let ((conte
25d0: 6e 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 nt (string-match
25e0: 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 66 69 6c formdat:bin-fil
25f0: 65 2d 74 79 70 65 2d 72 65 78 20 68 65 64 29 29 e-type-rex hed))
2600: 29 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 ) ;; this is the
2610: 20 73 74 61 6e 7a 61 20 66 6f 72 20 74 68 65 20 stanza for the
2620: 63 6f 6e 74 65 6e 74 20 74 79 70 65 0a 09 20 20 content type..
2630: 20 20 20 20 28 69 66 20 63 6f 6e 74 65 6e 74 0a (if content.
2640: 09 09 20 20 28 6c 65 74 20 28 28 6e 65 77 72 65 .. (let ((newre
2650: 73 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 27 63 s (cons (list 'c
2660: 6f 6e 74 65 6e 74 20 28 63 61 64 72 20 63 6f 6e ontent (cadr con
2670: 74 65 6e 74 29 29 20 72 65 73 29 29 29 0a 09 09 tent)) res)))...
2680: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
2690: 61 6c 29 0a 09 09 09 6e 65 77 72 65 73 0a 09 09 al)....newres...
26a0: 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 .(loop (car tal)
26b0: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 (cdr tal) newres
26c0: 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 6c )))... (if (nul
26d0: 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 20 20 20 l? tal)...
26e0: 72 65 73 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f res... (loo
26f0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
2700: 74 61 6c 29 20 72 65 73 29 0a 09 09 20 20 20 20 tal) res)...
2710: 20 20 29 29 29 29 29 29 29 0a 0a 3b 3b 09 20 20 )))))))..;;.
2720: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
2730: 6c 20 20 20 20 20 20 20 28 72 65 61 64 2d 6c 69 l (read-li
2740: 6e 65 29 29 20 3b 3b 20 28 69 66 20 28 65 71 3f ne)) ;; (if (eq?
2750: 20 6d 6f 64 65 20 27 6e 6f 72 6d 29 28 72 65 61 mode 'norm)(rea
2760: 64 2d 6c 69 6e 65 29 28 72 65 61 64 2d 63 68 61 d-line)(read-cha
2770: 72 29 29 29 0a 3b 3b 09 09 09 20 28 65 6e 64 6c r))).;;... (endl
2780: 69 6e 65 20 23 66 29 0a 3b 3b 09 09 09 20 28 6e ine #f).;;... (n
2790: 75 6d 20 20 20 20 20 30 29 29 0a 3b 3b 09 09 3b um 0)).;;..;
27a0: 3b 20 28 66 6f 72 6d 61 74 20 64 65 62 75 67 70 ; (format debugp
27b0: 20 22 7e 41 5c 6e 22 20 6c 29 0a 3b 3b 20 20 20 "~A\n" l).;;
27c0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
27d0: 6f 72 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a or (not (eof-obj
27e0: 65 63 74 3f 20 6c 29 29 0a 3b 3b 09 09 20 20 20 ect? l)).;;..
27f0: 20 20 20 28 6e 6f 74 20 28 61 6e 64 20 28 65 71 (not (and (eq
2800: 3f 20 6d 6f 64 65 20 27 62 69 6e 29 0a 3b 3b 09 ? mode 'bin).;;.
2810: 09 09 09 28 73 74 72 69 6e 67 3d 3f 20 6c 20 22 ...(string=? l "
2820: 22 29 29 29 29 20 3b 3b 20 69 66 20 69 6e 20 62 ")))) ;; if in b
2830: 69 6e 20 6d 6f 64 65 20 65 6d 70 74 79 20 73 74 in mode empty st
2840: 72 69 6e 67 20 69 73 20 65 6e 64 20 6f 66 20 66 ring is end of f
2850: 69 6c 65 0a 3b 3b 09 09 20 20 28 63 61 73 65 20 ile.;;.. (case
2860: 6d 6f 64 65 0a 3b 3b 09 09 20 20 20 20 28 28 73 mode.;;.. ((s
2870: 74 61 72 74 29 0a 3b 3b 09 09 20 20 20 20 20 28 tart).;;.. (
2880: 73 65 74 21 20 6d 6f 64 65 20 27 6e 6f 72 6d 29 set! mode 'norm)
2890: 0a 3b 3b 09 09 20 20 20 20 20 28 69 66 20 28 73 .;;.. (if (s
28a0: 74 72 69 6e 67 2d 6d 61 74 63 68 20 64 65 6c 69 tring-match deli
28b0: 6d 2d 70 61 74 74 2d 72 65 78 20 6c 29 0a 3b 3b m-patt-rex l).;;
28c0: 09 09 09 20 28 62 65 67 69 6e 0a 3b 3b 09 09 09 ... (begin.;;...
28d0: 20 20 20 28 73 65 74 21 20 64 65 6c 69 6d 2d 73 (set! delim-s
28e0: 74 72 69 6e 67 20 6c 29 0a 3b 3b 09 09 09 20 20 tring l).;;...
28f0: 20 28 73 65 74 21 20 64 65 6c 69 6d 2d 6c 65 6e (set! delim-len
2900: 20 20 20 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 (string-leng
2910: 74 68 20 6c 29 29 0a 3b 3b 09 09 09 20 20 20 28 th l)).;;... (
2920: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 loop (read-line)
2930: 20 23 66 20 30 29 29 0a 3b 3b 09 09 09 20 28 6c #f 0)).;;... (l
2940: 6f 6f 70 20 6c 20 23 66 20 30 29 29 29 0a 3b 3b oop l #f 0))).;;
2950: 09 09 20 20 20 20 28 28 6e 6f 72 6d 29 0a 3b 3b .. ((norm).;;
2960: 09 09 20 20 20 20 20 3b 3b 20 49 20 64 6f 6e 27 .. ;; I don'
2970: 74 20 6c 69 6b 65 20 68 6f 77 20 74 68 69 73 20 t like how this
2980: 67 65 74 73 20 63 68 65 63 6b 65 64 20 6f 6e 20 gets checked on
2990: 65 76 65 72 79 20 73 69 6e 67 6c 65 20 69 6e 70 every single inp
29a0: 75 74 2e 20 4d 75 73 74 20 62 65 20 61 20 62 65 ut. Must be a be
29b0: 74 74 65 72 20 77 61 79 2e 20 46 49 58 4d 45 0a tter way. FIXME.
29c0: 3b 3b 09 09 20 20 20 20 20 28 69 66 20 28 61 6e ;;.. (if (an
29d0: 64 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 d (string-match
29e0: 62 69 6e 2d 64 61 74 61 2d 64 69 73 70 2d 72 65 bin-data-disp-re
29f0: 78 20 6c 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 x l).;;...
2a00: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 (string-match bi
2a10: 6e 2d 64 61 74 61 2d 6e 61 6d 65 2d 72 65 78 20 n-data-name-rex
2a20: 6c 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 28 73 l).;;... (s
2a30: 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d tring-match bin-
2a40: 66 69 6c 65 2d 6e 61 6d 65 2d 72 65 78 20 6c 29 file-name-rex l)
2a50: 29 0a 3b 3b 09 09 09 20 28 62 65 67 69 6e 0a 3b ).;;... (begin.;
2a60: 3b 09 09 09 20 20 20 28 73 65 74 21 20 64 61 74 ;... (set! dat
2a70: 61 2d 6e 61 6d 65 20 28 63 61 64 72 20 28 73 74 a-name (cadr (st
2a80: 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d 64 ring-match bin-d
2a90: 61 74 61 2d 6e 61 6d 65 2d 72 65 78 20 6c 29 29 ata-name-rex l))
2aa0: 29 0a 3b 3b 09 09 09 20 20 20 28 73 65 74 21 20 ).;;... (set!
2ab0: 66 69 6c 65 2d 6e 61 6d 65 20 28 63 61 64 72 20 file-name (cadr
2ac0: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 (string-match bi
2ad0: 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d 72 65 78 20 n-file-name-rex
2ae0: 6c 29 29 29 0a 3b 3b 09 09 09 20 20 20 28 73 65 l))).;;... (se
2af0: 74 21 20 6d 6f 64 65 20 27 63 6f 6e 74 65 6e 74 t! mode 'content
2b00: 29 0a 3b 3b 09 09 09 20 20 20 28 6c 6f 6f 70 20 ).;;... (loop
2b10: 28 72 65 61 64 2d 6c 69 6e 65 29 20 23 66 20 6e (read-line) #f n
2b20: 75 6d 29 29 29 0a 3b 3b 09 09 20 20 20 20 20 28 um))).;;.. (
2b30: 6c 65 74 2a 20 28 28 64 61 74 20 20 28 73 3a 70 let* ((dat (s:p
2b40: 72 6f 63 65 73 73 2d 63 67 69 2d 69 6e 70 75 74 rocess-cgi-input
2b50: 20 6c 29 29 29 20 3b 3b 20 28 43 47 49 3a 75 72 l))) ;; (CGI:ur
2b60: 6c 2d 75 6e 71 75 6f 74 65 20 6c 29 29 0a 3b 3b l-unquote l)).;;
2b70: 09 09 20 20 20 20 20 20 20 28 66 6f 72 6d 61 74 .. (format
2b80: 20 64 65 62 75 67 70 20 22 50 52 4f 43 45 53 53 debugp "PROCESS
2b90: 2d 43 47 49 2d 49 4e 50 55 54 3a 20 7e 41 5c 6e -CGI-INPUT: ~A\n
2ba0: 22 20 28 69 6e 74 65 72 73 70 65 72 73 65 20 64 " (intersperse d
2bb0: 61 74 20 22 2c 22 29 29 0a 3b 3b 09 09 20 20 20 at ",")).;;..
2bc0: 20 20 20 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 (formdat:loa
2bd0: 64 20 66 6f 72 6d 64 61 74 20 64 61 74 29 0a 3b d formdat dat).;
2be0: 3b 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 ;.. (loop
2bf0: 28 72 65 61 64 2d 6c 69 6e 65 29 20 23 66 20 6e (read-line) #f n
2c00: 75 6d 29 29 29 0a 3b 3b 09 09 20 20 20 20 28 28 um))).;;.. ((
2c10: 63 6f 6e 74 65 6e 74 29 0a 3b 3b 09 09 20 20 20 content).;;..
2c20: 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 (if (string-ma
2c30: 74 63 68 20 62 69 6e 2d 66 69 6c 65 2d 74 79 70 tch bin-file-typ
2c40: 65 2d 72 65 78 20 6c 29 0a 3b 3b 09 09 09 20 28 e-rex l).;;... (
2c50: 62 65 67 69 6e 20 0a 3b 3b 09 09 09 20 20 20 28 begin .;;... (
2c60: 73 65 74 21 20 6d 6f 64 65 20 27 62 69 6e 29 0a set! mode 'bin).
2c70: 3b 3b 09 09 09 20 20 20 28 73 65 74 21 20 64 61 ;;... (set! da
2c80: 74 61 2d 74 79 70 65 20 28 63 61 64 72 20 28 73 ta-type (cadr (s
2c90: 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d tring-match bin-
2ca0: 66 69 6c 65 2d 74 79 70 65 2d 72 65 78 20 6c 29 file-type-rex l)
2cb0: 29 29 0a 3b 3b 09 09 09 20 20 20 28 6c 6f 6f 70 )).;;... (loop
2cc0: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 29 (read-string 1)
2cd0: 20 23 66 20 6e 75 6d 29 29 29 29 0a 3b 3b 09 09 #f num)))).;;..
2ce0: 20 20 20 20 28 28 62 69 6e 29 0a 3b 3b 09 09 20 ((bin).;;..
2cf0: 20 20 20 20 3b 3b 20 64 65 6c 69 6d 2d 73 74 72 ;; delim-str
2d00: 69 6e 67 3a 20 5c 6e 22 2d 2d 2d 2d 2d 2d 2d 2d ing: \n"--------
2d10: 2d 2d 2d 2d 2d 2d 2d 31 32 33 34 35 22 0a 3b 3b -------12345".;;
2d20: 09 09 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 .. ;;
2d30: 20 20 20 20 20 20 20 20 20 20 20 30 31 32 33 34 01234
2d40: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 5678901234567890
2d50: 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 65 6e 64 .;;.. ;; end
2d60: 6c 69 6e 65 3a 20 20 20 20 20 20 20 20 22 2d 2d line: "--
2d70: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 31 32 22 -------------12"
2d80: 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 6c 20 3d .;;.. ;; l =
2d90: 20 22 33 22 0a 3b 3b 09 09 20 20 20 20 20 3b 3b "3".;;.. ;;
2da0: 20 64 65 6c 69 6d 2d 6c 65 6e 20 3d 20 32 30 0a delim-len = 20.
2db0: 3b 3b 09 09 20 20 20 20 20 3b 3b 20 28 73 75 62 ;;.. ;; (sub
2dc0: 73 74 72 69 6e 67 20 20 22 2d 2d 2d 2d 2d 2d 2d string "-------
2dd0: 2d 2d 2d 2d 2d 2d 2d 2d 31 32 33 34 35 22 20 31 --------12345" 1
2de0: 37 20 31 38 29 20 3d 3e 20 22 33 22 0a 3b 3b 09 7 18) => "3".;;.
2df0: 09 20 20 20 20 20 3b 3b 0a 3b 3b 09 09 20 20 20 . ;;.;;..
2e00: 20 20 28 63 6f 6e 64 0a 3b 3b 09 09 20 20 20 20 (cond.;;..
2e10: 20 20 20 3b 3b 20 68 61 76 65 6e 27 74 20 66 6f ;; haven't fo
2e20: 75 6e 64 20 74 68 65 20 73 74 61 72 74 20 6f 66 und the start of
2e30: 20 61 6e 20 65 6e 64 6c 69 6e 65 2c 20 69 73 20 an endline, is
2e40: 74 68 65 20 6e 65 78 74 20 63 68 61 72 20 61 20 the next char a
2e50: 6e 65 77 6c 69 6e 65 3f 0a 3b 3b 09 09 20 20 20 newline?.;;..
2e60: 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 65 6e ((and (not en
2e70: 64 6c 69 6e 65 29 0a 3b 3b 09 09 09 20 20 20 20 dline).;;...
2e80: 28 73 74 72 69 6e 67 3d 3f 20 6c 20 22 5c 6e 22 (string=? l "\n"
2e90: 29 29 20 3b 3b 20 72 65 71 75 69 72 65 64 20 66 )) ;; required f
2ea0: 69 72 73 74 20 63 68 61 72 61 63 74 65 72 20 0a irst character .
2eb0: 3b 3b 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 ;;.. (let
2ec0: 28 28 6e 65 77 65 6e 64 6c 69 6e 65 20 28 6f 70 ((newendline (op
2ed0: 65 6e 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 en-output-string
2ee0: 29 29 29 0a 3b 3b 09 09 09 20 3b 3b 20 28 77 72 ))).;;... ;; (wr
2ef0: 69 74 65 2d 6c 69 6e 65 20 6c 20 6e 65 77 65 6e ite-line l newen
2f00: 64 6c 69 6e 65 29 20 3b 3b 20 64 69 73 63 61 72 dline) ;; discar
2f10: 64 20 74 68 65 20 6e 65 77 6c 69 6e 65 2e 20 61 d the newline. a
2f20: 64 64 20 69 74 20 62 61 63 6b 20 69 66 20 64 6f dd it back if do
2f30: 6e 27 74 20 68 61 76 65 20 61 20 6c 6f 63 6b 20 n't have a lock
2f40: 6f 6e 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 0a on delim-string.
2f50: 3b 3b 09 09 09 20 28 6c 6f 6f 70 20 28 72 65 61 ;;... (loop (rea
2f60: 64 2d 73 74 72 69 6e 67 20 31 29 20 6e 65 77 65 d-string 1) newe
2f70: 6e 64 6c 69 6e 65 20 28 2b 20 6e 75 6d 20 31 29 ndline (+ num 1)
2f80: 29 29 29 0a 3b 3b 09 09 20 20 20 20 20 20 28 28 ))).;;.. ((
2f90: 6e 6f 74 20 65 6e 64 6c 69 6e 65 29 0a 3b 3b 09 not endline).;;.
2fa0: 09 20 20 20 20 20 20 20 28 77 72 69 74 65 2d 73 . (write-s
2fb0: 74 72 69 6e 67 20 6c 20 23 66 20 62 69 6e 2d 64 tring l #f bin-d
2fc0: 61 74 29 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 at).;;.. (
2fd0: 6c 6f 6f 70 20 28 72 65 61 64 2d 73 74 72 69 6e loop (read-strin
2fe0: 67 20 31 29 20 23 66 20 28 2b 20 6e 75 6d 20 31 g 1) #f (+ num 1
2ff0: 29 29 29 0a 3b 3b 09 09 20 20 20 20 20 20 3b 3b ))).;;.. ;;
3000: 20 73 74 72 69 6e 67 20 73 6f 20 66 61 72 20 6d string so far m
3010: 61 74 63 68 65 73 20 64 65 6c 69 6d 2d 73 74 72 atches delim-str
3020: 69 6e 67 0a 3b 3b 09 09 20 20 20 20 20 20 28 65 ing.;;.. (e
3030: 6e 64 6c 69 6e 65 0a 3b 3b 09 09 20 20 20 20 20 ndline.;;..
3040: 20 20 28 6c 65 74 2a 20 28 28 65 6e 64 73 74 72 (let* ((endstr
3050: 20 28 67 65 74 2d 6f 75 74 70 75 74 2d 73 74 72 (get-output-str
3060: 69 6e 67 20 65 6e 64 6c 69 6e 65 29 29 0a 3b 3b ing endline)).;;
3070: 09 09 09 20 20 20 20 20 20 28 65 6e 64 6c 65 6e ... (endlen
3080: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
3090: 65 6e 64 73 74 72 29 29 29 0a 3b 3b 09 09 09 20 endstr))).;;...
30a0: 28 69 66 20 28 3e 20 65 6e 64 6c 65 6e 20 30 29 (if (> endlen 0)
30b0: 0a 3b 3b 09 09 09 20 20 20 20 20 28 66 6f 72 6d .;;... (form
30c0: 61 74 20 64 65 62 75 67 70 20 22 20 64 65 6c 69 at debugp " deli
30d0: 6d 3a 20 7e 41 5c 6e 65 6e 64 73 74 72 3a 20 7e m: ~A\nendstr: ~
30e0: 41 5c 6e 22 20 64 65 6c 69 6d 2d 73 74 72 69 6e A\n" delim-strin
30f0: 67 20 65 6e 64 73 74 72 29 29 0a 3b 3b 09 09 09 g endstr)).;;...
3100: 20 28 69 66 20 28 61 6e 64 20 28 3e 20 64 65 6c (if (and (> del
3110: 69 6d 2d 6c 65 6e 20 65 6e 64 6c 65 6e 29 0a 3b im-len endlen).;
3120: 3b 09 09 09 09 20 20 28 73 74 72 69 6e 67 3d 3f ;.... (string=?
3130: 20 6c 20 28 73 75 62 73 74 72 69 6e 67 20 64 65 l (substring de
3140: 6c 69 6d 2d 73 74 72 69 6e 67 20 65 6e 64 6c 65 lim-string endle
3150: 6e 20 28 2b 20 65 6e 64 6c 65 6e 20 31 29 29 29 n (+ endlen 1)))
3160: 29 0a 3b 3b 09 09 09 20 20 20 20 20 3b 3b 20 79 ).;;... ;; y
3170: 65 73 2c 20 74 68 69 73 20 63 68 61 72 61 63 74 es, this charact
3180: 65 72 20 6d 61 74 63 68 65 73 20 74 68 65 20 6e er matches the n
3190: 65 78 74 20 69 6e 20 74 68 65 20 64 65 6c 69 6d ext in the delim
31a0: 2d 73 74 72 69 6e 67 0a 3b 3b 09 09 09 20 20 20 -string.;;...
31b0: 20 20 28 69 66 20 28 65 71 3f 20 64 65 6c 69 6d (if (eq? delim
31c0: 2d 6c 65 6e 20 65 6e 64 6c 65 6e 29 20 3b 3b 20 -len endlen) ;;
31d0: 68 61 76 65 20 61 20 6d 61 74 63 68 21 20 49 67 have a match! Ig
31e0: 6e 6f 72 65 20 74 68 61 74 20 61 20 6e 65 77 6c nore that a newl
31f0: 69 6e 65 20 69 73 20 72 65 71 75 69 72 65 64 2e ine is required.
3200: 20 4c 61 7a 79 20 62 75 67 67 65 72 2e 0a 3b 3b Lazy bugger..;;
3210: 09 09 09 09 20 28 6c 65 74 2a 20 28 28 66 6e 20 .... (let* ((fn
3220: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 (string->sy
3230: 6d 62 6f 6c 20 64 61 74 61 2d 6e 61 6d 65 29 29 mbol data-name))
3240: 29 0a 3b 3b 09 09 09 09 20 20 20 28 66 6f 72 6d ).;;.... (form
3250: 64 61 74 3a 73 65 74 21 20 66 6f 72 6d 64 61 74 dat:set! formdat
3260: 20 66 6e 20 28 6c 69 73 74 20 66 69 6c 65 2d 6e fn (list file-n
3270: 61 6d 65 20 64 61 74 61 2d 74 79 70 65 20 28 73 ame data-type (s
3280: 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 28 67 65 74 tring->blob (get
3290: 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 20 62 -output-string b
32a0: 69 6e 2d 64 61 74 29 29 29 29 0a 3b 3b 09 09 09 in-dat)))).;;...
32b0: 09 20 20 20 28 73 65 74 21 20 6d 6f 64 65 20 27 . (set! mode '
32c0: 6e 6f 72 6d 29 0a 3b 3b 09 09 09 09 20 20 20 28 norm).;;.... (
32d0: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 loop (read-line)
32e0: 20 23 66 20 30 29 29 0a 3b 3b 09 09 09 09 20 28 #f 0)).;;.... (
32f0: 62 65 67 69 6e 0a 3b 3b 09 09 09 09 20 20 20 28 begin.;;.... (
3300: 77 72 69 74 65 2d 73 74 72 69 6e 67 20 6c 20 23 write-string l #
3310: 66 20 65 6e 64 6c 69 6e 65 29 0a 3b 3b 09 09 09 f endline).;;...
3320: 09 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d . (loop (read-
3330: 73 74 72 69 6e 67 20 31 29 20 65 6e 64 6c 69 6e string 1) endlin
3340: 65 20 28 2b 20 6e 75 6d 20 31 29 29 29 29 0a 3b e (+ num 1)))).;
3350: 3b 09 09 09 20 20 20 20 20 3b 3b 20 6e 6f 2c 20 ;... ;; no,
3360: 74 68 69 73 20 63 68 61 72 61 63 74 65 72 20 64 this character d
3370: 6f 65 73 20 4e 4f 54 20 6d 61 74 63 68 20 74 68 oes NOT match th
3380: 65 20 6e 65 78 74 20 69 6e 20 6c 69 6e 65 20 69 e next in line i
3390: 6e 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 0a 3b n delim-string.;
33a0: 3b 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a ;... (begin.
33b0: 3b 3b 09 09 09 20 20 20 20 20 20 20 28 77 72 69 ;;... (wri
33c0: 74 65 2d 73 74 72 69 6e 67 20 22 5c 6e 22 20 23 te-string "\n" #
33d0: 66 20 62 69 6e 2d 64 61 74 29 20 3b 3b 20 64 6f f bin-dat) ;; do
33e0: 6e 27 74 20 66 6f 72 67 65 74 20 74 68 61 74 20 n't forget that
33f0: 6e 65 77 6c 69 6e 65 20 77 65 20 64 72 6f 70 70 newline we dropp
3400: 65 64 0a 3b 3b 09 09 09 20 20 20 20 20 20 20 28 ed.;;... (
3410: 77 72 69 74 65 2d 73 74 72 69 6e 67 20 65 6e 64 write-string end
3420: 73 74 72 20 23 66 20 62 69 6e 2d 64 61 74 29 0a str #f bin-dat).
3430: 3b 3b 09 09 09 20 20 20 20 20 20 20 28 77 72 69 ;;... (wri
3440: 74 65 2d 73 74 72 69 6e 67 20 6c 20 23 66 20 62 te-string l #f b
3450: 69 6e 2d 64 61 74 29 0a 3b 3b 09 09 09 20 20 20 in-dat).;;...
3460: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read-
3470: 73 74 72 69 6e 67 20 31 29 20 23 66 20 28 2b 20 string 1) #f (+
3480: 6e 75 6d 20 31 29 29 29 29 29 29 29 29 0a 3b 3b num 1)))))))).;;
3490: 09 09 20 20 20 20 29 29 29 29 29 0a 0a 3b 3b 20 .. )))))..;;
34a0: 20 20 20 28 66 6f 72 6d 64 61 74 3a 70 72 69 6e (formdat:prin
34b0: 74 61 6c 6c 20 66 6f 72 6d 64 61 74 20 28 6c 61 tall formdat (la
34c0: 6d 62 64 61 20 28 78 29 28 77 72 69 74 65 2d 6c mbda (x)(write-l
34d0: 69 6e 65 20 78 20 64 65 62 75 67 70 29 29 29 0a ine x debugp))).
34e0: 0a 23 7c 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 .#|.(define inp
34f0: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 (open-input-file
3500: 20 22 2f 74 6d 70 2f 73 74 6d 6c 72 75 6e 2f 64 "/tmp/stmlrun/d
3510: 65 6c 6d 65 2d 33 33 2e 6c 6f 67 2e 6b 65 65 70 elme-33.log.keep
3520: 2d 66 6f 72 2d 72 65 66 22 29 29 0a 28 64 65 66 -for-ref")).(def
3530: 69 6e 65 20 64 61 74 20 28 72 65 61 64 2d 73 74 ine dat (read-st
3540: 72 69 6e 67 20 23 66 20 69 6e 70 29 29 0a 28 63 ring #f inp)).(c
3550: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
3560: 69 6e 70 29 0a 7c 23 0a 0a 29 0a inp).|#..).