Artifact
60d26fee898f179d10760b4ff4a3eebca2ce1037:
Unrecognized artifact
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 22 2f 74 6d 70 2f 64 65 e (conc "/tmp/de
1980: 6c 6d 65 2d 22 20 28 63 75 72 72 65 6e 74 2d 75 lme-" (current-u
1990: 73 65 72 2d 69 64 29 20 22 2e 6c 6f 67 22 29 29 ser-id) ".log"))
19a0: 29 29 0a 20 20 20 20 3b 3b 20 28 77 72 69 74 65 )). ;; (write
19b0: 2d 73 74 72 69 6e 67 20 28 72 65 61 64 2d 73 74 -string (read-st
19c0: 72 69 6e 67 20 23 66 20 69 6e 70 29 20 23 66 20 ring #f inp) #f
19d0: 64 65 62 75 67 70 29 0a 20 20 20 20 28 66 6f 72 debugp). (for
19e0: 6d 64 61 74 3a 69 6e 69 74 69 61 6c 69 7a 65 20 mdat:initialize
19f0: 66 6f 72 6d 64 61 74 29 0a 20 20 20 20 28 6c 65 formdat). (le
1a00: 74 20 28 28 61 6c 6c 64 61 74 73 20 28 66 6f 72 t ((alldats (for
1a10: 6d 64 61 74 3a 64 61 74 2d 3e 6c 69 73 74 20 69 mdat:dat->list i
1a20: 6e 70 20 31 30 65 36 29 29 29 0a 20 20 20 20 20 np 10e6))).
1a30: 20 0a 3b 3b 20 20 20 20 20 20 28 66 6f 72 6d 61 .;; (forma
1a40: 74 20 64 65 62 75 67 70 20 22 66 6f 72 6d 64 61 t debugp "formda
1a50: 74 20 3a 20 61 6c 6c 64 61 74 73 3a 20 7e 41 5c t : alldats: ~A\
1a60: 6e 22 20 61 6c 6c 64 61 74 73 29 0a 20 20 20 20 n" alldats).
1a70: 20 20 28 6c 65 74 20 28 28 66 69 72 73 74 69 74 (let ((firstit
1a80: 65 6d 20 20 20 28 63 61 72 20 61 6c 6c 64 61 74 em (car alldat
1a90: 73 29 29 0a 09 20 20 20 20 28 6d 75 6c 74 69 70 s)).. (multip
1aa0: 61 73 73 20 23 66 29 29 20 0a 09 28 69 66 20 28 ass #f)) ..(if (
1ab0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 69 72 73 74 not (null? first
1ac0: 69 74 65 6d 29 29 0a 09 20 20 20 20 28 69 66 20 item)).. (if
1ad0: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 66 6f (string-match fo
1ae0: 72 6d 64 61 74 3a 64 65 6c 69 6d 2d 70 61 74 74 rmdat:delim-patt
1af0: 2d 72 65 78 20 28 63 61 61 72 20 66 69 72 73 74 -rex (caar first
1b00: 69 74 65 6d 29 29 0a 09 09 28 73 65 74 21 20 6d item))...(set! m
1b10: 75 6c 74 69 70 61 73 73 20 23 74 29 29 29 0a 09 ultipass #t)))..
1b20: 28 69 66 20 6d 75 6c 74 69 70 61 73 73 0a 09 20 (if multipass..
1b30: 20 20 20 3b 3b 20 68 61 6e 64 6c 65 20 6d 75 6c ;; handle mul
1b40: 74 69 2d 70 61 72 74 20 66 6f 72 6d 0a 09 20 20 ti-part form..
1b50: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
1b60: 62 64 61 20 28 64 61 74 6c 73 74 29 0a 09 09 09 bda (datlst)....
1b70: 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 20 28 (let* ((header (
1b80: 66 6f 72 6d 64 61 74 3a 65 78 74 72 61 63 74 2d formdat:extract-
1b90: 68 65 61 64 65 72 2d 69 6e 66 6f 20 28 63 61 72 header-info (car
1ba0: 20 64 61 74 6c 73 74 29 29 29 0a 09 09 09 20 20 datlst)))....
1bb0: 20 20 20 20 20 28 6e 61 6d 65 20 20 20 28 69 66 (name (if
1bc0: 20 28 61 73 73 6f 63 20 27 6e 61 6d 65 20 68 65 (assoc 'name he
1bd0: 61 64 65 72 29 0a 09 09 09 09 09 20 20 20 28 73 ader)...... (s
1be0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 63 tring->symbol (c
1bf0: 61 64 72 20 28 61 73 73 6f 63 20 27 6e 61 6d 65 adr (assoc 'name
1c00: 20 68 65 61 64 65 72 29 29 29 0a 09 09 09 09 09 header)))......
1c10: 20 20 20 22 22 29 29 20 3b 3b 20 67 72 75 6d 62 "")) ;; grumb
1c20: 6c 65 0a 09 09 09 20 20 20 20 20 20 20 28 66 6e le.... (fn
1c30: 61 6d 65 6c 20 20 28 61 73 73 6f 63 20 27 66 69 amel (assoc 'fi
1c40: 6c 65 6e 61 6d 65 20 68 65 61 64 65 72 29 29 0a lename header)).
1c50: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 74 65 ... (conte
1c60: 6e 74 20 28 61 73 73 6f 63 20 27 63 6f 6e 74 65 nt (assoc 'conte
1c70: 6e 74 20 68 65 61 64 65 72 29 29 0a 09 09 09 20 nt header))....
1c80: 20 20 20 20 20 20 28 64 61 74 20 20 20 20 28 63 (dat (c
1c90: 61 64 72 20 64 61 74 6c 73 74 29 29 29 0a 09 09 adr datlst)))...
1ca0: 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 68 65 . ;; (print "he
1cb0: 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 20 22 ader: " header "
1cc0: 20 6e 61 6d 65 3a 20 22 20 6e 61 6d 65 20 22 20 name: " name "
1cd0: 66 6e 61 6d 65 6c 3a 20 22 20 66 6e 61 6d 65 6c fnamel: " fnamel
1ce0: 20 22 20 63 6f 6e 74 65 6e 74 3a 20 22 20 63 6f " content: " co
1cf0: 6e 74 65 6e 74 29 20 3b 3b 20 20 22 20 64 61 74 ntent) ;; " dat
1d00: 3a 20 22 20 28 64 61 74 29 0a 09 09 09 20 20 28 : " (dat).... (
1d10: 66 6f 72 6d 64 61 74 3a 73 65 74 21 20 66 6f 72 formdat:set! for
1d20: 6d 64 61 74 20 0a 09 09 09 09 09 6e 61 6d 65 0a mdat ......name.
1d30: 09 09 09 09 09 28 69 66 20 66 6e 61 6d 65 6c 20 .....(if fnamel
1d40: 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 ...... (list
1d50: 28 63 61 64 72 20 66 6e 61 6d 65 6c 29 0a 09 09 (cadr fnamel)...
1d60: 09 09 09 09 20 20 28 69 66 20 63 6f 6e 74 65 6e .... (if conten
1d70: 74 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 63 t....... (c
1d80: 61 64 72 20 63 6f 6e 74 65 6e 74 29 0a 09 09 09 adr content)....
1d90: 09 09 09 20 20 20 20 20 20 22 75 6e 6b 6e 6f 77 ... "unknow
1da0: 6e 22 29 0a 09 09 09 09 09 09 20 20 28 73 74 72 n")....... (str
1db0: 69 6e 67 2d 3e 62 6c 6f 62 20 64 61 74 29 29 0a ing->blob dat)).
1dc0: 09 09 09 09 09 20 20 20 20 64 61 74 29 29 29 29 ..... dat))))
1dd0: 0a 09 09 20 20 20 20 20 20 61 6c 6c 64 61 74 73 ... alldats
1de0: 29 0a 09 20 20 20 20 3b 3b 20 68 61 6e 64 6c 65 ).. ;; handle
1df0: 20 73 69 6e 67 6c 65 20 70 61 72 74 20 66 6f 72 single part for
1e00: 6d 0a 09 20 20 20 20 3b 3b 20 09 28 69 66 20 28 m.. ;; .(if (
1e10: 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 6e 61 6d and (string? nam
1e20: 65 29 0a 09 20 20 20 20 3b 3b 20 09 09 20 20 20 e).. ;; ..
1e30: 20 20 28 73 74 72 69 6e 67 3d 3f 20 6e 61 6d 65 (string=? name
1e40: 20 22 22 29 29 20 3b 3b 20 74 68 69 73 20 69 73 "")) ;; this is
1e50: 20 74 68 65 20 73 68 6f 72 74 20 66 6f 72 6d 20 the short form
1e60: 69 6e 70 75 74 20 49 20 67 75 65 73 73 0a 09 20 input I guess..
1e70: 20 20 20 3b 3b 20 09 09 28 6c 65 74 2a 20 28 28 ;; ..(let* ((
1e80: 64 61 74 73 74 72 20 28 63 61 61 72 20 64 61 74 datstr (caar dat
1e90: 6c 73 74 29 29 0a 09 20 20 20 20 3b 3b 20 09 09 lst)).. ;; ..
1ea0: 20 20 20 20 20 20 20 28 6d 75 6e 67 65 64 20 28 (munged (
1eb0: 73 3a 70 72 6f 63 65 73 73 2d 63 67 69 2d 69 6e s:process-cgi-in
1ec0: 70 75 74 20 64 61 74 73 74 72 29 29 29 0a 09 20 put datstr)))..
1ed0: 20 20 20 3b 3b 20 09 09 20 20 28 70 72 69 6e 74 ;; .. (print
1ee0: 20 22 64 61 74 73 74 72 3a 20 22 20 64 61 74 73 "datstr: " dats
1ef0: 74 72 20 22 20 6d 75 6e 67 65 64 3a 20 22 20 6d tr " munged: " m
1f00: 75 6e 67 65 64 29 0a 09 20 20 20 20 28 66 6f 72 unged).. (for
1f10: 6d 64 61 74 3a 6c 6f 61 64 20 66 6f 72 6d 64 61 mdat:load formda
1f20: 74 20 20 28 73 3a 70 72 6f 63 65 73 73 2d 63 67 t (s:process-cg
1f30: 69 2d 69 6e 70 75 74 20 28 63 61 61 61 72 20 61 i-input (caaar a
1f40: 6c 6c 64 61 74 73 29 29 29 29 20 3b 3b 20 6d 75 lldats)))) ;; mu
1f50: 6e 67 65 64 29 29 0a 09 3b 3b 09 09 20 20 20 20 nged))..;;..
1f60: 28 66 6f 72 6d 61 74 20 64 65 62 75 67 70 20 22 (format debugp "
1f70: 66 6f 72 6d 64 61 74 20 3a 20 6e 61 6d 65 3a 20 formdat : name:
1f80: 7e 41 20 63 6f 6e 74 65 6e 74 3a 20 7e 41 5c 6e ~A content: ~A\n
1f90: 22 20 6e 61 6d 65 20 63 6f 6e 74 65 6e 74 29 0a " name content).
1fa0: 09 3b 3b 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 .;; (close-outpu
1fb0: 74 2d 70 6f 72 74 20 64 65 62 75 67 70 29 0a 09 t-port debugp)..
1fc0: 66 6f 72 6d 64 61 74 29 29 29 29 0a 09 09 0a 23 formdat))))....#
1fd0: 7c 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 28 6f |.(define inp (o
1fe0: 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 pen-input-file "
1ff0: 74 65 73 74 73 2f 65 78 61 6d 70 6c 65 2e 70 6f tests/example.po
2000: 73 74 2e 69 6e 22 29 29 0a 28 64 65 66 69 6e 65 st.in")).(define
2010: 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 6e dat (read-strin
2020: 67 20 23 66 20 69 6e 70 29 29 0a 28 64 65 66 69 g #f inp)).(defi
2030: 6e 65 20 64 61 74 73 74 72 20 28 6f 70 65 6e 2d ne datstr (open-
2040: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 input-string dat
2050: 29 29 0a 0a 3b 3b 20 6f 72 0a 0a 28 64 65 66 69 ))..;; or..(defi
2060: 6e 65 20 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 ne inp (open-inp
2070: 75 74 2d 66 69 6c 65 20 22 74 65 73 74 73 2f 65 ut-file "tests/e
2080: 78 61 6d 70 6c 65 2e 70 6f 73 74 2e 62 69 6e 61 xample.post.bina
2090: 72 79 2e 69 6e 22 29 29 0a 28 64 65 66 69 6e 65 ry.in")).(define
20a0: 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 6e dat (read-strin
20b0: 67 20 23 66 20 69 6e 70 29 29 0a 28 64 65 66 69 g #f inp)).(defi
20c0: 6e 65 20 64 61 74 73 74 72 20 28 6f 70 65 6e 2d ne datstr (open-
20d0: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 64 61 74 input-string dat
20e0: 29 29 0a 0a 28 66 6f 72 6d 64 61 74 3a 72 65 61 ))..(formdat:rea
20f0: 64 2d 68 65 61 64 65 72 20 64 61 74 73 74 72 29 d-header datstr)
2100: 0a 0a 28 64 65 66 69 6e 65 20 64 61 74 20 28 66 ..(define dat (f
2110: 6f 72 6d 64 61 74 3a 64 61 74 2d 3e 6c 69 73 74 ormdat:dat->list
2120: 20 69 6e 70 20 31 30 65 36 29 29 0a 28 63 6c 6f inp 10e6)).(clo
2130: 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e se-input-port in
2140: 70 29 0a 7c 23 0a 20 20 0a 28 64 65 66 69 6e 65 p).|#. .(define
2150: 20 28 66 6f 72 6d 64 61 74 3a 65 78 74 72 61 63 (formdat:extrac
2160: 74 2d 68 65 61 64 65 72 2d 69 6e 66 6f 20 68 65 t-header-info he
2170: 61 64 65 72 29 0a 20 20 28 69 66 20 28 6e 75 6c ader). (if (nul
2180: 6c 3f 20 68 65 61 64 65 72 29 0a 20 20 20 20 20 l? header).
2190: 20 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 20 '(). (let
21a0: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
21b0: 68 65 61 64 65 72 29 29 0a 09 09 20 28 74 61 6c header))... (tal
21c0: 20 28 63 64 72 20 68 65 61 64 65 72 29 29 0a 09 (cdr header))..
21d0: 09 20 28 72 65 73 20 27 28 29 29 29 0a 09 28 69 . (res '()))..(i
21e0: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
21f0: 66 6f 72 6d 64 61 74 3a 62 69 6e 2d 64 61 74 61 formdat:bin-data
2200: 2d 64 69 73 70 2d 72 65 78 20 68 65 64 29 20 3b -disp-rex hed) ;
2210: 3b 20 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 ; .. (let* ((
2220: 64 61 74 61 2d 6e 61 6d 65 6d 20 28 73 74 72 69 data-namem (stri
2230: 6e 67 2d 6d 61 74 63 68 20 66 6f 72 6d 64 61 74 ng-match formdat
2240: 3a 62 69 6e 2d 64 61 74 61 2d 6e 61 6d 65 2d 72 :bin-data-name-r
2250: 65 78 20 68 65 64 29 29 0a 09 09 20 20 20 28 66 ex hed))... (f
2260: 69 6c 65 2d 6e 61 6d 65 6d 20 28 73 74 72 69 6e ile-namem (strin
2270: 67 2d 6d 61 74 63 68 20 66 6f 72 6d 64 61 74 3a g-match formdat:
2280: 62 69 6e 2d 66 69 6c 65 2d 6e 61 6d 65 2d 72 65 bin-file-name-re
2290: 78 20 68 65 64 29 29 0a 09 09 20 20 20 28 64 61 x hed))... (da
22a0: 74 61 2d 6e 61 6d 65 20 20 28 69 66 20 64 61 74 ta-name (if dat
22b0: 61 2d 6e 61 6d 65 6d 20 28 63 61 64 72 20 64 61 a-namem (cadr da
22c0: 74 61 2d 6e 61 6d 65 6d 29 20 23 66 29 29 0a 09 ta-namem) #f))..
22d0: 09 20 20 20 28 74 68 69 73 20 20 20 20 20 20 20 . (this
22e0: 28 69 66 20 66 69 6c 65 2d 6e 61 6d 65 6d 0a 09 (if file-namem..
22f0: 09 09 09 20 20 20 28 6c 69 73 74 20 28 6c 69 73 ... (list (lis
2300: 74 20 27 6e 61 6d 65 20 64 61 74 61 2d 6e 61 6d t 'name data-nam
2310: 65 29 28 6c 69 73 74 20 27 66 69 6c 65 6e 61 6d e)(list 'filenam
2320: 65 20 28 63 61 64 72 20 66 69 6c 65 2d 6e 61 6d e (cadr file-nam
2330: 65 6d 29 29 29 0a 09 09 09 09 20 20 20 28 6c 69 em)))..... (li
2340: 73 74 20 28 6c 69 73 74 20 27 6e 61 6d 65 20 64 st (list 'name d
2350: 61 74 61 2d 6e 61 6d 65 29 29 29 29 29 0a 09 20 ata-name)))))..
2360: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
2370: 74 61 6c 29 0a 09 09 20 20 28 61 70 70 65 6e 64 tal)... (append
2380: 20 72 65 73 20 74 68 69 73 29 0a 09 09 20 20 28 res this)... (
2390: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
23a0: 64 72 20 74 61 6c 29 28 61 70 70 65 6e 64 20 72 dr tal)(append r
23b0: 65 73 20 74 68 69 73 29 29 29 29 0a 09 20 20 20 es this))))..
23c0: 20 28 6c 65 74 20 28 28 63 6f 6e 74 65 6e 74 20 (let ((content
23d0: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 66 6f (string-match fo
23e0: 72 6d 64 61 74 3a 62 69 6e 2d 66 69 6c 65 2d 74 rmdat:bin-file-t
23f0: 79 70 65 2d 72 65 78 20 68 65 64 29 29 29 20 3b ype-rex hed))) ;
2400: 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 73 74 ; this is the st
2410: 61 6e 7a 61 20 66 6f 72 20 74 68 65 20 63 6f 6e anza for the con
2420: 74 65 6e 74 20 74 79 70 65 0a 09 20 20 20 20 20 tent type..
2430: 20 28 69 66 20 63 6f 6e 74 65 6e 74 0a 09 09 20 (if content...
2440: 20 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 28 (let ((newres (
2450: 63 6f 6e 73 20 28 6c 69 73 74 20 27 63 6f 6e 74 cons (list 'cont
2460: 65 6e 74 20 28 63 61 64 72 20 63 6f 6e 74 65 6e ent (cadr conten
2470: 74 29 29 20 72 65 73 29 29 29 0a 09 09 20 20 20 t)) res)))...
2480: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (if (null? tal)
2490: 0a 09 09 09 6e 65 77 72 65 73 0a 09 09 09 28 6c ....newres....(l
24a0: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
24b0: 72 20 74 61 6c 29 20 6e 65 77 72 65 73 29 29 29 r tal) newres)))
24c0: 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ... (if (null?
24d0: 74 61 6c 29 0a 09 09 20 20 20 20 20 20 72 65 73 tal)... res
24e0: 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop (
24f0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
2500: 29 20 72 65 73 29 0a 09 09 20 20 20 20 20 20 29 ) res)... )
2510: 29 29 29 29 29 29 0a 0a 3b 3b 09 20 20 20 20 20 ))))))..;;.
2520: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 20 20 (let loop ((l
2530: 20 20 20 20 20 28 72 65 61 64 2d 6c 69 6e 65 29 (read-line)
2540: 29 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 6d 6f ) ;; (if (eq? mo
2550: 64 65 20 27 6e 6f 72 6d 29 28 72 65 61 64 2d 6c de 'norm)(read-l
2560: 69 6e 65 29 28 72 65 61 64 2d 63 68 61 72 29 29 ine)(read-char))
2570: 29 0a 3b 3b 09 09 09 20 28 65 6e 64 6c 69 6e 65 ).;;... (endline
2580: 20 23 66 29 0a 3b 3b 09 09 09 20 28 6e 75 6d 20 #f).;;... (num
2590: 20 20 20 20 30 29 29 0a 3b 3b 09 09 3b 3b 20 28 0)).;;..;; (
25a0: 66 6f 72 6d 61 74 20 64 65 62 75 67 70 20 22 7e format debugp "~
25b0: 41 5c 6e 22 20 6c 29 0a 3b 3b 20 20 20 20 20 20 A\n" l).;;
25c0: 20 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 (if (or
25d0: 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (not (eof-object
25e0: 3f 20 6c 29 29 0a 3b 3b 09 09 20 20 20 20 20 20 ? l)).;;..
25f0: 28 6e 6f 74 20 28 61 6e 64 20 28 65 71 3f 20 6d (not (and (eq? m
2600: 6f 64 65 20 27 62 69 6e 29 0a 3b 3b 09 09 09 09 ode 'bin).;;....
2610: 28 73 74 72 69 6e 67 3d 3f 20 6c 20 22 22 29 29 (string=? l ""))
2620: 29 29 20 3b 3b 20 69 66 20 69 6e 20 62 69 6e 20 )) ;; if in bin
2630: 6d 6f 64 65 20 65 6d 70 74 79 20 73 74 72 69 6e mode empty strin
2640: 67 20 69 73 20 65 6e 64 20 6f 66 20 66 69 6c 65 g is end of file
2650: 0a 3b 3b 09 09 20 20 28 63 61 73 65 20 6d 6f 64 .;;.. (case mod
2660: 65 0a 3b 3b 09 09 20 20 20 20 28 28 73 74 61 72 e.;;.. ((star
2670: 74 29 0a 3b 3b 09 09 20 20 20 20 20 28 73 65 74 t).;;.. (set
2680: 21 20 6d 6f 64 65 20 27 6e 6f 72 6d 29 0a 3b 3b ! mode 'norm).;;
2690: 09 09 20 20 20 20 20 28 69 66 20 28 73 74 72 69 .. (if (stri
26a0: 6e 67 2d 6d 61 74 63 68 20 64 65 6c 69 6d 2d 70 ng-match delim-p
26b0: 61 74 74 2d 72 65 78 20 6c 29 0a 3b 3b 09 09 09 att-rex l).;;...
26c0: 20 28 62 65 67 69 6e 0a 3b 3b 09 09 09 20 20 20 (begin.;;...
26d0: 28 73 65 74 21 20 64 65 6c 69 6d 2d 73 74 72 69 (set! delim-stri
26e0: 6e 67 20 6c 29 0a 3b 3b 09 09 09 20 20 20 28 73 ng l).;;... (s
26f0: 65 74 21 20 64 65 6c 69 6d 2d 6c 65 6e 20 20 20 et! delim-len
2700: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
2710: 6c 29 29 0a 3b 3b 09 09 09 20 20 20 28 6c 6f 6f l)).;;... (loo
2720: 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 20 23 66 p (read-line) #f
2730: 20 30 29 29 0a 3b 3b 09 09 09 20 28 6c 6f 6f 70 0)).;;... (loop
2740: 20 6c 20 23 66 20 30 29 29 29 0a 3b 3b 09 09 20 l #f 0))).;;..
2750: 20 20 20 28 28 6e 6f 72 6d 29 0a 3b 3b 09 09 20 ((norm).;;..
2760: 20 20 20 20 3b 3b 20 49 20 64 6f 6e 27 74 20 6c ;; I don't l
2770: 69 6b 65 20 68 6f 77 20 74 68 69 73 20 67 65 74 ike how this get
2780: 73 20 63 68 65 63 6b 65 64 20 6f 6e 20 65 76 65 s checked on eve
2790: 72 79 20 73 69 6e 67 6c 65 20 69 6e 70 75 74 2e ry single input.
27a0: 20 4d 75 73 74 20 62 65 20 61 20 62 65 74 74 65 Must be a bette
27b0: 72 20 77 61 79 2e 20 46 49 58 4d 45 0a 3b 3b 09 r way. FIXME.;;.
27c0: 09 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 . (if (and (
27d0: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e string-match bin
27e0: 2d 64 61 74 61 2d 64 69 73 70 2d 72 65 78 20 6c -data-disp-rex l
27f0: 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 28 73 74 ).;;... (st
2800: 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d 64 ring-match bin-d
2810: 61 74 61 2d 6e 61 6d 65 2d 72 65 78 20 6c 29 0a ata-name-rex l).
2820: 3b 3b 09 09 09 20 20 20 20 20 20 28 73 74 72 69 ;;... (stri
2830: 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d 66 69 6c ng-match bin-fil
2840: 65 2d 6e 61 6d 65 2d 72 65 78 20 6c 29 29 0a 3b e-name-rex l)).;
2850: 3b 09 09 09 20 28 62 65 67 69 6e 0a 3b 3b 09 09 ;... (begin.;;..
2860: 09 20 20 20 28 73 65 74 21 20 64 61 74 61 2d 6e . (set! data-n
2870: 61 6d 65 20 28 63 61 64 72 20 28 73 74 72 69 6e ame (cadr (strin
2880: 67 2d 6d 61 74 63 68 20 62 69 6e 2d 64 61 74 61 g-match bin-data
2890: 2d 6e 61 6d 65 2d 72 65 78 20 6c 29 29 29 0a 3b -name-rex l))).;
28a0: 3b 09 09 09 20 20 20 28 73 65 74 21 20 66 69 6c ;... (set! fil
28b0: 65 2d 6e 61 6d 65 20 28 63 61 64 72 20 28 73 74 e-name (cadr (st
28c0: 72 69 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d 66 ring-match bin-f
28d0: 69 6c 65 2d 6e 61 6d 65 2d 72 65 78 20 6c 29 29 ile-name-rex l))
28e0: 29 0a 3b 3b 09 09 09 20 20 20 28 73 65 74 21 20 ).;;... (set!
28f0: 6d 6f 64 65 20 27 63 6f 6e 74 65 6e 74 29 0a 3b mode 'content).;
2900: 3b 09 09 09 20 20 20 28 6c 6f 6f 70 20 28 72 65 ;... (loop (re
2910: 61 64 2d 6c 69 6e 65 29 20 23 66 20 6e 75 6d 29 ad-line) #f num)
2920: 29 29 0a 3b 3b 09 09 20 20 20 20 20 28 6c 65 74 )).;;.. (let
2930: 2a 20 28 28 64 61 74 20 20 28 73 3a 70 72 6f 63 * ((dat (s:proc
2940: 65 73 73 2d 63 67 69 2d 69 6e 70 75 74 20 6c 29 ess-cgi-input l)
2950: 29 29 20 3b 3b 20 28 43 47 49 3a 75 72 6c 2d 75 )) ;; (CGI:url-u
2960: 6e 71 75 6f 74 65 20 6c 29 29 0a 3b 3b 09 09 20 nquote l)).;;..
2970: 20 20 20 20 20 20 28 66 6f 72 6d 61 74 20 64 65 (format de
2980: 62 75 67 70 20 22 50 52 4f 43 45 53 53 2d 43 47 bugp "PROCESS-CG
2990: 49 2d 49 4e 50 55 54 3a 20 7e 41 5c 6e 22 20 28 I-INPUT: ~A\n" (
29a0: 69 6e 74 65 72 73 70 65 72 73 65 20 64 61 74 20 intersperse dat
29b0: 22 2c 22 29 29 0a 3b 3b 09 09 20 20 20 20 20 20 ",")).;;..
29c0: 20 28 66 6f 72 6d 64 61 74 3a 6c 6f 61 64 20 66 (formdat:load f
29d0: 6f 72 6d 64 61 74 20 64 61 74 29 0a 3b 3b 09 09 ormdat dat).;;..
29e0: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 (loop (re
29f0: 61 64 2d 6c 69 6e 65 29 20 23 66 20 6e 75 6d 29 ad-line) #f num)
2a00: 29 29 0a 3b 3b 09 09 20 20 20 20 28 28 63 6f 6e )).;;.. ((con
2a10: 74 65 6e 74 29 0a 3b 3b 09 09 20 20 20 20 20 28 tent).;;.. (
2a20: 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 if (string-match
2a30: 20 62 69 6e 2d 66 69 6c 65 2d 74 79 70 65 2d 72 bin-file-type-r
2a40: 65 78 20 6c 29 0a 3b 3b 09 09 09 20 28 62 65 67 ex l).;;... (beg
2a50: 69 6e 20 0a 3b 3b 09 09 09 20 20 20 28 73 65 74 in .;;... (set
2a60: 21 20 6d 6f 64 65 20 27 62 69 6e 29 0a 3b 3b 09 ! mode 'bin).;;.
2a70: 09 09 20 20 20 28 73 65 74 21 20 64 61 74 61 2d .. (set! data-
2a80: 74 79 70 65 20 28 63 61 64 72 20 28 73 74 72 69 type (cadr (stri
2a90: 6e 67 2d 6d 61 74 63 68 20 62 69 6e 2d 66 69 6c ng-match bin-fil
2aa0: 65 2d 74 79 70 65 2d 72 65 78 20 6c 29 29 29 0a e-type-rex l))).
2ab0: 3b 3b 09 09 09 20 20 20 28 6c 6f 6f 70 20 28 72 ;;... (loop (r
2ac0: 65 61 64 2d 73 74 72 69 6e 67 20 31 29 20 23 66 ead-string 1) #f
2ad0: 20 6e 75 6d 29 29 29 29 0a 3b 3b 09 09 20 20 20 num)))).;;..
2ae0: 20 28 28 62 69 6e 29 0a 3b 3b 09 09 20 20 20 20 ((bin).;;..
2af0: 20 3b 3b 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 ;; delim-string
2b00: 3a 20 5c 6e 22 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d : \n"-----------
2b10: 2d 2d 2d 2d 31 32 33 34 35 22 0a 3b 3b 09 09 20 ----12345".;;..
2b20: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ;;
2b30: 20 20 20 20 20 20 20 20 30 31 32 33 34 35 36 37 01234567
2b40: 38 39 30 31 32 33 34 35 36 37 38 39 30 0a 3b 3b 8901234567890.;;
2b50: 09 09 20 20 20 20 20 3b 3b 20 65 6e 64 6c 69 6e .. ;; endlin
2b60: 65 3a 20 20 20 20 20 20 20 20 22 2d 2d 2d 2d 2d e: "-----
2b70: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 31 32 22 0a 3b 3b ----------12".;;
2b80: 09 09 20 20 20 20 20 3b 3b 20 6c 20 3d 20 22 33 .. ;; l = "3
2b90: 22 0a 3b 3b 09 09 20 20 20 20 20 3b 3b 20 64 65 ".;;.. ;; de
2ba0: 6c 69 6d 2d 6c 65 6e 20 3d 20 32 30 0a 3b 3b 09 lim-len = 20.;;.
2bb0: 09 20 20 20 20 20 3b 3b 20 28 73 75 62 73 74 72 . ;; (substr
2bc0: 69 6e 67 20 20 22 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ing "----------
2bd0: 2d 2d 2d 2d 2d 31 32 33 34 35 22 20 31 37 20 31 -----12345" 17 1
2be0: 38 29 20 3d 3e 20 22 33 22 0a 3b 3b 09 09 20 20 8) => "3".;;..
2bf0: 20 20 20 3b 3b 0a 3b 3b 09 09 20 20 20 20 20 28 ;;.;;.. (
2c00: 63 6f 6e 64 0a 3b 3b 09 09 20 20 20 20 20 20 20 cond.;;..
2c10: 3b 3b 20 68 61 76 65 6e 27 74 20 66 6f 75 6e 64 ;; haven't found
2c20: 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 61 6e the start of an
2c30: 20 65 6e 64 6c 69 6e 65 2c 20 69 73 20 74 68 65 endline, is the
2c40: 20 6e 65 78 74 20 63 68 61 72 20 61 20 6e 65 77 next char a new
2c50: 6c 69 6e 65 3f 0a 3b 3b 09 09 20 20 20 20 20 20 line?.;;..
2c60: 28 28 61 6e 64 20 28 6e 6f 74 20 65 6e 64 6c 69 ((and (not endli
2c70: 6e 65 29 0a 3b 3b 09 09 09 20 20 20 20 28 73 74 ne).;;... (st
2c80: 72 69 6e 67 3d 3f 20 6c 20 22 5c 6e 22 29 29 20 ring=? l "\n"))
2c90: 3b 3b 20 72 65 71 75 69 72 65 64 20 66 69 72 73 ;; required firs
2ca0: 74 20 63 68 61 72 61 63 74 65 72 20 0a 3b 3b 09 t character .;;.
2cb0: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e . (let ((n
2cc0: 65 77 65 6e 64 6c 69 6e 65 20 28 6f 70 65 6e 2d ewendline (open-
2cd0: 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 29 29 29 output-string)))
2ce0: 0a 3b 3b 09 09 09 20 3b 3b 20 28 77 72 69 74 65 .;;... ;; (write
2cf0: 2d 6c 69 6e 65 20 6c 20 6e 65 77 65 6e 64 6c 69 -line l newendli
2d00: 6e 65 29 20 3b 3b 20 64 69 73 63 61 72 64 20 74 ne) ;; discard t
2d10: 68 65 20 6e 65 77 6c 69 6e 65 2e 20 61 64 64 20 he newline. add
2d20: 69 74 20 62 61 63 6b 20 69 66 20 64 6f 6e 27 74 it back if don't
2d30: 20 68 61 76 65 20 61 20 6c 6f 63 6b 20 6f 6e 20 have a lock on
2d40: 64 65 6c 69 6d 2d 73 74 72 69 6e 67 0a 3b 3b 09 delim-string.;;.
2d50: 09 09 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 73 .. (loop (read-s
2d60: 74 72 69 6e 67 20 31 29 20 6e 65 77 65 6e 64 6c tring 1) newendl
2d70: 69 6e 65 20 28 2b 20 6e 75 6d 20 31 29 29 29 29 ine (+ num 1))))
2d80: 0a 3b 3b 09 09 20 20 20 20 20 20 28 28 6e 6f 74 .;;.. ((not
2d90: 20 65 6e 64 6c 69 6e 65 29 0a 3b 3b 09 09 20 20 endline).;;..
2da0: 20 20 20 20 20 28 77 72 69 74 65 2d 73 74 72 69 (write-stri
2db0: 6e 67 20 6c 20 23 66 20 62 69 6e 2d 64 61 74 29 ng l #f bin-dat)
2dc0: 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 6c 6f 6f .;;.. (loo
2dd0: 70 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 31 p (read-string 1
2de0: 29 20 23 66 20 28 2b 20 6e 75 6d 20 31 29 29 29 ) #f (+ num 1)))
2df0: 0a 3b 3b 09 09 20 20 20 20 20 20 3b 3b 20 73 74 .;;.. ;; st
2e00: 72 69 6e 67 20 73 6f 20 66 61 72 20 6d 61 74 63 ring so far matc
2e10: 68 65 73 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 hes delim-string
2e20: 0a 3b 3b 09 09 20 20 20 20 20 20 28 65 6e 64 6c .;;.. (endl
2e30: 69 6e 65 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 ine.;;.. (
2e40: 6c 65 74 2a 20 28 28 65 6e 64 73 74 72 20 28 67 let* ((endstr (g
2e50: 65 74 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 et-output-string
2e60: 20 65 6e 64 6c 69 6e 65 29 29 0a 3b 3b 09 09 09 endline)).;;...
2e70: 20 20 20 20 20 20 28 65 6e 64 6c 65 6e 20 28 73 (endlen (s
2e80: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 65 6e 64 tring-length end
2e90: 73 74 72 29 29 29 0a 3b 3b 09 09 09 20 28 69 66 str))).;;... (if
2ea0: 20 28 3e 20 65 6e 64 6c 65 6e 20 30 29 0a 3b 3b (> endlen 0).;;
2eb0: 09 09 09 20 20 20 20 20 28 66 6f 72 6d 61 74 20 ... (format
2ec0: 64 65 62 75 67 70 20 22 20 64 65 6c 69 6d 3a 20 debugp " delim:
2ed0: 7e 41 5c 6e 65 6e 64 73 74 72 3a 20 7e 41 5c 6e ~A\nendstr: ~A\n
2ee0: 22 20 64 65 6c 69 6d 2d 73 74 72 69 6e 67 20 65 " delim-string e
2ef0: 6e 64 73 74 72 29 29 0a 3b 3b 09 09 09 20 28 69 ndstr)).;;... (i
2f00: 66 20 28 61 6e 64 20 28 3e 20 64 65 6c 69 6d 2d f (and (> delim-
2f10: 6c 65 6e 20 65 6e 64 6c 65 6e 29 0a 3b 3b 09 09 len endlen).;;..
2f20: 09 09 20 20 28 73 74 72 69 6e 67 3d 3f 20 6c 20 .. (string=? l
2f30: 28 73 75 62 73 74 72 69 6e 67 20 64 65 6c 69 6d (substring delim
2f40: 2d 73 74 72 69 6e 67 20 65 6e 64 6c 65 6e 20 28 -string endlen (
2f50: 2b 20 65 6e 64 6c 65 6e 20 31 29 29 29 29 0a 3b + endlen 1)))).;
2f60: 3b 09 09 09 20 20 20 20 20 3b 3b 20 79 65 73 2c ;... ;; yes,
2f70: 20 74 68 69 73 20 63 68 61 72 61 63 74 65 72 20 this character
2f80: 6d 61 74 63 68 65 73 20 74 68 65 20 6e 65 78 74 matches the next
2f90: 20 69 6e 20 74 68 65 20 64 65 6c 69 6d 2d 73 74 in the delim-st
2fa0: 72 69 6e 67 0a 3b 3b 09 09 09 20 20 20 20 20 28 ring.;;... (
2fb0: 69 66 20 28 65 71 3f 20 64 65 6c 69 6d 2d 6c 65 if (eq? delim-le
2fc0: 6e 20 65 6e 64 6c 65 6e 29 20 3b 3b 20 68 61 76 n endlen) ;; hav
2fd0: 65 20 61 20 6d 61 74 63 68 21 20 49 67 6e 6f 72 e a match! Ignor
2fe0: 65 20 74 68 61 74 20 61 20 6e 65 77 6c 69 6e 65 e that a newline
2ff0: 20 69 73 20 72 65 71 75 69 72 65 64 2e 20 4c 61 is required. La
3000: 7a 79 20 62 75 67 67 65 72 2e 0a 3b 3b 09 09 09 zy bugger..;;...
3010: 09 20 28 6c 65 74 2a 20 28 28 66 6e 20 20 20 20 . (let* ((fn
3020: 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f (string->symbo
3030: 6c 20 64 61 74 61 2d 6e 61 6d 65 29 29 29 0a 3b l data-name))).;
3040: 3b 09 09 09 09 20 20 20 28 66 6f 72 6d 64 61 74 ;.... (formdat
3050: 3a 73 65 74 21 20 66 6f 72 6d 64 61 74 20 66 6e :set! formdat fn
3060: 20 28 6c 69 73 74 20 66 69 6c 65 2d 6e 61 6d 65 (list file-name
3070: 20 64 61 74 61 2d 74 79 70 65 20 28 73 74 72 69 data-type (stri
3080: 6e 67 2d 3e 62 6c 6f 62 20 28 67 65 74 2d 6f 75 ng->blob (get-ou
3090: 74 70 75 74 2d 73 74 72 69 6e 67 20 62 69 6e 2d tput-string bin-
30a0: 64 61 74 29 29 29 29 0a 3b 3b 09 09 09 09 20 20 dat)))).;;....
30b0: 20 28 73 65 74 21 20 6d 6f 64 65 20 27 6e 6f 72 (set! mode 'nor
30c0: 6d 29 0a 3b 3b 09 09 09 09 20 20 20 28 6c 6f 6f m).;;.... (loo
30d0: 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 20 23 66 p (read-line) #f
30e0: 20 30 29 29 0a 3b 3b 09 09 09 09 20 28 62 65 67 0)).;;.... (beg
30f0: 69 6e 0a 3b 3b 09 09 09 09 20 20 20 28 77 72 69 in.;;.... (wri
3100: 74 65 2d 73 74 72 69 6e 67 20 6c 20 23 66 20 65 te-string l #f e
3110: 6e 64 6c 69 6e 65 29 0a 3b 3b 09 09 09 09 20 20 ndline).;;....
3120: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 73 74 72 (loop (read-str
3130: 69 6e 67 20 31 29 20 65 6e 64 6c 69 6e 65 20 28 ing 1) endline (
3140: 2b 20 6e 75 6d 20 31 29 29 29 29 0a 3b 3b 09 09 + num 1)))).;;..
3150: 09 20 20 20 20 20 3b 3b 20 6e 6f 2c 20 74 68 69 . ;; no, thi
3160: 73 20 63 68 61 72 61 63 74 65 72 20 64 6f 65 73 s character does
3170: 20 4e 4f 54 20 6d 61 74 63 68 20 74 68 65 20 6e NOT match the n
3180: 65 78 74 20 69 6e 20 6c 69 6e 65 20 69 6e 20 64 ext in line in d
3190: 65 6c 69 6d 2d 73 74 72 69 6e 67 0a 3b 3b 09 09 elim-string.;;..
31a0: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 3b 3b 09 . (begin.;;.
31b0: 09 09 20 20 20 20 20 20 20 28 77 72 69 74 65 2d .. (write-
31c0: 73 74 72 69 6e 67 20 22 5c 6e 22 20 23 66 20 62 string "\n" #f b
31d0: 69 6e 2d 64 61 74 29 20 3b 3b 20 64 6f 6e 27 74 in-dat) ;; don't
31e0: 20 66 6f 72 67 65 74 20 74 68 61 74 20 6e 65 77 forget that new
31f0: 6c 69 6e 65 20 77 65 20 64 72 6f 70 70 65 64 0a line we dropped.
3200: 3b 3b 09 09 09 20 20 20 20 20 20 20 28 77 72 69 ;;... (wri
3210: 74 65 2d 73 74 72 69 6e 67 20 65 6e 64 73 74 72 te-string endstr
3220: 20 23 66 20 62 69 6e 2d 64 61 74 29 0a 3b 3b 09 #f bin-dat).;;.
3230: 09 09 20 20 20 20 20 20 20 28 77 72 69 74 65 2d .. (write-
3240: 73 74 72 69 6e 67 20 6c 20 23 66 20 62 69 6e 2d string l #f bin-
3250: 64 61 74 29 0a 3b 3b 09 09 09 20 20 20 20 20 20 dat).;;...
3260: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 73 74 72 (loop (read-str
3270: 69 6e 67 20 31 29 20 23 66 20 28 2b 20 6e 75 6d ing 1) #f (+ num
3280: 20 31 29 29 29 29 29 29 29 29 0a 3b 3b 09 09 20 1)))))))).;;..
3290: 20 20 20 29 29 29 29 29 0a 0a 3b 3b 20 20 20 20 )))))..;;
32a0: 28 66 6f 72 6d 64 61 74 3a 70 72 69 6e 74 61 6c (formdat:printal
32b0: 6c 20 66 6f 72 6d 64 61 74 20 28 6c 61 6d 62 64 l formdat (lambd
32c0: 61 20 28 78 29 28 77 72 69 74 65 2d 6c 69 6e 65 a (x)(write-line
32d0: 20 78 20 64 65 62 75 67 70 29 29 29 0a 0a 23 7c x debugp)))..#|
32e0: 0a 28 64 65 66 69 6e 65 20 69 6e 70 20 28 6f 70 .(define inp (op
32f0: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 22 2f en-input-file "/
3300: 74 6d 70 2f 73 74 6d 6c 72 75 6e 2f 64 65 6c 6d tmp/stmlrun/delm
3310: 65 2d 33 33 2e 6c 6f 67 2e 6b 65 65 70 2d 66 6f e-33.log.keep-fo
3320: 72 2d 72 65 66 22 29 29 0a 28 64 65 66 69 6e 65 r-ref")).(define
3330: 20 64 61 74 20 28 72 65 61 64 2d 73 74 72 69 6e dat (read-strin
3340: 67 20 23 66 20 69 6e 70 29 29 0a 28 63 6c 6f 73 g #f inp)).(clos
3350: 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 e-input-port inp
3360: 29 0a 7c 23 0a ).|#.