commit 757d4002fceb6ab0b74a8fd385c7f0c31121779d
parent 94b41f7d9d2f1652384319b367b0c27f278956dd
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 6 Oct 2013 22:59:40 +0200
till with look-ahead implemented, handle multiple lines in multipart/form-data
Diffstat:
| M | http.lisp | | | 53 | +++++++++++++++++++++++++++-------------------------- |
| M | rw.lisp | | | 122 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------- |
2 files changed, 139 insertions(+), 36 deletions(-)
diff --git a/http.lisp b/http.lisp
@@ -269,23 +269,23 @@
stream)
(write-crlf stream))
-(defun multipart-reader (reader start-boundary end-boundary)
- (lambda ()
- (rw:skip reader)
- (when (rw:peek reader)
- (let ((boundary (rw:till reader '(#\return #\newline))))
- (unless (equal boundary end-boundary)
- (assert (equalp boundary start-boundary))
- (next-eol reader)
- (list :part
- :headers (next-headers reader)
- :body (prog1 (rw:till reader '(#\return #\newline))
- (next-eol reader))))))))
-
-(defun next-multipart/form-data (reader boundary)
- (rw:till (rw:peek-reader (multipart-reader (rw:peek-reader reader)
- `(#\- #\- ,@boundary)
- `(#\- #\- ,@boundary #\- #\-)))))
+(defun multipart-reader (reader boundary)
+ (let* ((start-boundary `(#\- #\- ,@boundary))
+ (end-boundary `(,@start-boundary #\- #\-))
+ (sentinel (list `(#\return #\newline ,@start-boundary)
+ `(#\return ,@start-boundary)
+ `(#\newline ,@start-boundary)))
+ (r (rw::look-ahead-reader reader (length (car sentinel)))))
+ (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))))))))
(defun post-parameters (method multipart/form-data)
(when (eq :post method)
@@ -309,15 +309,16 @@
(multiple-value-bind (protocol2 code message headers2 body)
(funcall handler :write stream method query protocol headers
(when (eq :post method)
- (next-multipart/form-data
- (rw:shorter-reader
- r
- (cdr (assoc "Content-Length" headers :test #'equal)))
- (coerce
- (cdr (assoc "boundary"
- (cdr (assoc "Content-Type" headers :test #'equal))
- :test #'equal))
- 'list))))
+ (rw:slurp
+ (multipart-reader
+ (rw:shorter-reader
+ r
+ (cdr (assoc "Content-Length" headers :test #'equal)))
+ (coerce
+ (cdr (assoc "boundary"
+ (cdr (assoc "Content-Type" headers :test #'equal))
+ :test #'equal))
+ 'list)))))
(write-status stream protocol2 code message)
(write-headers (or headers2
'(("Connection" . "close")
diff --git a/rw.lisp b/rw.lisp
@@ -42,6 +42,7 @@
:search-reader
:shorter-reader
:skip
+ :slurp
:till
:write-octets
:write-u16
@@ -92,20 +93,121 @@
(dotimes (i n/items reader)
(next reader)))
(list
- (let ((x (or n/items '(#\space #\tab #\newline))))
+ (let ((x (or n/items '(#\space #\tab #\return #\newline))))
(loop
while (member (peek reader) x)
do (next reader)))
reader)))
-(defun till (reader &optional items good)
- (loop
- while (let ((x (peek reader)))
- (and x
- (if good
- (member x items)
- (not (member x items)))))
- collect (next reader)))
+(defun slurp (reader) ;; TODO use wherever possible
+ (let (x)
+ (loop
+ while (setq x (next reader))
+ collect x)))
+
+(defun till-reader (reader test)
+ (lambda ()
+ (when (funcall test (peek reader))
+ (next reader))))
+
+(defun make-circular-list (n)
+ (check-type n (and fixnum (satisfies plusp)))
+ (let* ((b (cons nil nil))
+ (e b))
+ (dotimes (i (1- n))
+ (push nil b))
+ (setf (cdr e) b)
+ b))
+
+;;(make-circular-list 1)
+;;(make-circular-list 2)
+
+(defun head (reader test)
+ (funcall reader 'head test))
+
+(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)))))
+ (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))))
+
+(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)
+
+#+nil
+(with-open-file (s "/etc/passwd")
+ (let* ((sentinel '#.(coerce "user" 'list))
+ (r (look-ahead-reader (char-reader s) (length sentinel))))
+ (list (coerce (till r (list sentinel) nil t) 'string)
+ (coerce (till r '(#\:)) 'string)
+ (coerce (till r (list sentinel) nil t) 'string)
+ (coerce (till r '(#\:)) 'string)
+ (coerce (till r (list sentinel) nil t) 'string)
+ (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)
@@ -113,7 +215,7 @@
;;(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)
+(defun search-reader (reader needle) ;; TODO remove
(let ((all (till (peek-reader reader))) ;; TODO optimize? use kmp algorithm
(start 0))
(lambda ()
