105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(let* ((datstr (open-input-string dat))
(result (read-string (caar index) datstr))
(remdat (read-string #f datstr)))
(close-input-port datstr)
(list result remdat)))))
;; inp is port to read data from, maxsize is max data allowed to read (total)
(define (formdat:dat->list inp maxsize)
;; read 1Meg chunks from the input port. If a block is not complete
;; tack on the next 1Meg chunk as needed. Set up so the header is always
;; at the beginning of the chunk
;;-----------------------------29932024411502323332136214973
;;Content-Disposition: form-data; name="input-picture"; filename="breadfruit.jpg"
;;Content-Type: image/jpeg
(let loop ((dat (read-string 1000000 inp))
(res '())
(siz 0))
(if (> siz maxsize)
(begin
(print "DATA TOO BIG")
res)
(let* ((datstr (open-input-string dat))
(header (formdat:read-header datstr))
(key (if (not (null? header))(car header) #f))
|
|
>
>
>
|
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(let* ((datstr (open-input-string dat))
(result (read-string (caar index) datstr))
(remdat (read-string #f datstr)))
(close-input-port datstr)
(list result remdat)))))
;; inp is port to read data from, maxsize is max data allowed to read (total)
(define (formdat:dat->list inp maxsize #!key (debug-port #f))
;; read 1Meg chunks from the input port. If a block is not complete
;; tack on the next 1Meg chunk as needed. Set up so the header is always
;; at the beginning of the chunk
;;-----------------------------29932024411502323332136214973
;;Content-Disposition: form-data; name="input-picture"; filename="breadfruit.jpg"
;;Content-Type: image/jpeg
(let loop ((dat (read-string 1000000 inp))
(res '())
(siz 0))
(if debug-port (format debug-port "dat: ~A\n" dat))
(if debug-port (format debug-port "eof: ~A\n" (eof-object? (read inp))))
(if (> siz maxsize)
(begin
(print "DATA TOO BIG")
res)
(let* ((datstr (open-input-string dat))
(header (formdat:read-header datstr))
(key (if (not (null? header))(car header) #f))
|
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
(let ((request-method (get-environment-variable "REQUEST_METHOD")))
(if (and request-method
(string=? request-method "POST"))
(formdat:load-all-port (current-input-port)))))
;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
(let* ((formdat (make-formdat:formdat)))
;; (debugp (open-output-file (conc (slot-ref s:session 'sroot) "/delme-" (current-user-id) ".log"))))
;; (write-string (read-string #f inp) #f debugp)
(formdat:initialize formdat)
(let ((alldats (formdat:dat->list inp 10e6)))
;; (format debugp "formdat : alldats: ~A\n" alldats)
(let ((firstitem (car alldats))
(multipass #f))
(if (not (null? firstitem))
(if (string-match formdat:delim-patt-rex (caar firstitem))
(set! multipass #t)))
(if multipass
;; handle multi-part form
(for-each (lambda (datlst)
(let* ((header (formdat:extract-header-info (car datlst)))
(name (if (assoc 'name header)
|
|
>
|
|
|
|
>
|
>
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
(let ((request-method (get-environment-variable "REQUEST_METHOD")))
(if (and request-method
(string=? request-method "POST"))
(formdat:load-all-port (current-input-port)))))
;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
(let* ((formdat (make-formdat:formdat))
(debugp #f))
;; (open-output-file (conc "/tmp/delme-" (current-user-id) ".log"))))
;; (write-string (read-string #f inp) #f debugp) ;; destroys all data!
(formdat:initialize formdat)
(let ((alldats (formdat:dat->list inp 10e6 debug-port: debugp)))
(if debugp (format debugp "formdat : alldats: ~A\n" alldats))
(let ((firstitem (car alldats))
(multipass #f))
(if (and (not (null? firstitem))
(not (null? (car firstitem))))
(if (string-match formdat:delim-patt-rex (caar firstitem))
(set! multipass #t)))
(if multipass
;; handle multi-part form
(for-each (lambda (datlst)
(let* ((header (formdat:extract-header-info (car datlst)))
(name (if (assoc 'name header)
|
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
alldats)
;; handle single part form
;; (if (and (string? name)
;; (string=? name "")) ;; this is the short form input I guess
;; (let* ((datstr (caar datlst))
;; (munged (s:process-cgi-input datstr)))
;; (print "datstr: " datstr " munged: " munged)
(formdat:load formdat (s:process-cgi-input (caaar alldats)))) ;; munged))
;; (format debugp "formdat : name: ~A content: ~A\n" name content)
;; (close-output-port debugp)
formdat))))
#|
(define inp (open-input-file "tests/example.post.in"))
(define dat (read-string #f inp))
(define datstr (open-input-string dat))
|
>
>
>
|
|
|
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
alldats)
;; handle single part form
;; (if (and (string? name)
;; (string=? name "")) ;; this is the short form input I guess
;; (let* ((datstr (caar datlst))
;; (munged (s:process-cgi-input datstr)))
;; (print "datstr: " datstr " munged: " munged)
(if (and (not (null? alldats))
(not (null? (car alldats)))
(not (null? (caar alldats))))
(formdat:load formdat (s:process-cgi-input (caaar alldats))))) ;; munged))
;; (format debugp "formdat : name: ~A content: ~A\n" name content)
(if debugp (close-output-port debugp))
formdat))))
#|
(define inp (open-input-file "tests/example.post.in"))
(define dat (read-string #f inp))
(define datstr (open-input-string dat))
|