Artifact
5b06a4d3e09710a62035548081fdf190fb715639:
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 74 72 69 6e 67 2d 73 65 61 72 63 68 x (string-search
0d00: 2d 70 6f 73 69 74 69 6f 6e 73 20 6b 65 79 20 64 -positions key d
0d10: 61 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f at))). (if (o
0d20: 72 20 28 6e 6f 74 20 69 6e 64 65 78 29 0a 09 20 r (not index)..
0d30: 20 20 20 28 6e 75 6c 6c 3f 20 69 6e 64 65 78 29 (null? index)
0d40: 29 20 3b 3b 20 74 68 65 20 6b 65 79 20 77 61 73 ) ;; the key was
0d50: 20 6e 6f 74 20 66 6f 75 6e 64 0a 09 23 66 0a 09 not found..#f..
0d60: 28 6c 65 74 2a 20 28 28 64 61 74 73 74 72 20 28 (let* ((datstr (
0d70: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
0d80: 67 20 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 g dat))..
0d90: 28 72 65 73 75 6c 74 20 28 72 65 61 64 2d 73 74 (result (read-st
0da0: 72 69 6e 67 20 28 63 61 61 72 20 69 6e 64 65 78 ring (caar index
0db0: 29 20 64 61 74 73 74 72 29 29 0a 09 20 20 20 20 ) datstr))..
0dc0: 20 20 20 28 72 65 6d 64 61 74 20 28 72 65 61 64 (remdat (read
0dd0: 2d 73 74 72 69 6e 67 20 23 66 20 64 61 74 73 74 -string #f datst
0de0: 72 29 29 29 0a 09 20 20 28 63 6c 6f 73 65 2d 69 r))).. (close-i
0df0: 6e 70 75 74 2d 70 6f 72 74 20 64 61 74 73 74 72 nput-port datstr
0e00: 29 0a 09 20 20 28 6c 69 73 74 20 72 65 73 75 6c ).. (list resul
0e10: 74 20 72 65 6d 64 61 74 29 29 29 29 29 0a 0a 20 t remdat)))))..
0e20: 3b 3b 20 69 6e 70 20 69 73 20 70 6f 72 74 20 74 ;; inp is port t
0e30: 6f 20 72 65 61 64 20 64 61 74 61 20 66 72 6f 6d o read data from
0e40: 2c 20 6d 61 78 73 69 7a 65 20 69 73 20 6d 61 78 , maxsize is max
0e50: 20 64 61 74 61 20 61 6c 6c 6f 77 65 64 20 74 6f data allowed to
0e60: 20 72 65 61 64 20 28 74 6f 74 61 6c 29 0a 28 64 read (total).(d
0e70: 65 66 69 6e 65 20 28 66 6f 72 6d 64 61 74 3a 64 efine (formdat:d
0e80: 61 74 2d 3e 6c 69 73 74 20 69 6e 70 20 6d 61 78 at->list inp max
0e90: 73 69 7a 65 29 0a 20 20 3b 3b 20 72 65 61 64 20 size). ;; read
0ea0: 31 4d 65 67 20 63 68 75 6e 6b 73 20 66 72 6f 6d 1Meg chunks from
0eb0: 20 74 68 65 20 69 6e 70 75 74 20 70 6f 72 74 2e the input port.
0ec0: 20 49 66 20 61 20 62 6c 6f 63 6b 20 69 73 20 6e If a block is n
0ed0: 6f 74 20 63 6f 6d 70 6c 65 74 65 0a 20 20 3b 3b ot complete. ;;
0ee0: 20 74 61 63 6b 20 6f 6e 20 74 68 65 20 6e 65 78 tack on the nex
0ef0: 74 20 31 4d 65 67 20 63 68 75 6e 6b 20 61 73 20 t 1Meg chunk as
0f00: 6e 65 65 64 65 64 2e 20 53 65 74 20 75 70 20 73 needed. Set up s
0f10: 6f 20 74 68 65 20 68 65 61 64 65 72 20 69 73 20 o the header is
0f20: 61 6c 77 61 79 73 0a 20 20 3b 3b 20 61 74 20 74 always. ;; at t
0f30: 68 65 20 62 65 67 69 6e 6e 69 6e 67 20 6f 66 20 he beginning of
0f40: 74 68 65 20 63 68 75 6e 6b 0a 20 20 3b 3b 2d 2d the chunk. ;;--
0f50: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0f60: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 32 39 39 33 32 -----------29932
0f70: 30 32 34 34 31 31 35 30 32 33 32 33 33 33 32 31 0244115023233321
0f80: 33 36 32 31 34 39 37 33 0a 20 20 3b 3b 43 6f 6e 36214973. ;;Con
0f90: 74 65 6e 74 2d 44 69 73 70 6f 73 69 74 69 6f 6e tent-Disposition
0fa0: 3a 20 66 6f 72 6d 2d 64 61 74 61 3b 20 6e 61 6d : form-data; nam
0fb0: 65 3d 22 69 6e 70 75 74 2d 70 69 63 74 75 72 65 e="input-picture
0fc0: 22 3b 20 66 69 6c 65 6e 61 6d 65 3d 22 62 72 65 "; filename="bre
0fd0: 61 64 66 72 75 69 74 2e 6a 70 67 22 0a 20 20 3b adfruit.jpg". ;
0fe0: 3b 43 6f 6e 74 65 6e 74 2d 54 79 70 65 3a 20 69 ;Content-Type: i
0ff0: 6d 61 67 65 2f 6a 70 65 67 0a 20 20 28 6c 65 74 mage/jpeg. (let
1000: 20 6c 6f 6f 70 20 28 28 64 61 74 20 28 72 65 61 loop ((dat (rea
1010: 64 2d 73 74 72 69 6e 67 20 31 30 30 30 30 30 30 d-string 1000000
1020: 20 69 6e 70 29 29 0a 09 20 20 20 20 20 28 72 65 inp)).. (re
1030: 73 20 27 28 29 29 0a 09 20 20 20 20 20 28 73 69 s '()).. (si
1040: 7a 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 3e z 0)). (if (>
1050: 20 73 69 7a 20 6d 61 78 73 69 7a 65 29 0a 09 28 siz maxsize)..(
1060: 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 begin.. (print
1070: 22 44 41 54 41 20 54 4f 4f 20 42 49 47 22 29 0a "DATA TOO BIG").
1080: 09 20 20 72 65 73 29 0a 09 28 6c 65 74 2a 20 28 . res)..(let* (
1090: 28 64 61 74 73 74 72 20 28 6f 70 65 6e 2d 69 6e (datstr (open-in
10a0: 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 29 29 put-string dat))
10b0: 0a 09 20 20 20 20 20 20 20 28 68 65 61 64 65 72 .. (header
10c0: 20 28 66 6f 72 6d 64 61 74 3a 72 65 61 64 2d 68 (formdat:read-h
10d0: 65 61 64 65 72 20 64 61 74 73 74 72 29 29 0a 09 eader datstr))..
10e0: 20 20 20 20 20 20 20 28 6b 65 79 20 20 20 20 28 (key (
10f0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 68 if (not (null? h
1100: 65 61 64 65 72 29 29 28 63 61 72 20 68 65 61 64 eader))(car head
1110: 65 72 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 er) #f))..
1120: 20 28 72 65 6d 64 61 74 20 28 72 65 61 64 2d 73 (remdat (read-s
1130: 74 72 69 6e 67 20 23 66 20 64 61 74 73 74 72 29 tring #f datstr)
1140: 29 20 20 20 20 20 20 20 20 20 20 3b 3b 20 75 73 ) ;; us
1150: 65 64 20 69 6e 20 6e 65 78 74 20 6c 69 6e 65 2c ed in next line,
1160: 20 64 69 73 63 61 72 64 20 69 66 20 67 6f 74 20 discard if got
1170: 64 61 74 61 2c 20 65 6c 73 65 20 72 65 76 65 72 data, else rever
1180: 74 20 74 6f 0a 09 20 20 20 20 20 20 20 28 61 6c t to.. (al
1190: 6c 64 61 74 20 28 69 66 20 6b 65 79 20 28 66 6f ldat (if key (fo
11a0: 72 6d 64 61 74 3a 72 65 61 64 2d 64 61 74 20 72 rmdat:read-dat r
11b0: 65 6d 64 61 74 20 6b 65 79 29 20 23 66 29 29 20 emdat key) #f))
11c0: 20 20 20 3b 3b 20 74 72 79 20 74 6f 20 65 78 74 ;; try to ext
11d0: 72 61 63 74 20 74 68 65 20 64 61 74 61 0a 09 20 ract the data..
11e0: 20 20 20 20 20 20 28 74 68 73 64 61 74 20 28 69 (thsdat (i
11f0: 66 20 61 6c 6c 64 61 74 20 28 63 61 72 20 61 6c f alldat (car al
1200: 6c 64 61 74 29 20 20 23 66 29 29 20 20 20 20 20 ldat) #f))
1210: 3b 3b 20 74 68 65 20 64 61 74 61 0a 09 20 20 20 ;; the data..
1220: 20 20 20 20 28 6e 65 77 64 61 74 20 28 69 66 20 (newdat (if
1230: 61 6c 6c 64 61 74 20 28 63 61 64 72 20 61 6c 6c alldat (cadr all
1240: 64 61 74 29 20 23 66 29 29 20 20 20 20 20 3b 3b dat) #f)) ;;
1250: 20 6c 65 66 74 20 6f 76 65 72 20 64 61 74 61 2c left over data,
1260: 20 6d 75 73 74 20 70 72 6f 63 65 73 73 20 2e 2e must process ..
1270: 2e 0a 09 20 20 20 20 20 20 20 28 74 68 73 72 65 ... (thsre
1280: 73 20 28 6c 69 73 74 20 68 65 61 64 65 72 20 74 s (list header t
1290: 68 73 64 61 74 29 29 20 20 20 20 20 20 20 20 20 hsdat))
12a0: 20 20 20 20 3b 3b 20 73 70 65 63 75 6c 61 74 69 ;; speculati
12b0: 76 65 6c 79 20 63 6f 6e 73 74 72 75 63 74 20 72 vely construct r
12c0: 65 73 75 6c 74 73 0a 09 20 20 20 20 20 20 20 28 esults.. (
12d0: 6e 65 77 72 65 73 20 28 61 70 70 65 6e 64 20 72 newres (append r
12e0: 65 73 20 28 6c 69 73 74 20 74 68 73 72 65 73 29 es (list thsres)
12f0: 29 29 29 20 20 20 20 20 20 3b 3b 20 73 70 65 63 ))) ;; spec
1300: 75 6c 61 74 69 76 65 6c 79 20 63 6f 6e 73 74 72 ulatively constr
1310: 75 63 74 20 72 65 73 75 6c 74 73 0a 09 20 20 28 uct results.. (
1320: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
1330: 20 64 61 74 73 74 72 29 0a 09 20 20 28 63 6f 6e datstr).. (con
1340: 64 0a 09 20 20 20 3b 3b 20 65 69 74 68 65 72 20 d.. ;; either
1350: 6e 6f 20 68 65 61 64 65 72 20 6f 72 20 73 69 6e no header or sin
1360: 67 6c 65 20 69 6e 70 75 74 0a 09 20 20 20 28 28 gle input.. ((
1370: 61 6e 64 20 28 6e 6f 74 20 61 6c 6c 64 61 74 29 and (not alldat)
1380: 0a 09 09 20 28 6f 72 20 28 6e 75 6c 6c 3f 20 68 ... (or (null? h
1390: 65 61 64 65 72 29 0a 09 09 20 20 20 20 20 28 6e eader)... (n
13a0: 6f 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 ot (string-match
13b0: 20 66 6f 72 6d 64 61 74 3a 64 65 6c 69 6d 2d 70 formdat:delim-p
13c0: 61 74 74 2d 72 65 78 20 28 63 61 72 20 68 65 61 att-rex (car hea
13d0: 64 65 72 29 29 29 29 29 0a 09 20 20 20 20 3b 3b der))))).. ;;
13e0: 20 28 70 72 69 6e 74 20 22 47 6f 74 20 68 65 72 (print "Got her
13f0: 65 22 29 0a 09 20 20 20 20 28 63 6f 6e 73 20 28 e").. (cons (
1400: 6c 69 73 74 20 68 65 61 64 65 72 20 22 22 29 20 list header "")
1410: 72 65 73 29 29 20 3b 3b 20 6e 6f 74 65 20 75 73 res)) ;; note us
1420: 65 20 68 65 61 64 65 72 20 61 73 20 64 61 74 20 e header as dat
1430: 61 6e 64 20 75 73 65 20 22 22 20 61 73 20 68 65 and use "" as he
1440: 61 64 65 72 3f 3f 3f 3f 0a 09 20 20 20 3b 3b 20 ader????.. ;;
1450: 64 69 64 6e 27 74 20 66 69 6e 64 20 65 6e 64 20 didn't find end
1460: 6b 65 79 20 69 6e 20 74 68 69 73 20 62 6c 6f 63 key in this bloc
1470: 6b 0a 09 20 20 20 28 28 6e 6f 74 20 61 6c 6c 64 k.. ((not alld
1480: 61 74 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 at).. (let ((
1490: 6d 6f 72 64 61 74 20 28 72 65 61 64 2d 73 74 72 mordat (read-str
14a0: 69 6e 67 20 31 30 30 30 30 30 30 20 69 6e 70 29 ing 1000000 inp)
14b0: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 73 )).. (if (s
14c0: 74 72 69 6e 67 3d 3f 20 6d 6f 72 64 61 74 20 22 tring=? mordat "
14d0: 22 29 20 3b 3b 20 74 68 65 72 65 20 69 73 20 6e ") ;; there is n
14e0: 6f 20 6d 6f 72 65 20 64 61 74 61 2c 20 64 69 73 o more data, dis
14f0: 63 61 72 64 20 72 65 73 75 6c 74 73 20 61 6e 64 card results and
1500: 20 75 73 65 20 72 65 6d 64 61 74 20 61 73 20 64 use remdat as d
1510: 61 74 61 2c 20 74 68 69 73 20 69 6e 70 75 74 20 ata, this input
1520: 69 73 20 62 72 6f 6b 65 6e 0a 09 09 20 20 28 63 is broken... (c
1530: 6f 6e 73 20 28 6c 69 73 74 20 68 65 61 64 65 72 ons (list header
1540: 20 72 65 6d 64 61 74 29 20 72 65 73 29 0a 09 09 remdat) res)...
1550: 20 20 28 6c 6f 6f 70 20 28 73 74 72 69 6e 67 2d (loop (string-
1560: 61 70 70 65 6e 64 20 64 61 74 20 6d 6f 72 64 61 append dat morda
1570: 74 29 20 72 65 73 20 28 2b 20 73 69 7a 20 32 30 t) res (+ siz 20
1580: 30 30 30 30 30 29 29 29 29 29 20 3b 3b 20 61 64 00000))))) ;; ad
1590: 64 20 74 68 65 20 65 78 74 72 61 20 31 30 30 30 d the extra 1000
15a0: 30 30 30 0a 09 20 20 20 28 61 6c 6c 64 61 74 20 000.. (alldat
15b0: 3b 3b 20 67 6f 74 20 64 61 74 61 2c 20 64 6f 6e ;; got data, don
15c0: 27 74 20 61 74 74 65 6d 70 74 20 74 6f 20 63 68 't attempt to ch
15d0: 65 63 6b 20 69 66 20 74 68 65 72 65 20 69 73 20 eck if there is
15e0: 6d 6f 72 65 2c 20 6a 75 73 74 20 6c 6f 6f 70 20 more, just loop
15f0: 61 6e 64 20 72 65 6c 79 20 6f 6e 20 28 6e 6f 74 and rely on (not
1600: 20 61 6c 6c 64 61 74 29 20 74 6f 20 67 65 74 20 alldat) to get
1610: 6d 6f 72 65 20 64 61 74 61 0a 09 20 20 20 20 28 more data.. (
1620: 6c 6f 6f 70 20 6e 65 77 64 61 74 20 6e 65 77 72 loop newdat newr
1630: 65 73 20 28 2b 20 73 69 7a 20 31 30 30 30 30 30 es (+ siz 100000
1640: 30 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 0))))))))..(defi
1650: 6e 65 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 ne formdat:bin-d
1660: 61 74 61 2d 64 69 73 70 2d 72 65 78 20 28 72 65 ata-disp-rex (re
1670: 67 65 78 70 20 22 5e 43 6f 6e 74 65 6e 74 2d 44 gexp "^Content-D
1680: 69 73 70 6f 73 69 74 69 6f 6e 3a 5c 5c 73 2b 66 isposition:\\s+f
1690: 6f 72 6d 2d 64 61 74 61 3b 22 29 29 0a 28 64 65 orm-data;")).(de
16a0: 66 69 6e 65 20 66 6f 72 6d 64 61 74 3a 62 69 6e fine formdat:bin
16b0: 2d 64 61 74 61 2d 6e 61 6d 65 2d 72 65 78 20 28 -data-name-rex (
16c0: 72 65 67 65 78 70 20 22 5c 5c 57 6e 61 6d 65 3d regexp "\\Wname=
16d0: 5c 22 28 5b 5e 5c 22 5d 2b 29 5c 22 22 29 29 0a \"([^\"]+)\"")).
16e0: 28 64 65 66 69 6e 65 20 66 6f 72 6d 64 61 74 3a (define formdat:
16f0: 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d 72 65 bin-file-name-re
1700: 78 20 28 72 65 67 65 78 70 20 22 5c 5c 57 66 69 x (regexp "\\Wfi
1710: 6c 65 6e 61 6d 65 3d 5c 22 28 5b 5e 5c 22 5d 2b lename=\"([^\"]+
1720: 29 5c 22 22 29 29 0a 28 64 65 66 69 6e 65 20 66 )\"")).(define f
1730: 6f 72 6d 64 61 74 3a 62 69 6e 2d 66 69 6c 65 2d ormdat:bin-file-
1740: 74 79 70 65 2d 72 65 78 20 28 72 65 67 65 78 70 type-rex (regexp
1750: 20 22 43 6f 6e 74 65 6e 74 2d 54 79 70 65 3a 5c "Content-Type:\
1760: 5c 73 2b 28 5b 5e 5c 5c 73 5d 2b 29 22 29 29 0a \s+([^\\s]+)")).
1770: 28 64 65 66 69 6e 65 20 66 6f 72 6d 64 61 74 3a (define formdat:
1780: 64 65 6c 69 6d 2d 70 61 74 74 2d 72 65 78 20 20 delim-patt-rex
1790: 20 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 2d 2b (regexp "^\\-+
17a0: 5b 30 2d 39 5d 2b 5c 5c 2d 2a 24 22 29 29 0a 0a [0-9]+\\-*$"))..
17b0: 3b 3b 20 72 65 74 75 72 6e 73 20 61 20 68 61 73 ;; returns a has
17c0: 68 20 77 69 74 68 20 65 6e 74 72 69 65 73 20 66 h with entries f
17d0: 6f 72 20 61 6c 6c 20 66 6f 72 6d 73 20 2d 20 63 or all forms - c
17e0: 6f 75 6c 64 20 77 65 6c 6c 20 75 73 65 20 61 20 ould well use a
17f0: 70 72 6f 70 6c 69 73 74 3f 0a 28 64 65 66 69 6e proplist?.(defin
1800: 65 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d e (formdat:load-
1810: 61 6c 6c 29 0a 20 20 28 6c 65 74 20 28 28 72 65 all). (let ((re
1820: 71 75 65 73 74 2d 6d 65 74 68 6f 64 20 28 67 65 quest-method (ge
1830: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
1840: 72 69 61 62 6c 65 20 22 52 45 51 55 45 53 54 5f riable "REQUEST_
1850: 4d 45 54 48 4f 44 22 29 29 29 0a 20 20 20 20 28 METHOD"))). (
1860: 69 66 20 28 61 6e 64 20 72 65 71 75 65 73 74 2d if (and request-
1870: 6d 65 74 68 6f 64 0a 09 20 20 20 20 20 28 73 74 method.. (st
1880: 72 69 6e 67 3d 3f 20 72 65 71 75 65 73 74 2d 6d ring=? request-m
1890: 65 74 68 6f 64 20 22 50 4f 53 54 22 29 29 0a 09 ethod "POST"))..
18a0: 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c (formdat:load-al
18b0: 6c 2d 70 6f 72 74 20 28 63 75 72 72 65 6e 74 2d l-port (current-
18c0: 69 6e 70 75 74 2d 70 6f 72 74 29 29 29 29 29 0a input-port))))).
18d0: 0a 3b 3b 20 28 73 3a 70 72 6f 63 65 73 73 2d 63 .;; (s:process-c
18e0: 67 69 2d 69 6e 70 75 74 20 28 63 61 61 61 72 20 gi-input (caaar
18f0: 64 61 74 29 29 0a 28 64 65 66 69 6e 65 20 28 66 dat)).(define (f
1900: 6f 72 6d 64 61 74 3a 6c 6f 61 64 2d 61 6c 6c 2d ormdat:load-all-
1910: 70 6f 72 74 20 69 6e 70 29 0a 20 20 28 6c 65 74 port inp). (let
1920: 2a 20 28 28 66 6f 72 6d 64 61 74 20 20 20 20 20 * ((formdat
1930: 20 20 20 28 6d 61 6b 65 2d 66 6f 72 6d 64 61 74 (make-formdat
1940: 3a 66 6f 72 6d 64 61 74 29 29 29 0a 3b 3b 09 20 :formdat))).;;.
1950: 28 64 65 62 75 67 70 20 20 20 20 20 20 20 20 20 (debugp
1960: 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c (open-output-fil
1970: 65 20 28 63 6f 6e 63 20 28 73 6c 6f 74 2d 72 65 e (conc (slot-re
1980: 66 20 73 3a 73 65 73 73 69 6f 6e 20 27 73 72 6f f s:session 'sro
1990: 6f 74 29 20 22 2f 64 65 6c 6d 65 2d 22 20 28 63 ot) "/delme-" (c
19a0: 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 20 urrent-user-id)
19b0: 22 2e 6c 6f 67 22 29 29 29 29 0a 20 20 20 20 3b ".log")))). ;
19c0: 3b 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 ; (write-string
19d0: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 (read-string #f
19e0: 69 6e 70 29 20 23 66 20 64 65 62 75 67 70 29 0a inp) #f debugp).
19f0: 20 20 20 20 28 66 6f 72 6d 64 61 74 3a 69 6e 69 (formdat:ini
1a00: 74 69 61 6c 69 7a 65 20 66 6f 72 6d 64 61 74 29 tialize formdat)
1a10: 0a 20 20 20 20 28 6c 65 74 20 28 28 61 6c 6c 64 . (let ((alld
1a20: 61 74 73 20 28 66 6f 72 6d 64 61 74 3a 64 61 74 ats (formdat:dat
1a30: 2d 3e 6c 69 73 74 20 69 6e 70 20 31 30 65 36 29 ->list inp 10e6)
1a40: 29 29 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 )). .
1a50: 3b 3b 20 28 66 6f 72 6d 61 74 20 64 65 62 75 67 ;; (format debug
1a60: 70 20 22 66 6f 72 6d 64 61 74 20 3a 20 61 6c 6c p "formdat : all
1a70: 64 61 74 73 3a 20 7e 41 5c 6e 22 20 61 6c 6c 64 dats: ~A\n" alld
1a80: 61 74 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 ats). (let
1a90: 28 28 66 69 72 73 74 69 74 65 6d 20 20 20 28 63 ((firstitem (c
1aa0: 61 72 20 61 6c 6c 64 61 74 73 29 29 0a 09 20 20 ar alldats))..
1ab0: 20 20 28 6d 75 6c 74 69 70 61 73 73 20 23 66 29 (multipass #f)
1ac0: 29 20 0a 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 ) ..(if (not (nu
1ad0: 6c 6c 3f 20 66 69 72 73 74 69 74 65 6d 29 29 0a ll? firstitem)).
1ae0: 09 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 . (if (string
1af0: 2d 6d 61 74 63 68 20 66 6f 72 6d 64 61 74 3a 64 -match formdat:d
1b00: 65 6c 69 6d 2d 70 61 74 74 2d 72 65 78 20 28 63 elim-patt-rex (c
1b10: 61 61 72 20 66 69 72 73 74 69 74 65 6d 29 29 0a aar firstitem)).
1b20: 09 09 28 73 65 74 21 20 6d 75 6c 74 69 70 61 73 ..(set! multipas
1b30: 73 20 23 74 29 29 29 0a 09 28 69 66 20 6d 75 6c s #t)))..(if mul
1b40: 74 69 70 61 73 73 0a 09 20 20 20 20 3b 3b 20 68 tipass.. ;; h
1b50: 61 6e 64 6c 65 20 6d 75 6c 74 69 2d 70 61 72 74 andle multi-part
1b60: 20 66 6f 72 6d 0a 09 20 20 20 20 28 66 6f 72 2d form.. (for-
1b70: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 64 61 each (lambda (da
1b80: 74 6c 73 74 29 0a 09 09 09 28 6c 65 74 2a 20 28 tlst)....(let* (
1b90: 28 68 65 61 64 65 72 20 28 66 6f 72 6d 64 61 74 (header (formdat
1ba0: 3a 65 78 74 72 61 63 74 2d 68 65 61 64 65 72 2d :extract-header-
1bb0: 69 6e 66 6f 20 28 63 61 72 20 64 61 74 6c 73 74 info (car datlst
1bc0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 6e ))).... (n
1bd0: 61 6d 65 20 20 20 28 69 66 20 28 61 73 73 6f 63 ame (if (assoc
1be0: 20 27 6e 61 6d 65 20 68 65 61 64 65 72 29 0a 09 'name header)..
1bf0: 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e .... (string->
1c00: 73 79 6d 62 6f 6c 20 28 63 61 64 72 20 28 61 73 symbol (cadr (as
1c10: 73 6f 63 20 27 6e 61 6d 65 20 68 65 61 64 65 72 soc 'name header
1c20: 29 29 29 0a 09 09 09 09 09 20 20 20 22 22 29 29 )))...... ""))
1c30: 20 3b 3b 20 67 72 75 6d 62 6c 65 0a 09 09 09 20 ;; grumble....
1c40: 20 20 20 20 20 20 28 66 6e 61 6d 65 6c 20 20 28 (fnamel (
1c50: 61 73 73 6f 63 20 27 66 69 6c 65 6e 61 6d 65 20 assoc 'filename
1c60: 68 65 61 64 65 72 29 29 0a 09 09 09 20 20 20 20 header))....
1c70: 20 20 20 28 63 6f 6e 74 65 6e 74 20 28 61 73 73 (content (ass
1c80: 6f 63 20 27 63 6f 6e 74 65 6e 74 20 68 65 61 64 oc 'content head
1c90: 65 72 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 er)).... (
1ca0: 64 61 74 20 20 20 20 28 63 61 64 72 20 64 61 74 dat (cadr dat
1cb0: 6c 73 74 29 29 29 0a 09 09 09 20 20 3b 3b 20 28 lst))).... ;; (
1cc0: 70 72 69 6e 74 20 22 68 65 61 64 65 72 3a 20 22 print "header: "
1cd0: 20 68 65 61 64 65 72 20 22 20 6e 61 6d 65 3a 20 header " name:
1ce0: 22 20 6e 61 6d 65 20 22 20 66 6e 61 6d 65 6c 3a " name " fnamel:
1cf0: 20 22 20 66 6e 61 6d 65 6c 20 22 20 63 6f 6e 74 " fnamel " cont
1d00: 65 6e 74 3a 20 22 20 63 6f 6e 74 65 6e 74 29 20 ent: " content)
1d10: 3b 3b 20 20 22 20 64 61 74 3a 20 22 20 28 64 61 ;; " dat: " (da
1d20: 74 29 0a 09 09 09 20 20 28 66 6f 72 6d 64 61 74 t).... (formdat
1d30: 3a 73 65 74 21 20 66 6f 72 6d 64 61 74 20 0a 09 :set! formdat ..
1d40: 09 09 09 09 6e 61 6d 65 0a 09 09 09 09 09 28 69 ....name......(i
1d50: 66 20 66 6e 61 6d 65 6c 20 0a 09 09 09 09 09 20 f fnamel ......
1d60: 20 20 20 28 6c 69 73 74 20 28 63 61 64 72 20 66 (list (cadr f
1d70: 6e 61 6d 65 6c 29 0a 09 09 09 09 09 09 20 20 28 namel)....... (
1d80: 69 66 20 63 6f 6e 74 65 6e 74 0a 09 09 09 09 09 if content......
1d90: 09 20 20 20 20 20 20 28 63 61 64 72 20 63 6f 6e . (cadr con
1da0: 74 65 6e 74 29 0a 09 09 09 09 09 09 20 20 20 20 tent).......
1db0: 20 20 22 75 6e 6b 6e 6f 77 6e 22 29 0a 09 09 09 "unknown")....
1dc0: 09 09 09 20 20 28 73 74 72 69 6e 67 2d 3e 62 6c ... (string->bl
1dd0: 6f 62 20 64 61 74 29 29 0a 09 09 09 09 09 20 20 ob dat))......
1de0: 20 20 64 61 74 29 29 29 29 0a 09 09 20 20 20 20 dat))))...
1df0: 20 20 61 6c 6c 64 61 74 73 29 0a 09 20 20 20 20 alldats)..
1e00: 3b 3b 20 68 61 6e 64 6c 65 20 73 69 6e 67 6c 65 ;; handle single
1e10: 20 70 61 72 74 20 66 6f 72 6d 0a 09 20 20 20 20 part form..
1e20: 3b 3b 20 09 28 69 66 20 28 61 6e 64 20 28 73 74 ;; .(if (and (st
1e30: 72 69 6e 67 3f 20 6e 61 6d 65 29 0a 09 20 20 20 ring? name)..
1e40: 20 3b 3b 20 09 09 20 20 20 20 20 28 73 74 72 69 ;; .. (stri
1e50: 6e 67 3d 3f 20 6e 61 6d 65 20 22 22 29 29 20 3b ng=? name "")) ;
1e60: 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 73 68 ; this is the sh
1e70: 6f 72 74 20 66 6f 72 6d 20 69 6e 70 75 74 20 49 ort form input I
1e80: 20 67 75 65 73 73 0a 09 20 20 20 20 3b 3b 20 09 guess.. ;; .
1e90: 09 28 6c 65 74 2a 20 28 28 64 61 74 73 74 72 20 .(let* ((datstr
1ea0: 28 63 61 61 72 20 64 61 74 6c 73 74 29 29 0a 09 (caar datlst))..
1eb0: 20 20 20 20 3b 3b 20 09 09 20 20 20 20 20 20 20 ;; ..
1ec0: 28 6d 75 6e 67 65 64 20 28 73 3a 70 72 6f 63 65 (munged (s:proce
1ed0: 73 73 2d 63 67 69 2d 69 6e 70 75 74 20 64 61 74 ss-cgi-input dat
1ee0: 73 74 72 29 29 29 0a 09 20 20 20 20 3b 3b 20 09 str))).. ;; .
1ef0: 09 20 20 28 70 72 69 6e 74 20 22 64 61 74 73 74 . (print "datst
1f00: 72 3a 20 22 20 64 61 74 73 74 72 20 22 20 6d 75 r: " datstr " mu
1f10: 6e 67 65 64 3a 20 22 20 6d 75 6e 67 65 64 29 0a nged: " munged).
1f20: 09 20 20 20 20 28 66 6f 72 6d 64 61 74 3a 6c 6f . (formdat:lo
1f30: 61 64 20 66 6f 72 6d 64 61 74 20 20 28 73 3a 70 ad formdat (s:p
1f40: 72 6f 63 65 73 73 2d 63 67 69 2d 69 6e 70 75 74 rocess-cgi-input
1f50: 20 28 63 61 61 61 72 20 61 6c 6c 64 61 74 73 29 (caaar alldats)
1f60: 29 29 29 20 3b 3b 20 6d 75 6e 67 65 64 29 29 0a ))) ;; munged)).
1f70: 09 3b 3b 09 09 20 20 20 20 28 66 6f 72 6d 61 74 .;;.. (format
1f80: 20 64 65 62 75 67 70 20 22 66 6f 72 6d 64 61 74 debugp "formdat
1f90: 20 3a 20 6e 61 6d 65 3a 20 7e 41 20 63 6f 6e 74 : name: ~A cont
1fa0: 65 6e 74 3a 20 7e 41 5c 6e 22 20 6e 61 6d 65 20 ent: ~A\n" name
1fb0: 63 6f 6e 74 65 6e 74 29 0a 09 3b 3b 20 28 63 6c content)..;; (cl
1fc0: 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 ose-output-port
1fd0: 64 65 62 75 67 70 29 0a 09 66 6f 72 6d 64 61 74 debugp)..formdat
1fe0: 29 29 29 29 0a 09 09 0a 23 7c 0a 28 64 65 66 69 ))))....#|.(defi
1ff0: 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 ne inp (open-inp
2000: 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 ut-file "tests/e
2010: 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 69 6e 22 29 xample.post.in")
2020: 29 0a 28 64 65 66 69 6e 65 20 64 61 74 20 28 72 ).(define dat (r
2030: 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e ead-string #f in
2040: 70 29 29 0a 28 64 65 66 69 6e 65 20 64 61 74 73 p)).(define dats
2050: 74 72 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 tr (open-input-s
2060: 74 72 69 6e 67 20 64 61 74 29 29 0a 0a 3b 3b 20 tring dat))..;;
2070: 6f 72 0a 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 or..(define inp
2080: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 (open-input-file
2090: 20 22 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e "tests/example.
20a0: 70 6f 73 74 2e 62 69 6e 61 72 79 2e 69 6e 22 29 post.binary.in")
20b0: 29 0a 28 64 65 66 69 6e 65 20 64 61 74 20 28 72 ).(define dat (r
20c0: 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e ead-string #f in
20d0: 70 29 29 0a 28 64 65 66 69 6e 65 20 64 61 74 73 p)).(define dats
20e0: 74 72 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 tr (open-input-s
20f0: 74 72 69 6e 67 20 64 61 74 29 29 0a 0a 28 66 6f tring dat))..(fo
2100: 72 6d 64 61 74 3a 72 65 61 64 2d 68 65 61 64 65 rmdat:read-heade
2110: 72 20 64 61 74 73 74 72 29 0a 0a 28 64 65 66 69 r datstr)..(defi
2120: 6e 65 20 64 61 74 20 28 66 6f 72 6d 64 61 74 3a ne dat (formdat:
2130: 64 61 74 2d 3e 6c 69 73 74 20 69 6e 70 20 31 30 dat->list inp 10
2140: 65 36 29 29 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 e6)).(close-inpu
2150: 74 2d 70 6f 72 74 20 69 6e 70 29 0a 7c 23 0a 20 t-port inp).|#.
2160: 20 0a 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 64 .(define (formd
2170: 61 74 3a 65 78 74 72 61 63 74 2d 68 65 61 64 65 at:extract-heade
2180: 72 2d 69 6e 66 6f 20 68 65 61 64 65 72 29 0a 20 r-info header).
2190: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 68 65 61 64 (if (null? head
21a0: 65 72 29 0a 20 20 20 20 20 20 27 28 29 0a 20 20 er). '().
21b0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
21c0: 68 65 64 20 28 63 61 72 20 68 65 61 64 65 72 29 hed (car header)
21d0: 29 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 68 )... (tal (cdr h
21e0: 65 61 64 65 72 29 29 0a 09 09 20 28 72 65 73 20 eader))... (res
21f0: 27 28 29 29 29 0a 09 28 69 66 20 28 73 74 72 69 '()))..(if (stri
2200: 6e 67 2d 6d 61 74 63 68 20 66 6f 72 6d 64 61 74 ng-match formdat
2210: 3a 62 69 6e 2d 64 61 74 61 2d 64 69 73 70 2d 72 :bin-data-disp-r
2220: 65 78 20 68 65 64 29 20 3b 3b 20 0a 09 20 20 20 ex hed) ;; ..
2230: 20 28 6c 65 74 2a 20 28 28 64 61 74 61 2d 6e 61 (let* ((data-na
2240: 6d 65 6d 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 mem (string-matc
2250: 68 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 61 h formdat:bin-da
2260: 74 61 2d 6e 61 6d 65 2d 72 65 78 20 68 65 64 29 ta-name-rex hed)
2270: 29 0a 09 09 20 20 20 28 66 69 6c 65 2d 6e 61 6d )... (file-nam
2280: 65 6d 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 em (string-match
2290: 20 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 66 69 6c formdat:bin-fil
22a0: 65 2d 6e 61 6d 65 2d 72 65 78 20 68 65 64 29 29 e-name-rex hed))
22b0: 0a 09 09 20 20 20 28 64 61 74 61 2d 6e 61 6d 65 ... (data-name
22c0: 20 20 28 69 66 20 64 61 74 61 2d 6e 61 6d 65 6d (if data-namem
22d0: 20 28 63 61 64 72 20 64 61 74 61 2d 6e 61 6d 65 (cadr data-name
22e0: 6d 29 20 23 66 29 29 0a 09 09 20 20 20 28 74 68 m) #f))... (th
22f0: 69 73 20 20 20 20 20 20 20 28 69 66 20 66 69 6c is (if fil
2300: 65 2d 6e 61 6d 65 6d 0a 09 09 09 09 20 20 20 28 e-namem..... (
2310: 6c 69 73 74 20 28 6c 69 73 74 20 27 6e 61 6d 65 list (list 'name
2320: 20 64 61 74 61 2d 6e 61 6d 65 29 28 6c 69 73 74 data-name)(list
2330: 20 27 66 69 6c 65 6e 61 6d 65 20 28 63 61 64 72 'filename (cadr
2340: 20 66 69 6c 65 2d 6e 61 6d 65 6d 29 29 29 0a 09 file-namem)))..
2350: 09 09 09 20 20 20 28 6c 69 73 74 20 28 6c 69 73 ... (list (lis
2360: 74 20 27 6e 61 6d 65 20 64 61 74 61 2d 6e 61 6d t 'name data-nam
2370: 65 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 e))))).. (i
2380: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
2390: 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 74 68 (append res th
23a0: 69 73 29 0a 09 09 20 20 28 6c 6f 6f 70 20 28 63 is)... (loop (c
23b0: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
23c0: 28 61 70 70 65 6e 64 20 72 65 73 20 74 68 69 73 (append res this
23d0: 29 29 29 29 0a 09 20 20 20 20 28 6c 65 74 20 28 )))).. (let (
23e0: 28 63 6f 6e 74 65 6e 74 20 28 73 74 72 69 6e 67 (content (string
23f0: 2d 6d 61 74 63 68 20 66 6f 72 6d 64 61 74 3a 62 -match formdat:b
2400: 69 6e 2d 66 69 6c 65 2d 74 79 70 65 2d 72 65 78 in-file-type-rex
2410: 20 68 65 64 29 29 29 20 3b 3b 20 74 68 69 73 20 hed))) ;; this
2420: 69 73 20 74 68 65 20 73 74 61 6e 7a 61 20 66 6f is the stanza fo
2430: 72 20 74 68 65 20 63 6f 6e 74 65 6e 74 20 74 79 r the content ty
2440: 70 65 0a 09 20 20 20 20 20 20 28 69 66 20 63 6f pe.. (if co
2450: 6e 74 65 6e 74 0a 09 09 20 20 28 6c 65 74 20 28 ntent... (let (
2460: 28 6e 65 77 72 65 73 20 28 63 6f 6e 73 20 28 6c (newres (cons (l
2470: 69 73 74 20 27 63 6f 6e 74 65 6e 74 20 28 63 61 ist 'content (ca
2480: 64 72 20 63 6f 6e 74 65 6e 74 29 29 20 72 65 73 dr content)) res
2490: 29 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e )))... (if (n
24a0: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 6e 65 77 ull? tal)....new
24b0: 72 65 73 0a 09 09 09 28 6c 6f 6f 70 20 28 63 61 res....(loop (ca
24c0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
24d0: 6e 65 77 72 65 73 29 29 29 0a 09 09 20 20 28 69 newres)))... (i
24e0: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
24f0: 20 20 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 res...
2500: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
2510: 29 28 63 64 72 20 74 61 6c 29 20 72 65 73 29 0a )(cdr tal) res).
2520: 09 09 20 20 20 20 20 20 29 29 29 29 29 29 29 0a .. ))))))).
2530: 0a 3b 3b 09 20 20 20 20 20 20 28 6c 65 74 20 6c .;;. (let l
2540: 6f 6f 70 20 28 28 6c 20 20 20 20 20 20 20 28 72 oop ((l (r
2550: 65 61 64 2d 6c 69 6e 65 29 29 20 3b 3b 20 28 69 ead-line)) ;; (i
2560: 66 20 28 65 71 3f 20 6d 6f 64 65 20 27 6e 6f 72 f (eq? mode 'nor
2570: 6d 29 28 72 65 61 64 2d 6c 69 6e 65 29 28 72 65 m)(read-line)(re
2580: 61 64 2d 63 68 61 72 29 29 29 0a 3b 3b 09 09 09 ad-char))).;;...
2590: 20 28 65 6e 64 6c 69 6e 65 20 23 66 29 0a 3b 3b (endline #f).;;
25a0: 09 09 09 20 28 6e 75 6d 20 20 20 20 20 30 29 29 ... (num 0))
25b0: 0a 3b 3b 09 09 3b 3b 20 28 66 6f 72 6d 61 74 20 .;;..;; (format
25c0: 64 65 62 75 67 70 20 22 7e 41 5c 6e 22 20 6c 29 debugp "~A\n" l)
25d0: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
25e0: 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 28 65 (if (or (not (e
25f0: 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 29 29 0a 3b of-object? l)).;
2600: 3b 09 09 20 20 20 20 20 20 28 6e 6f 74 20 28 61 ;.. (not (a
2610: 6e 64 20 28 65 71 3f 20 6d 6f 64 65 20 27 62 69 nd (eq? mode 'bi
2620: 6e 29 0a 3b 3b 09 09 09 09 28 73 74 72 69 6e 67 n).;;....(string
2630: 3d 3f 20 6c 20 22 22 29 29 29 29 20 3b 3b 20 69 =? l "")))) ;; i
2640: 66 20 69 6e 20 62 69 6e 20 6d 6f 64 65 20 65 6d f in bin mode em
2650: 70 74 79 20 73 74 72 69 6e 67 20 69 73 20 65 6e pty string is en
2660: 64 20 6f 66 20 66 69 6c 65 0a 3b 3b 09 09 20 20 d of file.;;..
2670: 28 63 61 73 65 20 6d 6f 64 65 0a 3b 3b 09 09 20 (case mode.;;..
2680: 20 20 20 28 28 73 74 61 72 74 29 0a 3b 3b 09 09 ((start).;;..
2690: 20 20 20 20 20 28 73 65 74 21 20 6d 6f 64 65 20 (set! mode
26a0: 27 6e 6f 72 6d 29 0a 3b 3b 09 09 20 20 20 20 20 'norm).;;..
26b0: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
26c0: 68 20 64 65 6c 69 6d 2d 70 61 74 74 2d 72 65 78 h delim-patt-rex
26d0: 20 6c 29 0a 3b 3b 09 09 09 20 28 62 65 67 69 6e l).;;... (begin
26e0: 0a 3b 3b 09 09 09 20 20 20 28 73 65 74 21 20 64 .;;... (set! d
26f0: 65 6c 69 6d 2d 73 74 72 69 6e 67 20 6c 29 0a 3b elim-string l).;
2700: 3b 09 09 09 20 20 20 28 73 65 74 21 20 64 65 6c ;... (set! del
2710: 69 6d 2d 6c 65 6e 20 20 20 20 28 73 74 72 69 6e im-len (strin
2720: 67 2d 6c 65 6e 67 74 68 20 6c 29 29 0a 3b 3b 09 g-length l)).;;.
2730: 09 09 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 .. (loop (read
2740: 2d 6c 69 6e 65 29 20 23 66 20 30 29 29 0a 3b 3b -line) #f 0)).;;
2750: 09 09 09 20 28 6c 6f 6f 70 20 6c 20 23 66 20 30 ... (loop l #f 0
2760: 29 29 29 0a 3b 3b 09 09 20 20 20 20 28 28 6e 6f ))).;;.. ((no
2770: 72 6d 29 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 rm).;;.. ;;
2780: 49 20 64 6f 6e 27 74 20 6c 69 6b 65 20 68 6f 77 I don't like how
2790: 20 74 68 69 73 20 67 65 74 73 20 63 68 65 63 6b this gets check
27a0: 65 64 20 6f 6e 20 65 76 65 72 79 20 73 69 6e 67 ed on every sing
27b0: 6c 65 20 69 6e 70 75 74 2e 20 4d 75 73 74 20 62 le input. Must b
27c0: 65 20 61 20 62 65 74 74 65 72 20 77 61 79 2e 20 e a better way.
27d0: 46 49 58 4d 45 0a 3b 3b 09 09 20 20 20 20 20 28 FIXME.;;.. (
27e0: 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 2d if (and (string-
27f0: 6d 61 74 63 68 20 62 69 6e 2d 64 61 74 61 2d 64 match bin-data-d
2800: 69 73 70 2d 72 65 78 20 6c 29 0a 3b 3b 09 09 09 isp-rex l).;;...
2810: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 (string-ma
2820: 74 63 68 20 62 69 6e 2d 64 61 74 61 2d 6e 61 6d tch bin-data-nam
2830: 65 2d 72 65 78 20 6c 29 0a 3b 3b 09 09 09 20 20 e-rex l).;;...
2840: 20 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (string-matc
2850: 68 20 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d h bin-file-name-
2860: 72 65 78 20 6c 29 29 0a 3b 3b 09 09 09 20 28 62 rex l)).;;... (b
2870: 65 67 69 6e 0a 3b 3b 09 09 09 20 20 20 28 73 65 egin.;;... (se
2880: 74 21 20 64 61 74 61 2d 6e 61 6d 65 20 28 63 61 t! data-name (ca
2890: 64 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 dr (string-match
28a0: 20 62 69 6e 2d 64 61 74 61 2d 6e 61 6d 65 2d 72 bin-data-name-r
28b0: 65 78 20 6c 29 29 29 0a 3b 3b 09 09 09 20 20 20 ex l))).;;...
28c0: 28 73 65 74 21 20 66 69 6c 65 2d 6e 61 6d 65 20 (set! file-name
28d0: 28 63 61 64 72 20 28 73 74 72 69 6e 67 2d 6d 61 (cadr (string-ma
28e0: 74 63 68 20 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d tch bin-file-nam
28f0: 65 2d 72 65 78 20 6c 29 29 29 0a 3b 3b 09 09 09 e-rex l))).;;...
2900: 20 20 20 28 73 65 74 21 20 6d 6f 64 65 20 27 63 (set! mode 'c
2910: 6f 6e 74 65 6e 74 29 0a 3b 3b 09 09 09 20 20 20 ontent).;;...
2920: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line
2930: 29 20 23 66 20 6e 75 6d 29 29 29 0a 3b 3b 09 09 ) #f num))).;;..
2940: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 61 74 (let* ((dat
2950: 20 20 28 73 3a 70 72 6f 63 65 73 73 2d 63 67 69 (s:process-cgi
2960: 2d 69 6e 70 75 74 20 6c 29 29 29 20 3b 3b 20 28 -input l))) ;; (
2970: 43 47 49 3a 75 72 6c 2d 75 6e 71 75 6f 74 65 20 CGI:url-unquote
2980: 6c 29 29 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 l)).;;.. (
2990: 66 6f 72 6d 61 74 20 64 65 62 75 67 70 20 22 50 format debugp "P
29a0: 52 4f 43 45 53 53 2d 43 47 49 2d 49 4e 50 55 54 ROCESS-CGI-INPUT
29b0: 3a 20 7e 41 5c 6e 22 20 28 69 6e 74 65 72 73 70 : ~A\n" (intersp
29c0: 65 72 73 65 20 64 61 74 20 22 2c 22 29 29 0a 3b erse dat ",")).;
29d0: 3b 09 09 20 20 20 20 20 20 20 28 66 6f 72 6d 64 ;.. (formd
29e0: 61 74 3a 6c 6f 61 64 20 66 6f 72 6d 64 61 74 20 at:load formdat
29f0: 64 61 74 29 0a 3b 3b 09 09 20 20 20 20 20 20 20 dat).;;..
2a00: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line
2a10: 29 20 23 66 20 6e 75 6d 29 29 29 0a 3b 3b 09 09 ) #f num))).;;..
2a20: 20 20 20 20 28 28 63 6f 6e 74 65 6e 74 29 0a 3b ((content).;
2a30: 3b 09 09 20 20 20 20 20 28 69 66 20 28 73 74 72 ;.. (if (str
2a40: 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d 66 69 ing-match bin-fi
2a50: 6c 65 2d 74 79 70 65 2d 72 65 78 20 6c 29 0a 3b le-type-rex l).;
2a60: 3b 09 09 09 20 28 62 65 67 69 6e 20 0a 3b 3b 09 ;... (begin .;;.
2a70: 09 09 20 20 20 28 73 65 74 21 20 6d 6f 64 65 20 .. (set! mode
2a80: 27 62 69 6e 29 0a 3b 3b 09 09 09 20 20 20 28 73 'bin).;;... (s
2a90: 65 74 21 20 64 61 74 61 2d 74 79 70 65 20 28 63 et! data-type (c
2aa0: 61 64 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 adr (string-matc
2ab0: 68 20 62 69 6e 2d 66 69 6c 65 2d 74 79 70 65 2d h bin-file-type-
2ac0: 72 65 78 20 6c 29 29 29 0a 3b 3b 09 09 09 20 20 rex l))).;;...
2ad0: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 73 74 72 (loop (read-str
2ae0: 69 6e 67 20 31 29 20 23 66 20 6e 75 6d 29 29 29 ing 1) #f num)))
2af0: 29 0a 3b 3b 09 09 20 20 20 20 28 28 62 69 6e 29 ).;;.. ((bin)
2b00: 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 64 65 6c .;;.. ;; del
2b10: 69 6d 2d 73 74 72 69 6e 67 3a 20 5c 6e 22 2d 2d im-string: \n"--
2b20: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 31 32 33 -------------123
2b30: 34 35 22 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 45".;;.. ;;
2b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b50: 20 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 012345678901234
2b60: 35 36 37 38 39 30 0a 3b 3b 09 09 20 20 20 20 20 567890.;;..
2b70: 3b 3b 20 65 6e 64 6c 69 6e 65 3a 20 20 20 20 20 ;; endline:
2b80: 20 20 20 22 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d "------------
2b90: 2d 2d 2d 31 32 22 0a 3b 3b 09 09 20 20 20 20 20 ---12".;;..
2ba0: 3b 3b 20 6c 20 3d 20 22 33 22 0a 3b 3b 09 09 20 ;; l = "3".;;..
2bb0: 20 20 20 20 3b 3b 20 64 65 6c 69 6d 2d 6c 65 6e ;; delim-len
2bc0: 20 3d 20 32 30 0a 3b 3b 09 09 20 20 20 20 20 3b = 20.;;.. ;
2bd0: 3b 20 28 73 75 62 73 74 72 69 6e 67 20 20 22 2d ; (substring "-
2be0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 31 32 --------------12
2bf0: 33 34 35 22 20 31 37 20 31 38 29 20 3d 3e 20 22 345" 17 18) => "
2c00: 33 22 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 0a 3b 3".;;.. ;;.;
2c10: 3b 09 09 20 20 20 20 20 28 63 6f 6e 64 0a 3b 3b ;.. (cond.;;
2c20: 09 09 20 20 20 20 20 20 20 3b 3b 20 68 61 76 65 .. ;; have
2c30: 6e 27 74 20 66 6f 75 6e 64 20 74 68 65 20 73 74 n't found the st
2c40: 61 72 74 20 6f 66 20 61 6e 20 65 6e 64 6c 69 6e art of an endlin
2c50: 65 2c 20 69 73 20 74 68 65 20 6e 65 78 74 20 63 e, is the next c
2c60: 68 61 72 20 61 20 6e 65 77 6c 69 6e 65 3f 0a 3b har a newline?.;
2c70: 3b 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ;.. ((and (
2c80: 6e 6f 74 20 65 6e 64 6c 69 6e 65 29 0a 3b 3b 09 not endline).;;.
2c90: 09 09 20 20 20 20 28 73 74 72 69 6e 67 3d 3f 20 .. (string=?
2ca0: 6c 20 22 5c 6e 22 29 29 20 3b 3b 20 72 65 71 75 l "\n")) ;; requ
2cb0: 69 72 65 64 20 66 69 72 73 74 20 63 68 61 72 61 ired first chara
2cc0: 63 74 65 72 20 0a 3b 3b 09 09 20 20 20 20 20 20 cter .;;..
2cd0: 20 28 6c 65 74 20 28 28 6e 65 77 65 6e 64 6c 69 (let ((newendli
2ce0: 6e 65 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d ne (open-output-
2cf0: 73 74 72 69 6e 67 29 29 29 0a 3b 3b 09 09 09 20 string))).;;...
2d00: 3b 3b 20 28 77 72 69 74 65 2d 6c 69 6e 65 20 6c ;; (write-line l
2d10: 20 6e 65 77 65 6e 64 6c 69 6e 65 29 20 3b 3b 20 newendline) ;;
2d20: 64 69 73 63 61 72 64 20 74 68 65 20 6e 65 77 6c discard the newl
2d30: 69 6e 65 2e 20 61 64 64 20 69 74 20 62 61 63 6b ine. add it back
2d40: 20 69 66 20 64 6f 6e 27 74 20 68 61 76 65 20 61 if don't have a
2d50: 20 6c 6f 63 6b 20 6f 6e 20 64 65 6c 69 6d 2d 73 lock on delim-s
2d60: 74 72 69 6e 67 0a 3b 3b 09 09 09 20 28 6c 6f 6f tring.;;... (loo
2d70: 70 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 p (read-string 1
2d80: 29 20 6e 65 77 65 6e 64 6c 69 6e 65 20 28 2b 20 ) newendline (+
2d90: 6e 75 6d 20 31 29 29 29 29 0a 3b 3b 09 09 20 20 num 1)))).;;..
2da0: 20 20 20 20 28 28 6e 6f 74 20 65 6e 64 6c 69 6e ((not endlin
2db0: 65 29 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 77 e).;;.. (w
2dc0: 72 69 74 65 2d 73 74 72 69 6e 67 20 6c 20 23 66 rite-string l #f
2dd0: 20 62 69 6e 2d 64 61 74 29 0a 3b 3b 09 09 20 20 bin-dat).;;..
2de0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read
2df0: 2d 73 74 72 69 6e 67 20 31 29 20 23 66 20 28 2b -string 1) #f (+
2e00: 20 6e 75 6d 20 31 29 29 29 0a 3b 3b 09 09 20 20 num 1))).;;..
2e10: 20 20 20 20 3b 3b 20 73 74 72 69 6e 67 20 73 6f ;; string so
2e20: 20 66 61 72 20 6d 61 74 63 68 65 73 20 64 65 6c far matches del
2e30: 69 6d 2d 73 74 72 69 6e 67 0a 3b 3b 09 09 20 20 im-string.;;..
2e40: 20 20 20 20 28 65 6e 64 6c 69 6e 65 0a 3b 3b 09 (endline.;;.
2e50: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
2e60: 65 6e 64 73 74 72 20 28 67 65 74 2d 6f 75 74 70 endstr (get-outp
2e70: 75 74 2d 73 74 72 69 6e 67 20 65 6e 64 6c 69 6e ut-string endlin
2e80: 65 29 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 28 e)).;;... (
2e90: 65 6e 64 6c 65 6e 20 28 73 74 72 69 6e 67 2d 6c endlen (string-l
2ea0: 65 6e 67 74 68 20 65 6e 64 73 74 72 29 29 29 0a ength endstr))).
2eb0: 3b 3b 09 09 09 20 28 69 66 20 28 3e 20 65 6e 64 ;;... (if (> end
2ec0: 6c 65 6e 20 30 29 0a 3b 3b 09 09 09 20 20 20 20 len 0).;;...
2ed0: 20 28 66 6f 72 6d 61 74 20 64 65 62 75 67 70 20 (format debugp
2ee0: 22 20 64 65 6c 69 6d 3a 20 7e 41 5c 6e 65 6e 64 " delim: ~A\nend
2ef0: 73 74 72 3a 20 7e 41 5c 6e 22 20 64 65 6c 69 6d str: ~A\n" delim
2f00: 2d 73 74 72 69 6e 67 20 65 6e 64 73 74 72 29 29 -string endstr))
2f10: 0a 3b 3b 09 09 09 20 28 69 66 20 28 61 6e 64 20 .;;... (if (and
2f20: 28 3e 20 64 65 6c 69 6d 2d 6c 65 6e 20 65 6e 64 (> delim-len end
2f30: 6c 65 6e 29 0a 3b 3b 09 09 09 09 20 20 28 73 74 len).;;.... (st
2f40: 72 69 6e 67 3d 3f 20 6c 20 28 73 75 62 73 74 72 ring=? l (substr
2f50: 69 6e 67 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 ing delim-string
2f60: 20 65 6e 64 6c 65 6e 20 28 2b 20 65 6e 64 6c 65 endlen (+ endle
2f70: 6e 20 31 29 29 29 29 0a 3b 3b 09 09 09 20 20 20 n 1)))).;;...
2f80: 20 20 3b 3b 20 79 65 73 2c 20 74 68 69 73 20 63 ;; yes, this c
2f90: 68 61 72 61 63 74 65 72 20 6d 61 74 63 68 65 73 haracter matches
2fa0: 20 74 68 65 20 6e 65 78 74 20 69 6e 20 74 68 65 the next in the
2fb0: 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 0a 3b 3b delim-string.;;
2fc0: 09 09 09 20 20 20 20 20 28 69 66 20 28 65 71 3f ... (if (eq?
2fd0: 20 64 65 6c 69 6d 2d 6c 65 6e 20 65 6e 64 6c 65 delim-len endle
2fe0: 6e 29 20 3b 3b 20 68 61 76 65 20 61 20 6d 61 74 n) ;; have a mat
2ff0: 63 68 21 20 49 67 6e 6f 72 65 20 74 68 61 74 20 ch! Ignore that
3000: 61 20 6e 65 77 6c 69 6e 65 20 69 73 20 72 65 71 a newline is req
3010: 75 69 72 65 64 2e 20 4c 61 7a 79 20 62 75 67 67 uired. Lazy bugg
3020: 65 72 2e 0a 3b 3b 09 09 09 09 20 28 6c 65 74 2a er..;;.... (let*
3030: 20 28 28 66 6e 20 20 20 20 20 20 28 73 74 72 69 ((fn (stri
3040: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 61 74 61 2d ng->symbol data-
3050: 6e 61 6d 65 29 29 29 0a 3b 3b 09 09 09 09 20 20 name))).;;....
3060: 20 28 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 66 (formdat:set! f
3070: 6f 72 6d 64 61 74 20 66 6e 20 28 6c 69 73 74 20 ormdat fn (list
3080: 66 69 6c 65 2d 6e 61 6d 65 20 64 61 74 61 2d 74 file-name data-t
3090: 79 70 65 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f ype (string->blo
30a0: 62 20 28 67 65 74 2d 6f 75 74 70 75 74 2d 73 74 b (get-output-st
30b0: 72 69 6e 67 20 62 69 6e 2d 64 61 74 29 29 29 29 ring bin-dat))))
30c0: 0a 3b 3b 09 09 09 09 20 20 20 28 73 65 74 21 20 .;;.... (set!
30d0: 6d 6f 64 65 20 27 6e 6f 72 6d 29 0a 3b 3b 09 09 mode 'norm).;;..
30e0: 09 09 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 .. (loop (read
30f0: 2d 6c 69 6e 65 29 20 23 66 20 30 29 29 0a 3b 3b -line) #f 0)).;;
3100: 09 09 09 09 20 28 62 65 67 69 6e 0a 3b 3b 09 09 .... (begin.;;..
3110: 09 09 20 20 20 28 77 72 69 74 65 2d 73 74 72 69 .. (write-stri
3120: 6e 67 20 6c 20 23 66 20 65 6e 64 6c 69 6e 65 29 ng l #f endline)
3130: 0a 3b 3b 09 09 09 09 20 20 20 28 6c 6f 6f 70 20 .;;.... (loop
3140: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 29 20 (read-string 1)
3150: 65 6e 64 6c 69 6e 65 20 28 2b 20 6e 75 6d 20 31 endline (+ num 1
3160: 29 29 29 29 0a 3b 3b 09 09 09 20 20 20 20 20 3b )))).;;... ;
3170: 3b 20 6e 6f 2c 20 74 68 69 73 20 63 68 61 72 61 ; no, this chara
3180: 63 74 65 72 20 64 6f 65 73 20 4e 4f 54 20 6d 61 cter does NOT ma
3190: 74 63 68 20 74 68 65 20 6e 65 78 74 20 69 6e 20 tch the next in
31a0: 6c 69 6e 65 20 69 6e 20 64 65 6c 69 6d 2d 73 74 line in delim-st
31b0: 72 69 6e 67 0a 3b 3b 09 09 09 20 20 20 20 20 28 ring.;;... (
31c0: 62 65 67 69 6e 0a 3b 3b 09 09 09 20 20 20 20 20 begin.;;...
31d0: 20 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 (write-string
31e0: 22 5c 6e 22 20 23 66 20 62 69 6e 2d 64 61 74 29 "\n" #f bin-dat)
31f0: 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 67 65 74 ;; don't forget
3200: 20 74 68 61 74 20 6e 65 77 6c 69 6e 65 20 77 65 that newline we
3210: 20 64 72 6f 70 70 65 64 0a 3b 3b 09 09 09 20 20 dropped.;;...
3220: 20 20 20 20 20 28 77 72 69 74 65 2d 73 74 72 69 (write-stri
3230: 6e 67 20 65 6e 64 73 74 72 20 23 66 20 62 69 6e ng endstr #f bin
3240: 2d 64 61 74 29 0a 3b 3b 09 09 09 20 20 20 20 20 -dat).;;...
3250: 20 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 (write-string
3260: 6c 20 23 66 20 62 69 6e 2d 64 61 74 29 0a 3b 3b l #f bin-dat).;;
3270: 09 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 ... (loop
3280: 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 29 20 (read-string 1)
3290: 23 66 20 28 2b 20 6e 75 6d 20 31 29 29 29 29 29 #f (+ num 1)))))
32a0: 29 29 29 0a 3b 3b 09 09 20 20 20 20 29 29 29 29 ))).;;.. ))))
32b0: 29 0a 0a 3b 3b 20 20 20 20 28 66 6f 72 6d 64 61 )..;; (formda
32c0: 74 3a 70 72 69 6e 74 61 6c 6c 20 66 6f 72 6d 64 t:printall formd
32d0: 61 74 20 28 6c 61 6d 62 64 61 20 28 78 29 28 77 at (lambda (x)(w
32e0: 72 69 74 65 2d 6c 69 6e 65 20 78 20 64 65 62 75 rite-line x debu
32f0: 67 70 29 29 29 0a 0a 23 7c 0a 28 64 65 66 69 6e gp)))..#|.(defin
3300: 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 e inp (open-inpu
3310: 74 2d 66 69 6c 65 20 22 2f 74 6d 70 2f 73 74 6d t-file "/tmp/stm
3320: 6c 72 75 6e 2f 64 65 6c 6d 65 2d 33 33 2e 6c 6f lrun/delme-33.lo
3330: 67 2e 6b 65 65 70 2d 66 6f 72 2d 72 65 66 22 29 g.keep-for-ref")
3340: 29 0a 28 64 65 66 69 6e 65 20 64 61 74 20 28 72 ).(define dat (r
3350: 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 69 6e ead-string #f in
3360: 70 29 29 0a 28 63 6c 6f 73 65 2d 69 6e 70 75 74 p)).(close-input
3370: 2d 70 6f 72 74 20 69 6e 70 29 0a 7c 23 0a -port inp).|#.