commit fe0c1f72716eb44faeaea141066e1a02e8296195
parent 201c2392b46055655ebbbce3fc33d4dd14b34dd3
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 21 May 2017 15:02:25 +0200
improve multipart-reader
Diffstat:
| M | http.lisp | | | 69 | +++++++++++++++++++++++++++++++++++++++------------------------------ |
| M | rw.lisp | | | 163 | +++++++++++++++++++++++++++++++++++-------------------------------------------- |
2 files changed, 111 insertions(+), 121 deletions(-)
diff --git a/http.lisp b/http.lisp
@@ -337,23 +337,34 @@
(error "unknown http code ~s" code)))
(write-crlf writer))
-(defun multipart-reader (reader boundary)
- (let* ((start-boundary `(#\- #\- ,@boundary))
- (end-boundary `(,@start-boundary #\- #\-))
- (sentinel `((#\return #\newline ,@start-boundary)
- (#\return ,@start-boundary)
- (#\newline ,@start-boundary)))
- (r (rw::look-ahead-reader reader (length (car sentinel)))))
+(defun multipart-reader (breader creader boundary)
+ (let* ((cb `(#\return #\newline #\- #\- ,@(coerce boundary 'list)))
+ (bb (rw.string:string-to-octets (coerce cb 'string) :utf-8))
+ (cr (rw:peek-reader creader))
+ done)
+ (assert (not (rw:slurp (rw:search-reader creader (cddr cb)))))
(lambda ()
- (rw:skip r)
- (when (rw:peek r)
- (let ((boundary (rw:till r '(#\return #\newline))))
- (unless (equal boundary end-boundary)
- (assert (equal boundary start-boundary))
- (next-eol r)
- (list :part
- :headers (next-headers r)
- :body (rw:till r sentinel nil t)))))))) ;; TODO very slow for anything non-tiny
+ (unless done
+ (cond
+ ((eql #\- (rw:peek cr))
+ (assert (eql #\- (rw:next cr)))
+ (assert (eql #\- (rw:next cr)))
+ (next-eol cr)
+ (setq done t)
+ nil)
+ (t
+ (next-eol cr)
+ (let ((headers (next-headers cr)))
+ (list :part
+ :headers headers
+ :body (if (cdr (assoc "Content-Type" headers :test #'equal))
+ ;; TODO callback instead of slurp?
+ ;;(cdr (assoc "filename" y :test #'equal))
+ ;;("Content-Type" ("application/octet-stream"))
+ (rw:slurp (rw:search-reader breader bb))
+ (let ((x (rw:slurp (rw:search-reader creader cb))))
+ (when x
+ (coerce x 'string))))))))))))
(defun post-parameters (method multipart/form-data)
(when (eq :post method)
@@ -363,12 +374,10 @@
(assert (eq :part tag))
(cons (let ((y (cdr (assoc "Content-Disposition" headers
:test #'equal))))
- (assert (assoc "form-data" y :test #'equal))
- ;;(cdr (assoc "filename" y :test #'equal))
- ;;("Content-Type" ("application/octet-stream"))
+ (assert (equal '("form-data")
+ (assoc "form-data" y :test #'equal)))
(cdr (assoc "name" y :test #'equal)))
- (when body
- (coerce body 'string)))))))
+ body)))))
(defun server-read (breader creader method)
(let ((headers (next-headers creader)))
@@ -376,15 +385,15 @@
headers
(when (eq :post method)
(rw:slurp
- (multipart-reader
- (rw:shorter-reader
- breader
- (cdr (assoc "Content-Length" headers :test #'equal)))
- (coerce
- (cdr (assoc "boundary"
- (cdr (assoc "Content-Type" headers :test #'equal))
- :test #'equal))
- 'list)))))))
+ (let ((br (rw:shorter-reader
+ breader
+ (cdr (assoc "Content-Length" headers :test #'equal)))))
+ (multipart-reader
+ br
+ (rw:utf8-reader br :charp t)
+ (cdr (assoc "boundary"
+ (cdr (assoc "Content-Type" headers :test #'equal))
+ :test #'equal)))))))))
(defun server-write (form writer)
(ecase (car form)
diff --git a/rw.lisp b/rw.lisp
@@ -145,6 +145,19 @@
(when (funcall test (peek reader))
(next reader))))
+(defun till (reader &optional items good) ;; TODO till vs until?
+ (slurp
+ (till-reader reader
+ (if good
+ (lambda (x) (member x items :test #'equal))
+ (lambda (x) (not (member x items :test #'equal)))))))
+
+;;(till (peek-reader (reader '(0 1 2 3 4))) '(3))
+;;(till (peek-reader (reader '(0 1 2 3 4))) '(0 1) t)
+;;(till (skip (peek-reader (reader '(0 1 2 3 4))) 1) '(3))
+;;(till (skip (peek-reader (reader #(0 1 2 3 4))) 1) '(3))
+;;(with-open-file (s "/etc/passwd") (till (peek-reader (char-reader s)) '(#\:)))
+
(defun make-circular-list (n)
(check-type n (and fixnum (satisfies plusp)))
(let* ((b (cons nil nil))
@@ -154,73 +167,72 @@
(setf (cdr e) b)
b))
-;;(make-circular-list 1)
-;;(make-circular-list 2)
+(defun delayed-reader (reader n)
+ (let ((b (make-circular-list n)))
+ (flet ((next ()
+ (prog1 (car b)
+ (setf (car b) (rw:next reader)
+ b (cdr b)))))
+ (dotimes (i n)
+ (next))
+ #'next)))
-(defun head (reader test)
- (funcall reader 'head test))
+;;(slurp (delayed-reader (reader '(0 1 2 1 2 3 4 5 6 7 8 9)) 4))
-(defun look-ahead-reader (reader n) ;; TODO optimize, like streaming regexp or knuth-morris-pratt
- (let (done
- (m 0)
- (b (make-circular-list n)))
- (flet ((fetch ()
- (prog1 (car b)
- (if (setf (car b) (next reader))
- (setq m (if (< m n) (1+ m) m))
- (setq done t))
- (setq b (cdr b)))))
+(defun %search-reader (reader needle)
+ (let* ((n (length needle))
+ z
+ found)
+ (lambda ()
+ (unless found
+ (let ((c (rw:next reader)))
+ (when c
+ (block here
+ (setq z (loop
+ for i in (cons 0 z)
+ when (eql c (elt needle i))
+ collect (if (= n (1+ i))
+ (return-from here (setq found t))
+ (1+ i))))))
+ c)))))
+
+;;(slurp (%search-reader (reader '(0 1 2 3 4 5 6 7 8 9)) '(a)))
+;;(slurp (%search-reader (reader '(0 1 2 3 4 5 6 7 8 9)) '(3 2 5)))
+;;(slurp (%search-reader (reader '(0 1 2 1 2 3 4 5 6 7 8 9)) '(1 2 3 4 5)))
+
+(defun search-reader (reader needle)
+ (let* ((n (length needle))
+ (b (make-circular-list n))
+ z
+ found)
+ (flet ((next ()
+ (unless found
+ (let ((c (rw:next reader)))
+ (when c
+ (block here
+ (setq z (loop
+ for i in (cons 0 z)
+ when (eql c (elt needle i))
+ collect (if (= n (1+ i))
+ (return-from here (setq found t))
+ (1+ i))))))
+ (prog1 (car b)
+ (setf (car b) c
+ b (cdr b)))))))
(dotimes (i n)
- (fetch))
- (lambda (&optional msg test)
- (flet ((%next ()
- (if done
- (let ((z (car b)))
- (when (plusp m)
- (decf m))
- (when z
- (setq b (cdr b))
- z))
- (fetch))))
- (ecase msg
- (peek
- (unless (or done (car b))
- (%next))
- (car b))
- (head (funcall test b m))
- ((nil) (%next))))))))
-
-;;(till (look-ahead-reader (reader '(0 1 2 3 4 5 6 7 8)) 4))
-;;(till (look-ahead-reader (reader '(0 1 2)) 4))
-;;(till (look-ahead-reader (reader nil) 4))
-
-(defun look-ahead-till-reader (reader test)
- (lambda ()
- (when (head reader test)
- (next reader))))
+ (next))
+ #'next)))
+
+;;(slurp (search-reader (reader '(0 1 2 3 4 5 6 7 8 9)) '(a)))
+;;(slurp (search-reader (reader '(0 1 2 3 4 5 6 7 8 9)) '(3 2 5)))
+;;(slurp (search-reader (reader '(0 1 2 1 2 3 4 5 6 7 8 9)) '(1 2 3 4 5)))
-(defun %head (prefix list &optional n)
- (do ((a prefix (cdr a))
- (b list (cdr b))
- (i 0 (1+ i)))
- ((not (and a b))
- (not a))
- (when n
- (unless (< i n)
- (return-from %head nil)))
- (unless (eql (car a) (car b))
- (return-from %head nil))))
-
-;; (%head '(1 2 3) '(2 3 4 5 6))
-;; (%head '(1 2 3) '(1 2 3 4 5 6))
-;; (%head '(1 2 3) '(1 2))
-;; (%head '(1 2 3) '(1 2 3 4 5 6) 3)
-;; (%head '(1 2 3) '(1 2 3 4 5 6) 2)
+;;(with-open-file (s "/etc/passwd") (slurp (search-reader (char-reader s) "user")))
#+nil
(with-open-file (s "/etc/passwd")
- (let* ((sentinel '#.(coerce "user" 'list))
- (r (look-ahead-reader (char-reader s) (length sentinel))))
+ (let* ((sentinel "user")
+ (r (search-reader (char-reader s) sentinel)))
(list (coerce (till r (list sentinel) nil t) 'string)
(coerce (till r '(#\:)) 'string)
(coerce (till r (list sentinel) nil t) 'string)
@@ -229,37 +241,6 @@
(coerce (till r '(#\:)) 'string)
(coerce (till r (list sentinel) nil t) 'string))))
-(defun till (reader &optional items good look-ahead) ;; TODO till vs until?
- (slurp
- (if look-ahead
- (look-ahead-till-reader
- reader
- (if good
- (lambda (b m)
- (member b items :test (lambda (b p) (%head p b m))))
- (lambda (b m)
- (not (member b items :test (lambda (b p) (%head p b m)))))))
- (till-reader reader
- (if good
- (lambda (x) (member x items))
- (lambda (x) (not (member x items))))))))
-
-;;(till (peek-reader (reader '(0 1 2 3 4))) '(3))
-;;(till (peek-reader (reader '(0 1 2 3 4))) '(0 1) t)
-;;(till (skip (peek-reader (reader '(0 1 2 3 4))) 1) '(3))
-;;(till (skip (peek-reader (reader #(0 1 2 3 4))) 1) '(3))
-;;(with-open-file (s "/etc/passwd") (till (peek-reader (char-reader s)) '(#\:)))
-
-(defun search-reader (reader needle) ;; TODO remove
- (let ((all (till (peek-reader reader))) ;; TODO optimize? use kmp algorithm
- (start 0))
- (lambda ()
- (let? i (search needle all :start2 start)
- (setq start (1+ i))
- (values i all)))))
-
-;;(with-open-file (s "/etc/passwd") (till (peek-reader (search-reader (peek-reader (char-reader s)) '#.(coerce "user" 'list)))))
-
(defun next-u8 (reader)
(let? x (next reader)
(assert (<= 0 x 255))
