/src/upload.lisp
Lisp | 48 lines | 36 code | 7 blank | 5 comment | 2 complexity | d02c2db6d43f6146bcbe9693e3e79c39 MD5 | raw file
1(in-package :wu)
2
3(export '(parse-upload-form))
4
5;;; Call this to parse a multipart form.
6
7;;; Returns a list of ((<field> <value>)..., where <value> will be a pathname for the file.
8;;; Not thoroughly tested, this is a very annoying piece of the web protocol
9
10(defun parse-upload-form (req &key (pathname-maker
11 #'(lambda (name) (make-pathname :defaults (pathname "/tmp/") :name (string+ (string *session*) "_" name)))
12 ))
13 (do ((result nil))
14 (())
15 (multiple-value-bind (part-type field filename content-type)
16 (parse-multipart-header (get-multipart-header req))
17 (declare (ignorable content-type))
18; (format t "~%Multipart part-type=~s name=~s filename=~s content-type=~s~%" part-type field filename content-type)
19 (case part-type
20 (:eof
21 (return result))
22 (:file
23 (let ((pathname (funcall pathname-maker filename))
24 (element-type '(unsigned-byte 8)))
25 (with-open-file (s pathname :direction :output :if-exists :supersede :element-type element-type)
26 (slurp-part req :stream s :element-type element-type))
27 (push (list field pathname) result)))
28 (:nofile
29 (push (list field nil) result))
30 (:data
31 (push (list field (slurp-part req))
32 result))
33 (t (warn "Unknown part type ~A" part-type)
34 (slurp-part req))))))
35
36(defparameter *buffer-size* (* 4 1024))
37
38(defun slurp-part (req &key stream (element-type '(unsigned-byte 8)))
39 (loop with buffer = (make-array *buffer-size* :element-type element-type)
40 for n = (get-multipart-sequence req buffer)
41 with len = 0
42 ;; +++ will be wrong if there are multiple buffers, but that's unlikely for a non-file
43 finally (return (values (unless stream (vector->string buffer len)) len))
44 while n do
45 (incf len n)
46 (if stream
47 (write-sequence buffer stream :end n))))
48