Artifact
e7bfc732dd4315de2ee68339ab28b8344894dfa5:
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 28 64 65 63 6c 61 PURPOSE...(decla
0150: 72 65 20 28 75 6e 69 74 20 66 6f 72 6d 64 61 74 re (unit formdat
0160: 29 29 0a 28 75 73 65 20 72 65 67 65 78 29 0a 28 )).(use regex).(
0170: 72 65 71 75 69 72 65 2d 65 78 74 65 6e 73 69 6f require-extensio
0180: 6e 20 73 72 66 69 2d 36 39 29 0a 0a 28 64 65 66 n srfi-69)..(def
0190: 69 6e 65 20 66 6f 72 6d 64 61 74 3a 2a 64 65 62 ine formdat:*deb
01a0: 75 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f 6c 64 20 ug* #f)..;; Old
01b0: 64 61 74 61 20 66 6f 72 6d 61 74 20 77 61 73 20 data format was
01c0: 73 6f 6d 65 74 68 69 6e 67 20 6c 69 6b 65 20 74 something like t
01d0: 68 69 73 2e 20 42 55 54 21 20 0a 3b 3b 20 46 6f his. BUT! .;; Fo
01e0: 72 6d 73 20 64 6f 20 6e 6f 74 20 68 61 76 65 20 rms do not have
01f0: 6e 61 6d 65 73 20 73 6f 20 74 68 65 20 68 69 65 names so the hie
0200: 72 61 72 63 79 20 69 73 0a 3b 3b 20 75 6e 6e 65 rarcy is.;; unne
0210: 63 65 73 73 61 72 79 20 28 49 20 74 68 69 6e 6b cessary (I think
0220: 29 0a 3b 3b 0a 3b 3b 20 68 61 73 68 74 61 62 6c ).;;.;; hashtabl
0230: 65 0a 3b 3b 20 20 20 7c 2d 66 6f 72 6d 6e 61 6d e.;; |-formnam
0240: 65 20 2d 2d 3e 20 3c 66 6f 72 6d 64 61 74 3e 20 e --> <formdat>
0250: 27 66 6f 72 6d 2d 6e 61 6d 65 3d 66 6f 72 6d 6e 'form-name=formn
0260: 61 6d 65 0a 3b 3b 20 20 20 7c 20 20 20 20 20 20 ame.;; |
0270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0280: 20 20 27 66 6f 72 6d 2d 64 61 74 61 3d 68 61 73 'form-data=has
0290: 68 74 61 62 6c 65 0a 3b 3b 20 20 20 7c 20 20 20 htable.;; |
02a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
02b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
02c0: 20 20 20 20 7c 20 6e 61 6d 65 20 3d 3e 20 76 61 | name => va
02d0: 6c 75 65 0a 3b 3b 0a 3b 3b 20 4e 65 77 20 64 61 lue.;;.;; New da
02e0: 74 61 20 66 6f 72 6d 61 74 20 69 73 20 6f 6e 6c ta format is onl
02f0: 79 20 74 68 65 20 3c 66 6f 72 6d 64 61 74 3e 20 y the <formdat>
0300: 70 6f 72 74 69 6f 6e 20 66 72 6f 6d 20 61 62 6f portion from abo
0310: 76 65 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 2d 63 ve..;; (define-c
0320: 6c 61 73 73 20 3c 66 6f 72 6d 64 61 74 3e 20 28 lass <formdat> (
0330: 29 0a 3b 3b 20 20 20 20 28 66 6f 72 6d 2d 64 61 ).;; (form-da
0340: 74 61 0a 3b 3b 20 20 20 20 29 29 0a 28 64 65 66 ta.;; )).(def
0350: 69 6e 65 20 28 6d 61 6b 65 2d 66 6f 72 6d 64 61 ine (make-formda
0360: 74 3a 66 6f 72 6d 64 61 74 29 28 76 65 63 74 6f t:formdat)(vecto
0370: 72 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 r (make-hash-tab
0380: 6c 65 29 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e le))).(define-in
0390: 6c 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a 66 6f line (formdat:fo
03a0: 72 6d 64 61 74 2d 67 65 74 2d 64 61 74 61 20 20 rmdat-get-data
03b0: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 vec) (vector
03c0: 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a 28 64 -ref vec 0)).(d
03d0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 66 6f efine-inline (fo
03e0: 72 6d 64 61 74 3a 66 6f 72 6d 64 61 74 2d 73 65 rmdat:formdat-se
03f0: 74 2d 64 61 74 61 21 20 20 76 65 63 20 76 61 6c t-data! vec val
0400: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 )(vector-set! ve
0410: 63 20 30 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 c 0 val))..(defi
0420: 6e 65 20 28 66 6f 72 6d 64 61 74 3a 69 6e 69 74 ne (formdat:init
0430: 69 61 6c 69 7a 65 20 73 65 6c 66 29 0a 20 20 28 ialize self). (
0440: 66 6f 72 6d 64 61 74 3a 66 6f 72 6d 64 61 74 2d formdat:formdat-
0450: 73 65 74 2d 64 61 74 61 21 20 73 65 6c 66 20 28 set-data! self (
0460: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0470: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 66 6f 72 ))..(define (for
0480: 6d 64 61 74 3a 67 65 74 20 73 65 6c 66 20 6b 65 mdat:get self ke
0490: 79 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 y). (hash-table
04a0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a 20 20 -ref/default .
04b0: 20 28 66 6f 72 6d 64 61 74 3a 66 6f 72 6d 64 61 (formdat:formda
04c0: 74 2d 67 65 74 2d 64 61 74 61 20 73 65 6c 66 29 t-get-data self)
04d0: 0a 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 28 . (cond . (
04e0: 28 73 79 6d 62 6f 6c 3f 20 6b 65 79 29 20 6b 65 (symbol? key) ke
04f0: 79 29 0a 20 20 20 20 28 28 73 74 72 69 6e 67 3f y). ((string?
0500: 20 6b 65 79 29 20 28 73 74 72 69 6e 67 2d 3e 73 key) (string->s
0510: 79 6d 62 6f 6c 20 6b 65 79 29 29 0a 20 20 20 20 ymbol key)).
0520: 28 65 6c 73 65 20 6b 65 79 29 29 0a 20 20 20 23 (else key)). #
0530: 66 29 29 0a 0a 3b 3b 20 63 68 61 6e 67 65 20 74 f))..;; change t
0540: 6f 20 63 6f 6e 76 65 72 74 20 64 61 74 61 20 74 o convert data t
0550: 6f 20 6c 69 73 74 20 61 6e 64 20 61 70 70 65 6e o list and appen
0560: 64 20 76 61 6c 20 69 66 20 61 6c 72 65 61 64 79 d val if already
0570: 20 65 78 69 73 74 73 0a 3b 3b 20 6f 72 20 69 73 exists.;; or is
0580: 20 61 20 6c 69 73 74 0a 28 64 65 66 69 6e 65 20 a list.(define
0590: 28 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 73 65 (formdat:set! se
05a0: 6c 66 20 6b 65 79 20 76 61 6c 29 0a 20 20 28 6c lf key val). (l
05b0: 65 74 20 28 28 70 72 65 76 2d 76 61 6c 20 28 66 et ((prev-val (f
05c0: 6f 72 6d 64 61 74 3a 67 65 74 20 73 65 6c 66 20 ormdat:get self
05d0: 6b 65 79 29 29 0a 20 20 20 20 20 20 20 20 28 68 key)). (h
05e0: 74 20 20 20 20 20 20 20 28 66 6f 72 6d 64 61 74 t (formdat
05f0: 3a 66 6f 72 6d 64 61 74 2d 67 65 74 2d 64 61 74 :formdat-get-dat
0600: 61 20 73 65 6c 66 29 29 29 0a 20 20 20 20 28 69 a self))). (i
0610: 66 20 70 72 65 76 2d 76 61 6c 0a 20 20 20 20 20 f prev-val.
0620: 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 70 72 (if (list? pr
0630: 65 76 2d 76 61 6c 29 0a 20 20 20 20 20 20 20 20 ev-val).
0640: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
0650: 73 65 74 21 20 68 74 20 6b 65 79 20 28 63 6f 6e set! ht key (con
0660: 73 20 76 61 6c 20 70 72 65 76 2d 76 61 6c 29 29 s val prev-val))
0670: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 . (ha
0680: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 74 sh-table-set! ht
0690: 20 6b 65 79 20 28 6c 69 73 74 20 76 61 6c 20 70 key (list val p
06a0: 72 65 76 2d 76 61 6c 29 29 29 0a 20 20 20 20 20 rev-val))).
06b0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
06c0: 65 74 21 20 68 74 20 6b 65 79 20 76 61 6c 29 29 et! ht key val))
06d0: 0a 20 20 20 20 73 65 6c 66 29 29 0a 0a 28 64 65 . self))..(de
06e0: 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a 6b 65 fine (formdat:ke
06f0: 79 73 20 73 65 6c 66 29 0a 20 20 28 68 61 73 68 ys self). (hash
0700: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 28 66 6f 72 -table-keys (for
0710: 6d 64 61 74 3a 66 6f 72 6d 64 61 74 2d 67 65 74 mdat:formdat-get
0720: 2d 64 61 74 61 20 73 65 6c 66 29 29 29 0a 0a 28 -data self)))..(
0730: 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a define (formdat:
0740: 70 72 69 6e 74 61 6c 6c 20 73 65 6c 66 20 70 72 printall self pr
0750: 69 6e 74 70 72 6f 63 29 0a 20 20 28 70 72 69 6e intproc). (prin
0760: 74 70 72 6f 63 20 22 66 6f 72 6d 64 61 74 3a 70 tproc "formdat:p
0770: 72 69 6e 74 61 6c 6c 20 22 20 28 66 6f 72 6d 64 rintall " (formd
0780: 61 74 3a 6b 65 79 73 20 73 65 6c 66 29 29 0a 20 at:keys self)).
0790: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
07a0: 64 61 20 28 6b 29 0a 09 20 20 20 20 20 20 28 70 da (k).. (p
07b0: 72 69 6e 74 70 72 6f 63 20 6b 20 22 20 3d 3e 20 rintproc k " =>
07c0: 22 20 28 66 6f 72 6d 64 61 74 3a 67 65 74 20 73 " (formdat:get s
07d0: 65 6c 66 20 6b 29 29 29 0a 09 20 20 20 20 28 66 elf k))).. (f
07e0: 6f 72 6d 64 61 74 3a 6b 65 79 73 20 73 65 6c 66 ormdat:keys self
07f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 66 6f )))..(define (fo
0800: 72 6d 64 61 74 3a 61 6c 6c 2d 3e 73 74 72 69 6e rmdat:all->strin
0810: 67 73 20 73 65 6c 66 29 0a 20 20 28 6c 65 74 20 gs self). (let
0820: 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 ((res '())).
0830: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
0840: 61 20 28 6b 29 0a 20 20 20 20 20 20 20 20 20 20 a (k).
0850: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
0860: 20 28 63 6f 6e 73 20 28 63 6f 6e 63 20 6b 20 22 (cons (conc k "
0870: 3d 3e 22 20 28 66 6f 72 6d 64 61 74 3a 67 65 74 =>" (formdat:get
0880: 20 73 65 6c 66 20 6b 29 29 20 72 65 73 29 29 29 self k)) res)))
0890: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
08a0: 66 6f 72 6d 64 61 74 3a 6b 65 79 73 20 73 65 6c formdat:keys sel
08b0: 66 29 29 0a 20 20 20 20 20 20 20 20 72 65 73 29 f)). res)
08c0: 29 0a 0a 3b 3b 20 63 61 6c 6c 20 77 69 74 68 20 )..;; call with
08d0: 2a 6f 6e 65 2a 20 6f 66 20 74 68 65 20 6c 69 73 *one* of the lis
08e0: 74 73 20 69 6e 20 74 68 65 20 6c 69 73 74 20 6f ts in the list o
08f0: 66 20 6c 69 73 74 73 20 63 72 65 61 74 65 64 20 f lists created
0900: 62 79 20 43 47 49 3a 75 72 6c 2d 75 6e 71 75 6f by CGI:url-unquo
0910: 74 65 0a 28 64 65 66 69 6e 65 20 28 66 6f 72 6d te.(define (form
0920: 64 61 74 3a 6c 6f 61 64 20 73 65 6c 66 20 66 6f dat:load self fo
0930: 72 6d 6c 69 73 74 29 0a 20 20 28 6c 65 74 20 28 rmlist). (let (
0940: 28 68 74 20 20 20 20 20 20 20 20 20 20 20 20 20 (ht
0950: 28 66 6f 72 6d 64 61 74 3a 66 6f 72 6d 64 61 74 (formdat:formdat
0960: 2d 67 65 74 2d 64 61 74 61 20 73 65 6c 66 29 29 -get-data self))
0970: 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f ). (if (null?
0980: 20 66 6f 72 6d 6c 69 73 74 29 20 73 65 6c 66 20 formlist) self
0990: 3b 3b 20 6e 6f 20 76 61 6c 75 65 73 20 70 72 6f ;; no values pro
09a0: 76 69 64 65 64 2c 20 72 65 74 75 72 6e 20 73 65 vided, return se
09b0: 6c 66 20 66 6f 72 20 6e 6f 20 67 6f 6f 64 20 72 lf for no good r
09c0: 65 61 73 6f 6e 0a 20 20 20 20 20 20 20 20 28 6c eason. (l
09d0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 61 64 20 28 et loop ((head (
09e0: 63 61 72 20 66 6f 72 6d 6c 69 73 74 29 29 0a 20 car formlist)).
09f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a00: 20 20 28 74 61 69 6c 20 28 63 64 72 20 66 6f 72 (tail (cdr for
0a10: 6d 6c 69 73 74 29 29 29 0a 20 20 20 20 20 20 20 mlist))).
0a20: 20 20 20 28 6c 65 74 20 28 28 6b 65 79 20 28 63 (let ((key (c
0a30: 61 72 20 68 65 61 64 29 29 0a 20 20 20 20 20 20 ar head)).
0a40: 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 20 28 (val (
0a50: 63 64 72 20 68 65 61 64 29 29 29 0a 20 20 20 20 cdr head))).
0a60: 20 20 20 20 20 20 20 20 3b 3b 20 28 65 72 72 3a ;; (err:
0a70: 6c 6f 67 20 22 6b 65 79 3d 22 20 6b 65 79 20 22 log "key=" key "
0a80: 20 76 61 6c 3d 22 20 76 61 6c 29 0a 09 20 20 20 val=" val)..
0a90: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
0aa0: 76 61 6c 29 20 31 29 0a 09 09 28 66 6f 72 6d 64 val) 1)...(formd
0ab0: 61 74 3a 73 65 74 21 20 73 65 6c 66 20 6b 65 79 at:set! self key
0ac0: 20 76 61 6c 29 0a 09 09 28 66 6f 72 6d 64 61 74 val)...(formdat
0ad0: 3a 73 65 74 21 20 73 65 6c 66 20 6b 65 79 20 28 :set! self key (
0ae0: 63 61 72 20 76 61 6c 29 29 29 0a 20 20 20 20 20 car val))).
0af0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
0b00: 3f 20 74 61 69 6c 29 20 73 65 6c 66 20 20 20 3b ? tail) self ;
0b10: 3b 20 77 65 20 61 72 65 20 64 6f 6e 65 0a 20 20 ; we are done.
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
0b30: 6f 6f 70 20 28 63 61 72 20 74 61 69 6c 29 28 63 oop (car tail)(c
0b40: 64 72 20 74 61 69 6c 29 29 29 29 29 29 29 29 0a dr tail)))))))).
0b50: 0a 3b 3b 20 67 65 74 20 74 68 65 20 68 65 61 64 .;; get the head
0b60: 65 72 20 66 72 6f 6d 20 64 61 74 73 74 72 0a 28 er from datstr.(
0b70: 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a define (formdat:
0b80: 72 65 61 64 2d 68 65 61 64 65 72 20 64 61 74 73 read-header dats
0b90: 74 72 29 20 3b 3b 20 64 61 74 73 74 72 20 69 73 tr) ;; datstr is
0ba0: 20 61 6e 20 69 6e 70 75 74 20 73 74 72 69 6e 67 an input string
0bb0: 20 70 6f 72 74 0a 20 20 28 6c 65 74 20 6c 6f 6f port. (let loo
0bc0: 70 20 28 28 68 73 20 28 72 65 61 64 2d 6c 69 6e p ((hs (read-lin
0bd0: 65 20 64 61 74 73 74 72 29 29 0a 09 20 20 20 20 e datstr))..
0be0: 20 28 68 65 61 64 65 72 20 27 28 29 29 29 0a 20 (header '())).
0bf0: 20 20 20 28 69 66 20 28 6f 72 20 28 65 6f 66 2d (if (or (eof-
0c00: 6f 62 6a 65 63 74 3f 20 68 73 29 0a 09 20 20 20 object? hs)..
0c10: 20 28 73 74 72 69 6e 67 3d 3f 20 68 73 20 22 22 (string=? hs ""
0c20: 29 29 0a 09 68 65 61 64 65 72 0a 09 28 6c 6f 6f ))..header..(loo
0c30: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 64 61 74 p (read-line dat
0c40: 73 74 72 29 28 61 70 70 65 6e 64 20 68 65 61 64 str)(append head
0c50: 65 72 20 28 6c 69 73 74 20 68 73 29 29 29 29 29 er (list hs)))))
0c60: 29 0a 0a 3b 3b 20 67 65 74 20 74 68 65 20 64 61 )..;; get the da
0c70: 74 61 20 75 70 20 74 6f 20 74 68 65 20 6e 65 78 ta up to the nex
0c80: 74 20 6b 65 79 2e 20 69 66 20 74 68 65 72 65 20 t key. if there
0c90: 69 73 20 6e 6f 20 6b 65 79 20 74 68 65 6e 20 72 is no key then r
0ca0: 65 74 75 72 6e 20 23 66 0a 3b 3b 20 72 65 74 75 eturn #f.;; retu
0cb0: 72 6e 20 28 64 61 74 20 72 65 6d 64 61 74 29 0a rn (dat remdat).
0cc0: 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 (define (formdat
0cd0: 3a 72 65 61 64 2d 64 61 74 20 64 61 74 20 6b 65 :read-dat dat ke
0ce0: 79 29 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 65 y). (let ((inde
0cf0: 78 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 x (substring-ind
0d00: 65 78 20 6b 65 79 20 64 61 74 29 29 29 20 3b 3b ex key dat))) ;;
0d10: 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 2d (string-search-
0d20: 70 6f 73 69 74 69 6f 6e 73 20 6b 65 79 20 64 61 positions key da
0d30: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 t))). (if (or
0d40: 20 28 6e 6f 74 20 69 6e 64 65 78 29 0a 09 20 20 (not index)..
0d50: 20 20 28 6e 75 6c 6c 3f 20 69 6e 64 65 78 29 29 (null? index))
0d60: 20 3b 3b 20 74 68 65 20 6b 65 79 20 77 61 73 20 ;; the key was
0d70: 6e 6f 74 20 66 6f 75 6e 64 0a 09 23 66 0a 09 28 not found..#f..(
0d80: 6c 65 74 2a 20 28 28 64 61 74 73 74 72 20 28 6f let* ((datstr (o
0d90: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
0da0: 20 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 dat)).. (
0db0: 72 65 73 75 6c 74 20 28 72 65 61 64 2d 73 74 72 result (read-str
0dc0: 69 6e 67 20 28 63 61 61 72 20 69 6e 64 65 78 29 ing (caar index)
0dd0: 20 64 61 74 73 74 72 29 29 0a 09 20 20 20 20 20 datstr))..
0de0: 20 20 28 72 65 6d 64 61 74 20 28 72 65 61 64 2d (remdat (read-
0df0: 73 74 72 69 6e 67 20 23 66 20 64 61 74 73 74 72 string #f datstr
0e00: 29 29 29 0a 09 20 20 28 63 6c 6f 73 65 2d 69 6e ))).. (close-in
0e10: 70 75 74 2d 70 6f 72 74 20 64 61 74 73 74 72 29 put-port datstr)
0e20: 0a 09 20 20 28 6c 69 73 74 20 72 65 73 75 6c 74 .. (list result
0e30: 20 72 65 6d 64 61 74 29 29 29 29 29 0a 0a 20 3b remdat))))).. ;
0e40: 3b 20 69 6e 70 20 69 73 20 70 6f 72 74 20 74 6f ; inp is port to
0e50: 20 72 65 61 64 20 64 61 74 61 20 66 72 6f 6d 2c read data from,
0e60: 20 6d 61 78 73 69 7a 65 20 69 73 20 6d 61 78 20 maxsize is max
0e70: 64 61 74 61 20 61 6c 6c 6f 77 65 64 20 74 6f 20 data allowed to
0e80: 72 65 61 64 20 28 74 6f 74 61 6c 29 0a 28 64 65 read (total).(de
0e90: 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a 64 61 fine (formdat:da
0ea0: 74 2d 3e 6c 69 73 74 20 69 6e 70 20 6d 61 78 73 t->list inp maxs
0eb0: 69 7a 65 20 23 21 6b 65 79 20 28 64 65 62 75 67 ize #!key (debug
0ec0: 2d 70 6f 72 74 20 23 66 29 29 0a 20 20 3b 3b 20 -port #f)). ;;
0ed0: 72 65 61 64 20 31 4d 65 67 20 63 68 75 6e 6b 73 read 1Meg chunks
0ee0: 20 66 72 6f 6d 20 74 68 65 20 69 6e 70 75 74 20 from the input
0ef0: 70 6f 72 74 2e 20 49 66 20 61 20 62 6c 6f 63 6b port. If a block
0f00: 20 69 73 20 6e 6f 74 20 63 6f 6d 70 6c 65 74 65 is not complete
0f10: 0a 20 20 3b 3b 20 74 61 63 6b 20 6f 6e 20 74 68 . ;; tack on th
0f20: 65 20 6e 65 78 74 20 31 4d 65 67 20 63 68 75 6e e next 1Meg chun
0f30: 6b 20 61 73 20 6e 65 65 64 65 64 2e 20 53 65 74 k as needed. Set
0f40: 20 75 70 20 73 6f 20 74 68 65 20 68 65 61 64 65 up so the heade
0f50: 72 20 69 73 20 61 6c 77 61 79 73 0a 20 20 3b 3b r is always. ;;
0f60: 20 61 74 20 74 68 65 20 62 65 67 69 6e 6e 69 6e at the beginnin
0f70: 67 20 6f 66 20 74 68 65 20 63 68 75 6e 6b 0a 20 g of the chunk.
0f80: 20 3b 3b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ;;-------------
0f90: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0fa0: 32 39 39 33 32 30 32 34 34 31 31 35 30 32 33 32 2993202441150232
0fb0: 33 33 33 32 31 33 36 32 31 34 39 37 33 0a 20 20 3332136214973.
0fc0: 3b 3b 43 6f 6e 74 65 6e 74 2d 44 69 73 70 6f 73 ;;Content-Dispos
0fd0: 69 74 69 6f 6e 3a 20 66 6f 72 6d 2d 64 61 74 61 ition: form-data
0fe0: 3b 20 6e 61 6d 65 3d 22 69 6e 70 75 74 2d 70 69 ; name="input-pi
0ff0: 63 74 75 72 65 22 3b 20 66 69 6c 65 6e 61 6d 65 cture"; filename
1000: 3d 22 62 72 65 61 64 66 72 75 69 74 2e 6a 70 67 ="breadfruit.jpg
1010: 22 0a 20 20 3b 3b 43 6f 6e 74 65 6e 74 2d 54 79 ". ;;Content-Ty
1020: 70 65 3a 20 69 6d 61 67 65 2f 6a 70 65 67 0a 20 pe: image/jpeg.
1030: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 64 61 74 (let loop ((dat
1040: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 30 (read-string 10
1050: 30 30 30 30 30 20 69 6e 70 29 29 0a 09 20 20 20 00000 inp))..
1060: 20 20 28 72 65 73 20 27 28 29 29 0a 09 20 20 20 (res '())..
1070: 20 20 28 73 69 7a 20 30 29 29 0a 20 20 20 20 28 (siz 0)). (
1080: 69 66 20 64 65 62 75 67 2d 70 6f 72 74 20 28 66 if debug-port (f
1090: 6f 72 6d 61 74 20 64 65 62 75 67 2d 70 6f 72 74 ormat debug-port
10a0: 20 22 64 61 74 3a 20 7e 41 5c 6e 22 20 64 61 74 "dat: ~A\n" dat
10b0: 29 29 0a 20 20 20 20 28 69 66 20 64 65 62 75 67 )). (if debug
10c0: 2d 70 6f 72 74 20 28 66 6f 72 6d 61 74 20 64 65 -port (format de
10d0: 62 75 67 2d 70 6f 72 74 20 22 65 6f 66 3a 20 7e bug-port "eof: ~
10e0: 41 5c 6e 22 20 28 65 6f 66 2d 6f 62 6a 65 63 74 A\n" (eof-object
10f0: 3f 20 28 72 65 61 64 20 69 6e 70 29 29 29 29 0a ? (read inp)))).
1100: 20 20 20 20 0a 20 20 20 20 28 69 66 20 28 3e 20 . (if (>
1110: 73 69 7a 20 6d 61 78 73 69 7a 65 29 0a 09 28 62 siz maxsize)..(b
1120: 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 egin.. (print "
1130: 44 41 54 41 20 54 4f 4f 20 42 49 47 22 29 0a 09 DATA TOO BIG")..
1140: 20 20 72 65 73 29 0a 09 28 6c 65 74 2a 20 28 28 res)..(let* ((
1150: 64 61 74 73 74 72 20 28 6f 70 65 6e 2d 69 6e 70 datstr (open-inp
1160: 75 74 2d 73 74 72 69 6e 67 20 64 61 74 29 29 0a ut-string dat)).
1170: 09 20 20 20 20 20 20 20 28 68 65 61 64 65 72 20 . (header
1180: 28 66 6f 72 6d 64 61 74 3a 72 65 61 64 2d 68 65 (formdat:read-he
1190: 61 64 65 72 20 64 61 74 73 74 72 29 29 0a 09 20 ader datstr))..
11a0: 20 20 20 20 20 20 28 6b 65 79 20 20 20 20 28 69 (key (i
11b0: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 68 65 f (not (null? he
11c0: 61 64 65 72 29 29 28 63 61 72 20 68 65 61 64 65 ader))(car heade
11d0: 72 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 r) #f))..
11e0: 28 72 65 6d 64 61 74 20 28 72 65 61 64 2d 73 74 (remdat (read-st
11f0: 72 69 6e 67 20 23 66 20 64 61 74 73 74 72 29 29 ring #f datstr))
1200: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 75 73 65 ;; use
1210: 64 20 69 6e 20 6e 65 78 74 20 6c 69 6e 65 2c 20 d in next line,
1220: 64 69 73 63 61 72 64 20 69 66 20 67 6f 74 20 64 discard if got d
1230: 61 74 61 2c 20 65 6c 73 65 20 72 65 76 65 72 74 ata, else revert
1240: 20 74 6f 0a 09 20 20 20 20 20 20 20 28 61 6c 6c to.. (all
1250: 64 61 74 20 28 69 66 20 6b 65 79 20 28 66 6f 72 dat (if key (for
1260: 6d 64 61 74 3a 72 65 61 64 2d 64 61 74 20 72 65 mdat:read-dat re
1270: 6d 64 61 74 20 6b 65 79 29 20 23 66 29 29 20 20 mdat key) #f))
1280: 20 20 3b 3b 20 74 72 79 20 74 6f 20 65 78 74 72 ;; try to extr
1290: 61 63 74 20 74 68 65 20 64 61 74 61 0a 09 20 20 act the data..
12a0: 20 20 20 20 20 28 74 68 73 64 61 74 20 28 69 66 (thsdat (if
12b0: 20 61 6c 6c 64 61 74 20 28 63 61 72 20 61 6c 6c alldat (car all
12c0: 64 61 74 29 20 20 23 66 29 29 20 20 20 20 20 3b dat) #f)) ;
12d0: 3b 20 74 68 65 20 64 61 74 61 0a 09 20 20 20 20 ; the data..
12e0: 20 20 20 28 6e 65 77 64 61 74 20 28 69 66 20 61 (newdat (if a
12f0: 6c 6c 64 61 74 20 28 63 61 64 72 20 61 6c 6c 64 lldat (cadr alld
1300: 61 74 29 20 23 66 29 29 20 20 20 20 20 3b 3b 20 at) #f)) ;;
1310: 6c 65 66 74 20 6f 76 65 72 20 64 61 74 61 2c 20 left over data,
1320: 6d 75 73 74 20 70 72 6f 63 65 73 73 20 2e 2e 2e must process ...
1330: 0a 09 20 20 20 20 20 20 20 28 74 68 73 72 65 73 .. (thsres
1340: 20 28 6c 69 73 74 20 68 65 61 64 65 72 20 74 68 (list header th
1350: 73 64 61 74 29 29 20 20 20 20 20 20 20 20 20 20 sdat))
1360: 20 20 20 3b 3b 20 73 70 65 63 75 6c 61 74 69 76 ;; speculativ
1370: 65 6c 79 20 63 6f 6e 73 74 72 75 63 74 20 72 65 ely construct re
1380: 73 75 6c 74 73 0a 09 20 20 20 20 20 20 20 28 6e sults.. (n
1390: 65 77 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ewres (append re
13a0: 73 20 28 6c 69 73 74 20 74 68 73 72 65 73 29 29 s (list thsres))
13b0: 29 29 20 20 20 20 20 20 3b 3b 20 73 70 65 63 75 )) ;; specu
13c0: 6c 61 74 69 76 65 6c 79 20 63 6f 6e 73 74 72 75 latively constru
13d0: 63 74 20 72 65 73 75 6c 74 73 0a 09 20 20 28 63 ct results.. (c
13e0: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
13f0: 64 61 74 73 74 72 29 0a 09 20 20 28 63 6f 6e 64 datstr).. (cond
1400: 0a 09 20 20 20 3b 3b 20 65 69 74 68 65 72 20 6e .. ;; either n
1410: 6f 20 68 65 61 64 65 72 20 6f 72 20 73 69 6e 67 o header or sing
1420: 6c 65 20 69 6e 70 75 74 0a 09 20 20 20 28 28 61 le input.. ((a
1430: 6e 64 20 28 6e 6f 74 20 61 6c 6c 64 61 74 29 0a nd (not alldat).
1440: 09 09 20 28 6f 72 20 28 6e 75 6c 6c 3f 20 68 65 .. (or (null? he
1450: 61 64 65 72 29 0a 09 09 20 20 20 20 20 28 6e 6f ader)... (no
1460: 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 t (string-match
1470: 66 6f 72 6d 64 61 74 3a 64 65 6c 69 6d 2d 70 61 formdat:delim-pa
1480: 74 74 2d 72 65 78 20 28 63 61 72 20 68 65 61 64 tt-rex (car head
1490: 65 72 29 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 er))))).. ;;
14a0: 28 70 72 69 6e 74 20 22 47 6f 74 20 68 65 72 65 (print "Got here
14b0: 22 29 0a 09 20 20 20 20 28 63 6f 6e 73 20 28 6c ").. (cons (l
14c0: 69 73 74 20 68 65 61 64 65 72 20 22 22 29 20 72 ist header "") r
14d0: 65 73 29 29 20 3b 3b 20 6e 6f 74 65 20 75 73 65 es)) ;; note use
14e0: 20 68 65 61 64 65 72 20 61 73 20 64 61 74 20 61 header as dat a
14f0: 6e 64 20 75 73 65 20 22 22 20 61 73 20 68 65 61 nd use "" as hea
1500: 64 65 72 3f 3f 3f 3f 0a 09 20 20 20 3b 3b 20 64 der????.. ;; d
1510: 69 64 6e 27 74 20 66 69 6e 64 20 65 6e 64 20 6b idn't find end k
1520: 65 79 20 69 6e 20 74 68 69 73 20 62 6c 6f 63 6b ey in this block
1530: 0a 09 20 20 20 28 28 6e 6f 74 20 61 6c 6c 64 61 .. ((not allda
1540: 74 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6d t).. (let ((m
1550: 6f 72 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 ordat (read-stri
1560: 6e 67 20 31 30 30 30 30 30 30 20 69 6e 70 29 29 ng 1000000 inp))
1570: 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 73 74 ).. (if (st
1580: 72 69 6e 67 3d 3f 20 6d 6f 72 64 61 74 20 22 22 ring=? mordat ""
1590: 29 20 3b 3b 20 74 68 65 72 65 20 69 73 20 6e 6f ) ;; there is no
15a0: 20 6d 6f 72 65 20 64 61 74 61 2c 20 64 69 73 63 more data, disc
15b0: 61 72 64 20 72 65 73 75 6c 74 73 20 61 6e 64 20 ard results and
15c0: 75 73 65 20 72 65 6d 64 61 74 20 61 73 20 64 61 use remdat as da
15d0: 74 61 2c 20 74 68 69 73 20 69 6e 70 75 74 20 69 ta, this input i
15e0: 73 20 62 72 6f 6b 65 6e 0a 09 09 20 20 28 63 6f s broken... (co
15f0: 6e 73 20 28 6c 69 73 74 20 68 65 61 64 65 72 20 ns (list header
1600: 72 65 6d 64 61 74 29 20 72 65 73 29 0a 09 09 20 remdat) res)...
1610: 20 28 6c 6f 6f 70 20 28 73 74 72 69 6e 67 2d 61 (loop (string-a
1620: 70 70 65 6e 64 20 64 61 74 20 6d 6f 72 64 61 74 ppend dat mordat
1630: 29 20 72 65 73 20 28 2b 20 73 69 7a 20 32 30 30 ) res (+ siz 200
1640: 30 30 30 30 29 29 29 29 29 20 3b 3b 20 61 64 64 0000))))) ;; add
1650: 20 74 68 65 20 65 78 74 72 61 20 31 30 30 30 30 the extra 10000
1660: 30 30 0a 09 20 20 20 28 61 6c 6c 64 61 74 20 3b 00.. (alldat ;
1670: 3b 20 67 6f 74 20 64 61 74 61 2c 20 64 6f 6e 27 ; got data, don'
1680: 74 20 61 74 74 65 6d 70 74 20 74 6f 20 63 68 65 t attempt to che
1690: 63 6b 20 69 66 20 74 68 65 72 65 20 69 73 20 6d ck if there is m
16a0: 6f 72 65 2c 20 6a 75 73 74 20 6c 6f 6f 70 20 61 ore, just loop a
16b0: 6e 64 20 72 65 6c 79 20 6f 6e 20 28 6e 6f 74 20 nd rely on (not
16c0: 61 6c 6c 64 61 74 29 20 74 6f 20 67 65 74 20 6d alldat) to get m
16d0: 6f 72 65 20 64 61 74 61 0a 09 20 20 20 20 28 6c ore data.. (l
16e0: 6f 6f 70 20 6e 65 77 64 61 74 20 6e 65 77 72 65 oop newdat newre
16f0: 73 20 28 2b 20 73 69 7a 20 31 30 30 30 30 30 30 s (+ siz 1000000
1700: 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e ))))))))..(defin
1710: 65 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 61 e formdat:bin-da
1720: 74 61 2d 64 69 73 70 2d 72 65 78 20 28 72 65 67 ta-disp-rex (reg
1730: 65 78 70 20 22 5e 43 6f 6e 74 65 6e 74 2d 44 69 exp "^Content-Di
1740: 73 70 6f 73 69 74 69 6f 6e 3a 5c 5c 73 2b 66 6f sposition:\\s+fo
1750: 72 6d 2d 64 61 74 61 3b 22 29 29 0a 28 64 65 66 rm-data;")).(def
1760: 69 6e 65 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d ine formdat:bin-
1770: 64 61 74 61 2d 6e 61 6d 65 2d 72 65 78 20 28 72 data-name-rex (r
1780: 65 67 65 78 70 20 22 5c 5c 57 6e 61 6d 65 3d 5c egexp "\\Wname=\
1790: 22 28 5b 5e 5c 22 5d 2b 29 5c 22 22 29 29 0a 28 "([^\"]+)\"")).(
17a0: 64 65 66 69 6e 65 20 66 6f 72 6d 64 61 74 3a 62 define formdat:b
17b0: 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d 72 65 78 in-file-name-rex
17c0: 20 28 72 65 67 65 78 70 20 22 5c 5c 57 66 69 6c (regexp "\\Wfil
17d0: 65 6e 61 6d 65 3d 5c 22 28 5b 5e 5c 22 5d 2b 29 ename=\"([^\"]+)
17e0: 5c 22 22 29 29 0a 28 64 65 66 69 6e 65 20 66 6f \"")).(define fo
17f0: 72 6d 64 61 74 3a 62 69 6e 2d 66 69 6c 65 2d 74 rmdat:bin-file-t
1800: 79 70 65 2d 72 65 78 20 28 72 65 67 65 78 70 20 ype-rex (regexp
1810: 22 43 6f 6e 74 65 6e 74 2d 54 79 70 65 3a 5c 5c "Content-Type:\\
1820: 73 2b 28 5b 5e 5c 5c 73 5d 2b 29 22 29 29 0a 28 s+([^\\s]+)")).(
1830: 64 65 66 69 6e 65 20 66 6f 72 6d 64 61 74 3a 64 define formdat:d
1840: 65 6c 69 6d 2d 70 61 74 74 2d 72 65 78 20 20 20 elim-patt-rex
1850: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 2d 2b 5b (regexp "^\\-+[
1860: 30 2d 39 5d 2b 5c 5c 2d 2a 24 22 29 29 0a 0a 3b 0-9]+\\-*$"))..;
1870: 3b 20 72 65 74 75 72 6e 73 20 61 20 68 61 73 68 ; returns a hash
1880: 20 77 69 74 68 20 65 6e 74 72 69 65 73 20 66 6f with entries fo
1890: 72 20 61 6c 6c 20 66 6f 72 6d 73 20 2d 20 63 6f r all forms - co
18a0: 75 6c 64 20 77 65 6c 6c 20 75 73 65 20 61 20 70 uld well use a p
18b0: 72 6f 70 6c 69 73 74 3f 0a 28 64 65 66 69 6e 65 roplist?.(define
18c0: 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 (formdat:load-a
18d0: 6c 6c 29 0a 20 20 28 6c 65 74 20 28 28 72 65 71 ll). (let ((req
18e0: 75 65 73 74 2d 6d 65 74 68 6f 64 20 28 67 65 74 uest-method (get
18f0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
1900: 69 61 62 6c 65 20 22 52 45 51 55 45 53 54 5f 4d iable "REQUEST_M
1910: 45 54 48 4f 44 22 29 29 29 0a 20 20 20 20 28 69 ETHOD"))). (i
1920: 66 20 28 61 6e 64 20 72 65 71 75 65 73 74 2d 6d f (and request-m
1930: 65 74 68 6f 64 0a 09 20 20 20 20 20 28 73 74 72 ethod.. (str
1940: 69 6e 67 3d 3f 20 72 65 71 75 65 73 74 2d 6d 65 ing=? request-me
1950: 74 68 6f 64 20 22 50 4f 53 54 22 29 29 0a 09 28 thod "POST"))..(
1960: 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c formdat:load-all
1970: 2d 70 6f 72 74 20 28 63 75 72 72 65 6e 74 2d 69 -port (current-i
1980: 6e 70 75 74 2d 70 6f 72 74 29 29 29 29 29 0a 0a nput-port)))))..
1990: 3b 3b 20 28 73 3a 70 72 6f 63 65 73 73 2d 63 67 ;; (s:process-cg
19a0: 69 2d 69 6e 70 75 74 20 28 63 61 61 61 72 20 64 i-input (caaar d
19b0: 61 74 29 29 0a 28 64 65 66 69 6e 65 20 28 66 6f at)).(define (fo
19c0: 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d 70 rmdat:load-all-p
19d0: 6f 72 74 20 69 6e 70 29 0a 20 20 28 6c 65 74 2a ort inp). (let*
19e0: 20 28 28 66 6f 72 6d 64 61 74 20 20 20 20 20 20 ((formdat
19f0: 20 20 28 6d 61 6b 65 2d 66 6f 72 6d 64 61 74 3a (make-formdat:
1a00: 66 6f 72 6d 64 61 74 29 29 0a 09 20 28 64 65 62 formdat)).. (deb
1a10: 75 67 70 20 20 20 20 20 20 20 20 20 23 66 29 29 ugp #f))
1a20: 0a 09 09 09 20 3b 3b 20 28 6f 70 65 6e 2d 6f 75 .... ;; (open-ou
1a30: 74 70 75 74 2d 66 69 6c 65 20 28 63 6f 6e 63 20 tput-file (conc
1a40: 22 2f 74 6d 70 2f 64 65 6c 6d 65 2d 22 20 28 63 "/tmp/delme-" (c
1a50: 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 20 urrent-user-id)
1a60: 22 2e 6c 6f 67 22 29 29 29 29 0a 20 20 20 20 3b ".log")))). ;
1a70: 3b 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 ; (write-string
1a80: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 (read-string #f
1a90: 69 6e 70 29 20 23 66 20 64 65 62 75 67 70 29 20 inp) #f debugp)
1aa0: 20 3b 3b 20 64 65 73 74 72 6f 79 73 20 61 6c 6c ;; destroys all
1ab0: 20 64 61 74 61 21 0a 20 20 20 20 28 66 6f 72 6d data!. (form
1ac0: 64 61 74 3a 69 6e 69 74 69 61 6c 69 7a 65 20 66 dat:initialize f
1ad0: 6f 72 6d 64 61 74 29 0a 20 20 20 20 28 6c 65 74 ormdat). (let
1ae0: 20 28 28 61 6c 6c 64 61 74 73 20 28 66 6f 72 6d ((alldats (form
1af0: 64 61 74 3a 64 61 74 2d 3e 6c 69 73 74 20 69 6e dat:dat->list in
1b00: 70 20 31 30 65 36 20 64 65 62 75 67 2d 70 6f 72 p 10e6 debug-por
1b10: 74 3a 20 64 65 62 75 67 70 29 29 29 0a 20 20 20 t: debugp))).
1b20: 20 20 20 0a 20 20 20 20 20 20 28 69 66 20 64 65 . (if de
1b30: 62 75 67 70 20 28 66 6f 72 6d 61 74 20 64 65 62 bugp (format deb
1b40: 75 67 70 20 22 66 6f 72 6d 64 61 74 20 3a 20 61 ugp "formdat : a
1b50: 6c 6c 64 61 74 73 3a 20 7e 41 5c 6e 22 20 61 6c lldats: ~A\n" al
1b60: 6c 64 61 74 73 29 29 0a 0a 20 20 20 20 20 20 28 ldats)).. (
1b70: 6c 65 74 20 28 28 66 69 72 73 74 69 74 65 6d 20 let ((firstitem
1b80: 20 20 28 63 61 72 20 61 6c 6c 64 61 74 73 29 29 (car alldats))
1b90: 0a 09 20 20 20 20 28 6d 75 6c 74 69 70 61 73 73 .. (multipass
1ba0: 20 23 66 29 29 20 0a 09 28 69 66 20 28 61 6e 64 #f)) ..(if (and
1bb0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 69 72 (not (null? fir
1bc0: 73 74 69 74 65 6d 29 29 0a 09 09 20 28 6e 6f 74 stitem))... (not
1bd0: 20 28 6e 75 6c 6c 3f 20 28 63 61 72 20 66 69 72 (null? (car fir
1be0: 73 74 69 74 65 6d 29 29 29 29 0a 09 20 20 20 20 stitem))))..
1bf0: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
1c00: 68 20 66 6f 72 6d 64 61 74 3a 64 65 6c 69 6d 2d h formdat:delim-
1c10: 70 61 74 74 2d 72 65 78 20 28 63 61 61 72 20 66 patt-rex (caar f
1c20: 69 72 73 74 69 74 65 6d 29 29 0a 09 09 28 73 65 irstitem))...(se
1c30: 74 21 20 6d 75 6c 74 69 70 61 73 73 20 23 74 29 t! multipass #t)
1c40: 29 29 0a 09 28 69 66 20 6d 75 6c 74 69 70 61 73 ))..(if multipas
1c50: 73 0a 09 20 20 20 20 3b 3b 20 68 61 6e 64 6c 65 s.. ;; handle
1c60: 20 6d 75 6c 74 69 2d 70 61 72 74 20 66 6f 72 6d multi-part form
1c70: 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
1c80: 28 6c 61 6d 62 64 61 20 28 64 61 74 6c 73 74 29 (lambda (datlst)
1c90: 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 65 61 64 ....(let* ((head
1ca0: 65 72 20 28 66 6f 72 6d 64 61 74 3a 65 78 74 72 er (formdat:extr
1cb0: 61 63 74 2d 68 65 61 64 65 72 2d 69 6e 66 6f 20 act-header-info
1cc0: 28 63 61 72 20 64 61 74 6c 73 74 29 29 29 0a 09 (car datlst)))..
1cd0: 09 09 20 20 20 20 20 20 20 28 6e 61 6d 65 20 20 .. (name
1ce0: 20 28 69 66 20 28 61 73 73 6f 63 20 27 6e 61 6d (if (assoc 'nam
1cf0: 65 20 68 65 61 64 65 72 29 0a 09 09 09 09 09 20 e header)......
1d00: 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f (string->symbo
1d10: 6c 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 27 l (cadr (assoc '
1d20: 6e 61 6d 65 20 68 65 61 64 65 72 29 29 29 0a 09 name header)))..
1d30: 09 09 09 09 20 20 20 22 22 29 29 20 3b 3b 20 67 .... "")) ;; g
1d40: 72 75 6d 62 6c 65 0a 09 09 09 20 20 20 20 20 20 rumble....
1d50: 20 28 66 6e 61 6d 65 6c 20 20 28 61 73 73 6f 63 (fnamel (assoc
1d60: 20 27 66 69 6c 65 6e 61 6d 65 20 68 65 61 64 65 'filename heade
1d70: 72 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 r)).... (c
1d80: 6f 6e 74 65 6e 74 20 28 61 73 73 6f 63 20 27 63 ontent (assoc 'c
1d90: 6f 6e 74 65 6e 74 20 68 65 61 64 65 72 29 29 0a ontent header)).
1da0: 09 09 09 20 20 20 20 20 20 20 28 64 61 74 20 20 ... (dat
1db0: 20 20 28 63 61 64 72 20 64 61 74 6c 73 74 29 29 (cadr datlst))
1dc0: 29 0a 09 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 ).... ;; (print
1dd0: 20 22 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 "header: " head
1de0: 65 72 20 22 20 6e 61 6d 65 3a 20 22 20 6e 61 6d er " name: " nam
1df0: 65 20 22 20 66 6e 61 6d 65 6c 3a 20 22 20 66 6e e " fnamel: " fn
1e00: 61 6d 65 6c 20 22 20 63 6f 6e 74 65 6e 74 3a 20 amel " content:
1e10: 22 20 63 6f 6e 74 65 6e 74 29 20 3b 3b 20 20 22 " content) ;; "
1e20: 20 64 61 74 3a 20 22 20 28 64 61 74 29 0a 09 09 dat: " (dat)...
1e30: 09 20 20 28 66 6f 72 6d 64 61 74 3a 73 65 74 21 . (formdat:set!
1e40: 20 66 6f 72 6d 64 61 74 20 0a 09 09 09 09 09 6e formdat ......n
1e50: 61 6d 65 0a 09 09 09 09 09 28 69 66 20 66 6e 61 ame......(if fna
1e60: 6d 65 6c 20 0a 09 09 09 09 09 20 20 20 20 28 6c mel ...... (l
1e70: 69 73 74 20 28 63 61 64 72 20 66 6e 61 6d 65 6c ist (cadr fnamel
1e80: 29 0a 09 09 09 09 09 09 20 20 28 69 66 20 63 6f )....... (if co
1e90: 6e 74 65 6e 74 0a 09 09 09 09 09 09 20 20 20 20 ntent.......
1ea0: 20 20 28 63 61 64 72 20 63 6f 6e 74 65 6e 74 29 (cadr content)
1eb0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 22 75 6e ....... "un
1ec0: 6b 6e 6f 77 6e 22 29 0a 09 09 09 09 09 09 20 20 known").......
1ed0: 28 73 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 64 61 (string->blob da
1ee0: 74 29 29 0a 09 09 09 09 09 20 20 20 20 64 61 74 t))...... dat
1ef0: 29 29 29 29 0a 09 09 20 20 20 20 20 20 61 6c 6c ))))... all
1f00: 64 61 74 73 29 0a 09 20 20 20 20 3b 3b 20 68 61 dats).. ;; ha
1f10: 6e 64 6c 65 20 73 69 6e 67 6c 65 20 70 61 72 74 ndle single part
1f20: 20 66 6f 72 6d 0a 09 20 20 20 20 3b 3b 20 09 28 form.. ;; .(
1f30: 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f if (and (string?
1f40: 20 6e 61 6d 65 29 0a 09 20 20 20 20 3b 3b 20 09 name).. ;; .
1f50: 09 20 20 20 20 20 28 73 74 72 69 6e 67 3d 3f 20 . (string=?
1f60: 6e 61 6d 65 20 22 22 29 29 20 3b 3b 20 74 68 69 name "")) ;; thi
1f70: 73 20 69 73 20 74 68 65 20 73 68 6f 72 74 20 66 s is the short f
1f80: 6f 72 6d 20 69 6e 70 75 74 20 49 20 67 75 65 73 orm input I gues
1f90: 73 0a 09 20 20 20 20 3b 3b 20 09 09 28 6c 65 74 s.. ;; ..(let
1fa0: 2a 20 28 28 64 61 74 73 74 72 20 28 63 61 61 72 * ((datstr (caar
1fb0: 20 64 61 74 6c 73 74 29 29 0a 09 20 20 20 20 3b datlst)).. ;
1fc0: 3b 20 09 09 20 20 20 20 20 20 20 28 6d 75 6e 67 ; .. (mung
1fd0: 65 64 20 28 73 3a 70 72 6f 63 65 73 73 2d 63 67 ed (s:process-cg
1fe0: 69 2d 69 6e 70 75 74 20 64 61 74 73 74 72 29 29 i-input datstr))
1ff0: 29 0a 09 20 20 20 20 3b 3b 20 09 09 20 20 28 70 ).. ;; .. (p
2000: 72 69 6e 74 20 22 64 61 74 73 74 72 3a 20 22 20 rint "datstr: "
2010: 64 61 74 73 74 72 20 22 20 6d 75 6e 67 65 64 3a datstr " munged:
2020: 20 22 20 6d 75 6e 67 65 64 29 0a 09 20 20 20 20 " munged)..
2030: 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e (if (and (not (n
2040: 75 6c 6c 3f 20 61 6c 6c 64 61 74 73 29 29 0a 09 ull? alldats))..
2050: 09 20 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c . (not (null
2060: 3f 20 28 63 61 72 20 61 6c 6c 64 61 74 73 29 29 ? (car alldats))
2070: 29 0a 09 09 20 20 20 20 20 28 6e 6f 74 20 28 6e )... (not (n
2080: 75 6c 6c 3f 20 28 63 61 61 72 20 61 6c 6c 64 61 ull? (caar allda
2090: 74 73 29 29 29 29 0a 09 09 28 66 6f 72 6d 64 61 ts))))...(formda
20a0: 74 3a 6c 6f 61 64 20 66 6f 72 6d 64 61 74 20 20 t:load formdat
20b0: 28 73 3a 70 72 6f 63 65 73 73 2d 63 67 69 2d 69 (s:process-cgi-i
20c0: 6e 70 75 74 20 28 63 61 61 61 72 20 61 6c 6c 64 nput (caaar alld
20d0: 61 74 73 29 29 29 29 29 20 3b 3b 20 6d 75 6e 67 ats))))) ;; mung
20e0: 65 64 29 29 0a 09 3b 3b 09 09 20 20 20 20 28 66 ed))..;;.. (f
20f0: 6f 72 6d 61 74 20 64 65 62 75 67 70 20 22 66 6f ormat debugp "fo
2100: 72 6d 64 61 74 20 3a 20 6e 61 6d 65 3a 20 7e 41 rmdat : name: ~A
2110: 20 63 6f 6e 74 65 6e 74 3a 20 7e 41 5c 6e 22 20 content: ~A\n"
2120: 6e 61 6d 65 20 63 6f 6e 74 65 6e 74 29 0a 09 28 name content)..(
2130: 69 66 20 64 65 62 75 67 70 20 28 63 6c 6f 73 65 if debugp (close
2140: 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 64 65 62 -output-port deb
2150: 75 67 70 29 29 0a 09 66 6f 72 6d 64 61 74 29 29 ugp))..formdat))
2160: 29 29 0a 09 09 0a 23 7c 0a 28 64 65 66 69 6e 65 ))....#|.(define
2170: 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 inp (open-input
2180: 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 78 61 -file "tests/exa
2190: 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 29 0a mple.post.in")).
21a0: 28 64 65 66 69 6e 65 20 64 61 74 20 28 72 65 61 (define dat (rea
21b0: 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 29 d-string #f inp)
21c0: 29 0a 28 64 65 66 69 6e 65 20 64 61 74 73 74 72 ).(define datstr
21d0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 (open-input-str
21e0: 69 6e 67 20 64 61 74 29 29 0a 0a 3b 3b 20 6f 72 ing dat))..;; or
21f0: 0a 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 28 6f ..(define inp (o
2200: 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 pen-input-file "
2210: 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 6f tests/example.po
2220: 73 74 2e 62 69 6e 61 72 79 2e 69 6e 22 29 29 0a st.binary.in")).
2230: 28 64 65 66 69 6e 65 20 64 61 74 20 28 72 65 61 (define dat (rea
2240: 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 29 d-string #f inp)
2250: 29 0a 28 64 65 66 69 6e 65 20 64 61 74 73 74 72 ).(define datstr
2260: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 (open-input-str
2270: 69 6e 67 20 64 61 74 29 29 0a 0a 28 66 6f 72 6d ing dat))..(form
2280: 64 61 74 3a 72 65 61 64 2d 68 65 61 64 65 72 20 dat:read-header
2290: 64 61 74 73 74 72 29 0a 0a 28 64 65 66 69 6e 65 datstr)..(define
22a0: 20 64 61 74 20 28 66 6f 72 6d 64 61 74 3a 64 61 dat (formdat:da
22b0: 74 2d 3e 6c 69 73 74 20 69 6e 70 20 31 30 65 36 t->list inp 10e6
22c0: 29 29 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d )).(close-input-
22d0: 70 6f 72 74 20 69 6e 70 29 0a 7c 23 0a 20 20 0a port inp).|#. .
22e0: 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 (define (formdat
22f0: 3a 65 78 74 72 61 63 74 2d 68 65 61 64 65 72 2d :extract-header-
2300: 69 6e 66 6f 20 68 65 61 64 65 72 29 0a 20 20 28 info header). (
2310: 69 66 20 28 6e 75 6c 6c 3f 20 68 65 61 64 65 72 if (null? header
2320: 29 0a 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 ). '().
2330: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 (let loop ((he
2340: 64 20 28 63 61 72 20 68 65 61 64 65 72 29 29 0a d (car header)).
2350: 09 09 20 28 74 61 6c 20 28 63 64 72 20 68 65 61 .. (tal (cdr hea
2360: 64 65 72 29 29 0a 09 09 20 28 72 65 73 20 27 28 der))... (res '(
2370: 29 29 29 0a 09 28 69 66 20 28 73 74 72 69 6e 67 )))..(if (string
2380: 2d 6d 61 74 63 68 20 66 6f 72 6d 64 61 74 3a 62 -match formdat:b
2390: 69 6e 2d 64 61 74 61 2d 64 69 73 70 2d 72 65 78 in-data-disp-rex
23a0: 20 68 65 64 29 20 3b 3b 20 0a 09 20 20 20 20 28 hed) ;; .. (
23b0: 6c 65 74 2a 20 28 28 64 61 74 61 2d 6e 61 6d 65 let* ((data-name
23c0: 6d 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 m (string-match
23d0: 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 61 74 61 formdat:bin-data
23e0: 2d 6e 61 6d 65 2d 72 65 78 20 68 65 64 29 29 0a -name-rex hed)).
23f0: 09 09 20 20 20 28 66 69 6c 65 2d 6e 61 6d 65 6d .. (file-namem
2400: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 66 (string-match f
2410: 6f 72 6d 64 61 74 3a 62 69 6e 2d 66 69 6c 65 2d ormdat:bin-file-
2420: 6e 61 6d 65 2d 72 65 78 20 68 65 64 29 29 0a 09 name-rex hed))..
2430: 09 20 20 20 28 64 61 74 61 2d 6e 61 6d 65 20 20 . (data-name
2440: 28 69 66 20 64 61 74 61 2d 6e 61 6d 65 6d 20 28 (if data-namem (
2450: 63 61 64 72 20 64 61 74 61 2d 6e 61 6d 65 6d 29 cadr data-namem)
2460: 20 23 66 29 29 0a 09 09 20 20 20 28 74 68 69 73 #f))... (this
2470: 20 20 20 20 20 20 20 28 69 66 20 66 69 6c 65 2d (if file-
2480: 6e 61 6d 65 6d 0a 09 09 09 09 20 20 20 28 6c 69 namem..... (li
2490: 73 74 20 28 6c 69 73 74 20 27 6e 61 6d 65 20 64 st (list 'name d
24a0: 61 74 61 2d 6e 61 6d 65 29 28 6c 69 73 74 20 27 ata-name)(list '
24b0: 66 69 6c 65 6e 61 6d 65 20 28 63 61 64 72 20 66 filename (cadr f
24c0: 69 6c 65 2d 6e 61 6d 65 6d 29 29 29 0a 09 09 09 ile-namem)))....
24d0: 09 20 20 20 28 6c 69 73 74 20 28 6c 69 73 74 20 . (list (list
24e0: 27 6e 61 6d 65 20 64 61 74 61 2d 6e 61 6d 65 29 'name data-name)
24f0: 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 )))).. (if
2500: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 (null? tal)...
2510: 28 61 70 70 65 6e 64 20 72 65 73 20 74 68 69 73 (append res this
2520: 29 0a 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 )... (loop (car
2530: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 61 tal)(cdr tal)(a
2540: 70 70 65 6e 64 20 72 65 73 20 74 68 69 73 29 29 ppend res this))
2550: 29 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 63 )).. (let ((c
2560: 6f 6e 74 65 6e 74 20 28 73 74 72 69 6e 67 2d 6d ontent (string-m
2570: 61 74 63 68 20 66 6f 72 6d 64 61 74 3a 62 69 6e atch formdat:bin
2580: 2d 66 69 6c 65 2d 74 79 70 65 2d 72 65 78 20 68 -file-type-rex h
2590: 65 64 29 29 29 20 3b 3b 20 74 68 69 73 20 69 73 ed))) ;; this is
25a0: 20 74 68 65 20 73 74 61 6e 7a 61 20 66 6f 72 20 the stanza for
25b0: 74 68 65 20 63 6f 6e 74 65 6e 74 20 74 79 70 65 the content type
25c0: 0a 09 20 20 20 20 20 20 28 69 66 20 63 6f 6e 74 .. (if cont
25d0: 65 6e 74 0a 09 09 20 20 28 6c 65 74 20 28 28 6e ent... (let ((n
25e0: 65 77 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 73 ewres (cons (lis
25f0: 74 20 27 63 6f 6e 74 65 6e 74 20 28 63 61 64 72 t 'content (cadr
2600: 20 63 6f 6e 74 65 6e 74 29 29 20 72 65 73 29 29 content)) res))
2610: 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e 75 6c )... (if (nul
2620: 6c 3f 20 74 61 6c 29 0a 09 09 09 6e 65 77 72 65 l? tal)....newre
2630: 73 0a 09 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 s....(loop (car
2640: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
2650: 77 72 65 73 29 29 29 0a 09 09 20 20 28 69 66 20 wres)))... (if
2660: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 (null? tal)...
2670: 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 20 20 res...
2680: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
2690: 63 64 72 20 74 61 6c 29 20 72 65 73 29 0a 09 09 cdr tal) res)...
26a0: 20 20 20 20 20 20 29 29 29 29 29 29 29 0a 0a 3b )))))))..;
26b0: 3b 09 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f ;. (let loo
26c0: 70 20 28 28 6c 20 20 20 20 20 20 20 28 72 65 61 p ((l (rea
26d0: 64 2d 6c 69 6e 65 29 29 20 3b 3b 20 28 69 66 20 d-line)) ;; (if
26e0: 28 65 71 3f 20 6d 6f 64 65 20 27 6e 6f 72 6d 29 (eq? mode 'norm)
26f0: 28 72 65 61 64 2d 6c 69 6e 65 29 28 72 65 61 64 (read-line)(read
2700: 2d 63 68 61 72 29 29 29 0a 3b 3b 09 09 09 20 28 -char))).;;... (
2710: 65 6e 64 6c 69 6e 65 20 23 66 29 0a 3b 3b 09 09 endline #f).;;..
2720: 09 20 28 6e 75 6d 20 20 20 20 20 30 29 29 0a 3b . (num 0)).;
2730: 3b 09 09 3b 3b 20 28 66 6f 72 6d 61 74 20 64 65 ;..;; (format de
2740: 62 75 67 70 20 22 7e 41 5c 6e 22 20 6c 29 0a 3b bugp "~A\n" l).;
2750: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ; (
2760: 69 66 20 28 6f 72 20 28 6e 6f 74 20 28 65 6f 66 if (or (not (eof
2770: 2d 6f 62 6a 65 63 74 3f 20 6c 29 29 0a 3b 3b 09 -object? l)).;;.
2780: 09 20 20 20 20 20 20 28 6e 6f 74 20 28 61 6e 64 . (not (and
2790: 20 28 65 71 3f 20 6d 6f 64 65 20 27 62 69 6e 29 (eq? mode 'bin)
27a0: 0a 3b 3b 09 09 09 09 28 73 74 72 69 6e 67 3d 3f .;;....(string=?
27b0: 20 6c 20 22 22 29 29 29 29 20 3b 3b 20 69 66 20 l "")))) ;; if
27c0: 69 6e 20 62 69 6e 20 6d 6f 64 65 20 65 6d 70 74 in bin mode empt
27d0: 79 20 73 74 72 69 6e 67 20 69 73 20 65 6e 64 20 y string is end
27e0: 6f 66 20 66 69 6c 65 0a 3b 3b 09 09 20 20 28 63 of file.;;.. (c
27f0: 61 73 65 20 6d 6f 64 65 0a 3b 3b 09 09 20 20 20 ase mode.;;..
2800: 20 28 28 73 74 61 72 74 29 0a 3b 3b 09 09 20 20 ((start).;;..
2810: 20 20 20 28 73 65 74 21 20 6d 6f 64 65 20 27 6e (set! mode 'n
2820: 6f 72 6d 29 0a 3b 3b 09 09 20 20 20 20 20 28 69 orm).;;.. (i
2830: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
2840: 64 65 6c 69 6d 2d 70 61 74 74 2d 72 65 78 20 6c delim-patt-rex l
2850: 29 0a 3b 3b 09 09 09 20 28 62 65 67 69 6e 0a 3b ).;;... (begin.;
2860: 3b 09 09 09 20 20 20 28 73 65 74 21 20 64 65 6c ;... (set! del
2870: 69 6d 2d 73 74 72 69 6e 67 20 6c 29 0a 3b 3b 09 im-string l).;;.
2880: 09 09 20 20 20 28 73 65 74 21 20 64 65 6c 69 6d .. (set! delim
2890: 2d 6c 65 6e 20 20 20 20 28 73 74 72 69 6e 67 2d -len (string-
28a0: 6c 65 6e 67 74 68 20 6c 29 29 0a 3b 3b 09 09 09 length l)).;;...
28b0: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l
28c0: 69 6e 65 29 20 23 66 20 30 29 29 0a 3b 3b 09 09 ine) #f 0)).;;..
28d0: 09 20 28 6c 6f 6f 70 20 6c 20 23 66 20 30 29 29 . (loop l #f 0))
28e0: 29 0a 3b 3b 09 09 20 20 20 20 28 28 6e 6f 72 6d ).;;.. ((norm
28f0: 29 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 49 20 ).;;.. ;; I
2900: 64 6f 6e 27 74 20 6c 69 6b 65 20 68 6f 77 20 74 don't like how t
2910: 68 69 73 20 67 65 74 73 20 63 68 65 63 6b 65 64 his gets checked
2920: 20 6f 6e 20 65 76 65 72 79 20 73 69 6e 67 6c 65 on every single
2930: 20 69 6e 70 75 74 2e 20 4d 75 73 74 20 62 65 20 input. Must be
2940: 61 20 62 65 74 74 65 72 20 77 61 79 2e 20 46 49 a better way. FI
2950: 58 4d 45 0a 3b 3b 09 09 20 20 20 20 20 28 69 66 XME.;;.. (if
2960: 20 28 61 6e 64 20 28 73 74 72 69 6e 67 2d 6d 61 (and (string-ma
2970: 74 63 68 20 62 69 6e 2d 64 61 74 61 2d 64 69 73 tch bin-data-dis
2980: 70 2d 72 65 78 20 6c 29 0a 3b 3b 09 09 09 20 20 p-rex l).;;...
2990: 20 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (string-matc
29a0: 68 20 62 69 6e 2d 64 61 74 61 2d 6e 61 6d 65 2d h bin-data-name-
29b0: 72 65 78 20 6c 29 0a 3b 3b 09 09 09 20 20 20 20 rex l).;;...
29c0: 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 (string-match
29d0: 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d 72 65 bin-file-name-re
29e0: 78 20 6c 29 29 0a 3b 3b 09 09 09 20 28 62 65 67 x l)).;;... (beg
29f0: 69 6e 0a 3b 3b 09 09 09 20 20 20 28 73 65 74 21 in.;;... (set!
2a00: 20 64 61 74 61 2d 6e 61 6d 65 20 28 63 61 64 72 data-name (cadr
2a10: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 (string-match b
2a20: 69 6e 2d 64 61 74 61 2d 6e 61 6d 65 2d 72 65 78 in-data-name-rex
2a30: 20 6c 29 29 29 0a 3b 3b 09 09 09 20 20 20 28 73 l))).;;... (s
2a40: 65 74 21 20 66 69 6c 65 2d 6e 61 6d 65 20 28 63 et! file-name (c
2a50: 61 64 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 adr (string-matc
2a60: 68 20 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d h bin-file-name-
2a70: 72 65 78 20 6c 29 29 29 0a 3b 3b 09 09 09 20 20 rex l))).;;...
2a80: 20 28 73 65 74 21 20 6d 6f 64 65 20 27 63 6f 6e (set! mode 'con
2a90: 74 65 6e 74 29 0a 3b 3b 09 09 09 20 20 20 28 6c tent).;;... (l
2aa0: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 20 oop (read-line)
2ab0: 23 66 20 6e 75 6d 29 29 29 0a 3b 3b 09 09 20 20 #f num))).;;..
2ac0: 20 20 20 28 6c 65 74 2a 20 28 28 64 61 74 20 20 (let* ((dat
2ad0: 28 73 3a 70 72 6f 63 65 73 73 2d 63 67 69 2d 69 (s:process-cgi-i
2ae0: 6e 70 75 74 20 6c 29 29 29 20 3b 3b 20 28 43 47 nput l))) ;; (CG
2af0: 49 3a 75 72 6c 2d 75 6e 71 75 6f 74 65 20 6c 29 I:url-unquote l)
2b00: 29 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 66 6f ).;;.. (fo
2b10: 72 6d 61 74 20 64 65 62 75 67 70 20 22 50 52 4f rmat debugp "PRO
2b20: 43 45 53 53 2d 43 47 49 2d 49 4e 50 55 54 3a 20 CESS-CGI-INPUT:
2b30: 7e 41 5c 6e 22 20 28 69 6e 74 65 72 73 70 65 72 ~A\n" (intersper
2b40: 73 65 20 64 61 74 20 22 2c 22 29 29 0a 3b 3b 09 se dat ",")).;;.
2b50: 09 20 20 20 20 20 20 20 28 66 6f 72 6d 64 61 74 . (formdat
2b60: 3a 6c 6f 61 64 20 66 6f 72 6d 64 61 74 20 64 61 :load formdat da
2b70: 74 29 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 6c t).;;.. (l
2b80: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 20 oop (read-line)
2b90: 23 66 20 6e 75 6d 29 29 29 0a 3b 3b 09 09 20 20 #f num))).;;..
2ba0: 20 20 28 28 63 6f 6e 74 65 6e 74 29 0a 3b 3b 09 ((content).;;.
2bb0: 09 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e . (if (strin
2bc0: 67 2d 6d 61 74 63 68 20 62 69 6e 2d 66 69 6c 65 g-match bin-file
2bd0: 2d 74 79 70 65 2d 72 65 78 20 6c 29 0a 3b 3b 09 -type-rex l).;;.
2be0: 09 09 20 28 62 65 67 69 6e 20 0a 3b 3b 09 09 09 .. (begin .;;...
2bf0: 20 20 20 28 73 65 74 21 20 6d 6f 64 65 20 27 62 (set! mode 'b
2c00: 69 6e 29 0a 3b 3b 09 09 09 20 20 20 28 73 65 74 in).;;... (set
2c10: 21 20 64 61 74 61 2d 74 79 70 65 20 28 63 61 64 ! data-type (cad
2c20: 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 r (string-match
2c30: 62 69 6e 2d 66 69 6c 65 2d 74 79 70 65 2d 72 65 bin-file-type-re
2c40: 78 20 6c 29 29 29 0a 3b 3b 09 09 09 20 20 20 28 x l))).;;... (
2c50: 6c 6f 6f 70 20 28 72 65 61 64 2d 73 74 72 69 6e loop (read-strin
2c60: 67 20 31 29 20 23 66 20 6e 75 6d 29 29 29 29 0a g 1) #f num)))).
2c70: 3b 3b 09 09 20 20 20 20 28 28 62 69 6e 29 0a 3b ;;.. ((bin).;
2c80: 3b 09 09 20 20 20 20 20 3b 3b 20 64 65 6c 69 6d ;.. ;; delim
2c90: 2d 73 74 72 69 6e 67 3a 20 5c 6e 22 2d 2d 2d 2d -string: \n"----
2ca0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 31 32 33 34 35 -----------12345
2cb0: 22 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 20 20 ".;;.. ;;
2cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 30 0
2cd0: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
2ce0: 37 38 39 30 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 7890.;;.. ;;
2cf0: 20 65 6e 64 6c 69 6e 65 3a 20 20 20 20 20 20 20 endline:
2d00: 20 22 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d "--------------
2d10: 2d 31 32 22 0a 3b 3b 09 09 20 20 20 20 20 3b 3b -12".;;.. ;;
2d20: 20 6c 20 3d 20 22 33 22 0a 3b 3b 09 09 20 20 20 l = "3".;;..
2d30: 20 20 3b 3b 20 64 65 6c 69 6d 2d 6c 65 6e 20 3d ;; delim-len =
2d40: 20 32 30 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 20.;;.. ;;
2d50: 28 73 75 62 73 74 72 69 6e 67 20 20 22 2d 2d 2d (substring "---
2d60: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 31 32 33 34 ------------1234
2d70: 35 22 20 31 37 20 31 38 29 20 3d 3e 20 22 33 22 5" 17 18) => "3"
2d80: 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 0a 3b 3b 09 .;;.. ;;.;;.
2d90: 09 20 20 20 20 20 28 63 6f 6e 64 0a 3b 3b 09 09 . (cond.;;..
2da0: 20 20 20 20 20 20 20 3b 3b 20 68 61 76 65 6e 27 ;; haven'
2db0: 74 20 66 6f 75 6e 64 20 74 68 65 20 73 74 61 72 t found the star
2dc0: 74 20 6f 66 20 61 6e 20 65 6e 64 6c 69 6e 65 2c t of an endline,
2dd0: 20 69 73 20 74 68 65 20 6e 65 78 74 20 63 68 61 is the next cha
2de0: 72 20 61 20 6e 65 77 6c 69 6e 65 3f 0a 3b 3b 09 r a newline?.;;.
2df0: 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 6e 6f . ((and (no
2e00: 74 20 65 6e 64 6c 69 6e 65 29 0a 3b 3b 09 09 09 t endline).;;...
2e10: 20 20 20 20 28 73 74 72 69 6e 67 3d 3f 20 6c 20 (string=? l
2e20: 22 5c 6e 22 29 29 20 3b 3b 20 72 65 71 75 69 72 "\n")) ;; requir
2e30: 65 64 20 66 69 72 73 74 20 63 68 61 72 61 63 74 ed first charact
2e40: 65 72 20 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 er .;;.. (
2e50: 6c 65 74 20 28 28 6e 65 77 65 6e 64 6c 69 6e 65 let ((newendline
2e60: 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 73 74 (open-output-st
2e70: 72 69 6e 67 29 29 29 0a 3b 3b 09 09 09 20 3b 3b ring))).;;... ;;
2e80: 20 28 77 72 69 74 65 2d 6c 69 6e 65 20 6c 20 6e (write-line l n
2e90: 65 77 65 6e 64 6c 69 6e 65 29 20 3b 3b 20 64 69 ewendline) ;; di
2ea0: 73 63 61 72 64 20 74 68 65 20 6e 65 77 6c 69 6e scard the newlin
2eb0: 65 2e 20 61 64 64 20 69 74 20 62 61 63 6b 20 69 e. add it back i
2ec0: 66 20 64 6f 6e 27 74 20 68 61 76 65 20 61 20 6c f don't have a l
2ed0: 6f 63 6b 20 6f 6e 20 64 65 6c 69 6d 2d 73 74 72 ock on delim-str
2ee0: 69 6e 67 0a 3b 3b 09 09 09 20 28 6c 6f 6f 70 20 ing.;;... (loop
2ef0: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 29 20 (read-string 1)
2f00: 6e 65 77 65 6e 64 6c 69 6e 65 20 28 2b 20 6e 75 newendline (+ nu
2f10: 6d 20 31 29 29 29 29 0a 3b 3b 09 09 20 20 20 20 m 1)))).;;..
2f20: 20 20 28 28 6e 6f 74 20 65 6e 64 6c 69 6e 65 29 ((not endline)
2f30: 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 77 72 69 .;;.. (wri
2f40: 74 65 2d 73 74 72 69 6e 67 20 6c 20 23 66 20 62 te-string l #f b
2f50: 69 6e 2d 64 61 74 29 0a 3b 3b 09 09 20 20 20 20 in-dat).;;..
2f60: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 73 (loop (read-s
2f70: 74 72 69 6e 67 20 31 29 20 23 66 20 28 2b 20 6e tring 1) #f (+ n
2f80: 75 6d 20 31 29 29 29 0a 3b 3b 09 09 20 20 20 20 um 1))).;;..
2f90: 20 20 3b 3b 20 73 74 72 69 6e 67 20 73 6f 20 66 ;; string so f
2fa0: 61 72 20 6d 61 74 63 68 65 73 20 64 65 6c 69 6d ar matches delim
2fb0: 2d 73 74 72 69 6e 67 0a 3b 3b 09 09 20 20 20 20 -string.;;..
2fc0: 20 20 28 65 6e 64 6c 69 6e 65 0a 3b 3b 09 09 20 (endline.;;..
2fd0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 65 6e (let* ((en
2fe0: 64 73 74 72 20 28 67 65 74 2d 6f 75 74 70 75 74 dstr (get-output
2ff0: 2d 73 74 72 69 6e 67 20 65 6e 64 6c 69 6e 65 29 -string endline)
3000: 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 28 65 6e ).;;... (en
3010: 64 6c 65 6e 20 28 73 74 72 69 6e 67 2d 6c 65 6e dlen (string-len
3020: 67 74 68 20 65 6e 64 73 74 72 29 29 29 0a 3b 3b gth endstr))).;;
3030: 09 09 09 20 28 69 66 20 28 3e 20 65 6e 64 6c 65 ... (if (> endle
3040: 6e 20 30 29 0a 3b 3b 09 09 09 20 20 20 20 20 28 n 0).;;... (
3050: 66 6f 72 6d 61 74 20 64 65 62 75 67 70 20 22 20 format debugp "
3060: 64 65 6c 69 6d 3a 20 7e 41 5c 6e 65 6e 64 73 74 delim: ~A\nendst
3070: 72 3a 20 7e 41 5c 6e 22 20 64 65 6c 69 6d 2d 73 r: ~A\n" delim-s
3080: 74 72 69 6e 67 20 65 6e 64 73 74 72 29 29 0a 3b tring endstr)).;
3090: 3b 09 09 09 20 28 69 66 20 28 61 6e 64 20 28 3e ;... (if (and (>
30a0: 20 64 65 6c 69 6d 2d 6c 65 6e 20 65 6e 64 6c 65 delim-len endle
30b0: 6e 29 0a 3b 3b 09 09 09 09 20 20 28 73 74 72 69 n).;;.... (stri
30c0: 6e 67 3d 3f 20 6c 20 28 73 75 62 73 74 72 69 6e ng=? l (substrin
30d0: 67 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 20 65 g delim-string e
30e0: 6e 64 6c 65 6e 20 28 2b 20 65 6e 64 6c 65 6e 20 ndlen (+ endlen
30f0: 31 29 29 29 29 0a 3b 3b 09 09 09 20 20 20 20 20 1)))).;;...
3100: 3b 3b 20 79 65 73 2c 20 74 68 69 73 20 63 68 61 ;; yes, this cha
3110: 72 61 63 74 65 72 20 6d 61 74 63 68 65 73 20 74 racter matches t
3120: 68 65 20 6e 65 78 74 20 69 6e 20 74 68 65 20 64 he next in the d
3130: 65 6c 69 6d 2d 73 74 72 69 6e 67 0a 3b 3b 09 09 elim-string.;;..
3140: 09 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 64 . (if (eq? d
3150: 65 6c 69 6d 2d 6c 65 6e 20 65 6e 64 6c 65 6e 29 elim-len endlen)
3160: 20 3b 3b 20 68 61 76 65 20 61 20 6d 61 74 63 68 ;; have a match
3170: 21 20 49 67 6e 6f 72 65 20 74 68 61 74 20 61 20 ! Ignore that a
3180: 6e 65 77 6c 69 6e 65 20 69 73 20 72 65 71 75 69 newline is requi
3190: 72 65 64 2e 20 4c 61 7a 79 20 62 75 67 67 65 72 red. Lazy bugger
31a0: 2e 0a 3b 3b 09 09 09 09 20 28 6c 65 74 2a 20 28 ..;;.... (let* (
31b0: 28 66 6e 20 20 20 20 20 20 28 73 74 72 69 6e 67 (fn (string
31c0: 2d 3e 73 79 6d 62 6f 6c 20 64 61 74 61 2d 6e 61 ->symbol data-na
31d0: 6d 65 29 29 29 0a 3b 3b 09 09 09 09 20 20 20 28 me))).;;.... (
31e0: 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 66 6f 72 formdat:set! for
31f0: 6d 64 61 74 20 66 6e 20 28 6c 69 73 74 20 66 69 mdat fn (list fi
3200: 6c 65 2d 6e 61 6d 65 20 64 61 74 61 2d 74 79 70 le-name data-typ
3210: 65 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 e (string->blob
3220: 28 67 65 74 2d 6f 75 74 70 75 74 2d 73 74 72 69 (get-output-stri
3230: 6e 67 20 62 69 6e 2d 64 61 74 29 29 29 29 0a 3b ng bin-dat)))).;
3240: 3b 09 09 09 09 20 20 20 28 73 65 74 21 20 6d 6f ;.... (set! mo
3250: 64 65 20 27 6e 6f 72 6d 29 0a 3b 3b 09 09 09 09 de 'norm).;;....
3260: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l
3270: 69 6e 65 29 20 23 66 20 30 29 29 0a 3b 3b 09 09 ine) #f 0)).;;..
3280: 09 09 20 28 62 65 67 69 6e 0a 3b 3b 09 09 09 09 .. (begin.;;....
3290: 20 20 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 (write-string
32a0: 20 6c 20 23 66 20 65 6e 64 6c 69 6e 65 29 0a 3b l #f endline).;
32b0: 3b 09 09 09 09 20 20 20 28 6c 6f 6f 70 20 28 72 ;.... (loop (r
32c0: 65 61 64 2d 73 74 72 69 6e 67 20 31 29 20 65 6e ead-string 1) en
32d0: 64 6c 69 6e 65 20 28 2b 20 6e 75 6d 20 31 29 29 dline (+ num 1))
32e0: 29 29 0a 3b 3b 09 09 09 20 20 20 20 20 3b 3b 20 )).;;... ;;
32f0: 6e 6f 2c 20 74 68 69 73 20 63 68 61 72 61 63 74 no, this charact
3300: 65 72 20 64 6f 65 73 20 4e 4f 54 20 6d 61 74 63 er does NOT matc
3310: 68 20 74 68 65 20 6e 65 78 74 20 69 6e 20 6c 69 h the next in li
3320: 6e 65 20 69 6e 20 64 65 6c 69 6d 2d 73 74 72 69 ne in delim-stri
3330: 6e 67 0a 3b 3b 09 09 09 20 20 20 20 20 28 62 65 ng.;;... (be
3340: 67 69 6e 0a 3b 3b 09 09 09 20 20 20 20 20 20 20 gin.;;...
3350: 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 22 5c (write-string "\
3360: 6e 22 20 23 66 20 62 69 6e 2d 64 61 74 29 20 3b n" #f bin-dat) ;
3370: 3b 20 64 6f 6e 27 74 20 66 6f 72 67 65 74 20 74 ; don't forget t
3380: 68 61 74 20 6e 65 77 6c 69 6e 65 20 77 65 20 64 hat newline we d
3390: 72 6f 70 70 65 64 0a 3b 3b 09 09 09 20 20 20 20 ropped.;;...
33a0: 20 20 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 (write-string
33b0: 20 65 6e 64 73 74 72 20 23 66 20 62 69 6e 2d 64 endstr #f bin-d
33c0: 61 74 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 20 at).;;...
33d0: 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 6c 20 (write-string l
33e0: 23 66 20 62 69 6e 2d 64 61 74 29 0a 3b 3b 09 09 #f bin-dat).;;..
33f0: 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 . (loop (r
3400: 65 61 64 2d 73 74 72 69 6e 67 20 31 29 20 23 66 ead-string 1) #f
3410: 20 28 2b 20 6e 75 6d 20 31 29 29 29 29 29 29 29 (+ num 1)))))))
3420: 29 0a 3b 3b 09 09 20 20 20 20 29 29 29 29 29 0a ).;;.. ))))).
3430: 0a 3b 3b 20 20 20 20 28 66 6f 72 6d 64 61 74 3a .;; (formdat:
3440: 70 72 69 6e 74 61 6c 6c 20 66 6f 72 6d 64 61 74 printall formdat
3450: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 77 72 69 (lambda (x)(wri
3460: 74 65 2d 6c 69 6e 65 20 78 20 64 65 62 75 67 70 te-line x debugp
3470: 29 29 29 0a 0a 23 7c 0a 28 64 65 66 69 6e 65 20 )))..#|.(define
3480: 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d inp (open-input-
3490: 66 69 6c 65 20 22 2f 74 6d 70 2f 73 74 6d 6c 72 file "/tmp/stmlr
34a0: 75 6e 2f 64 65 6c 6d 65 2d 33 33 2e 6c 6f 67 2e un/delme-33.log.
34b0: 6b 65 65 70 2d 66 6f 72 2d 72 65 66 22 29 29 0a keep-for-ref")).
34c0: 28 64 65 66 69 6e 65 20 64 61 74 20 28 72 65 61 (define dat (rea
34d0: 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e 70 29 d-string #f inp)
34e0: 29 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 ).(close-input-p
34f0: 6f 72 74 20 69 6e 70 29 0a 7c 23 0a ort inp).|#.