Revision: 4478 Author: edi URL: http://bknr.net/trac/changeset/4478
Changes for cookie parsing
U trunk/thirdparty/chunga/CHANGELOG.txt U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp U trunk/thirdparty/chunga/read.lisp U trunk/thirdparty/chunga/util.lisp
Modified: trunk/thirdparty/chunga/CHANGELOG.txt =================================================================== --- trunk/thirdparty/chunga/CHANGELOG.txt 2009-11-30 13:24:17 UTC (rev 4477) +++ trunk/thirdparty/chunga/CHANGELOG.txt 2009-12-01 21:58:01 UTC (rev 4478) @@ -1,3 +1,7 @@ +Exported TOKEN-CHAR-P +Allowed START and END keyword arguments for TRIM-WHITESPACE +Simplified cookie value parsing + Version 1.0.0 2009-02-19 Switched to binary streams underneath and got rid of FLEXI-STREAMS dependency
Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-11-30 13:24:17 UTC (rev 4477) +++ trunk/thirdparty/chunga/doc/index.html 2009-12-01 21:58:01 UTC (rev 4478) @@ -85,6 +85,7 @@ <li><a href="#with-character-stream-semantics"><code>with-character-stream-semantics</code></a> <li><a href="#read-line*"><code>read-line*</code></a> <li><a href="#read-http-headers"><code>read-http-headers</code></a> + <li><a href="#token-char-p"><code>token-char-p</code></a> <li><a href="#read-token"><code>read-token</code></a> <li><a href="#read-name-value-pair"><code>read-name-value-pair</code></a> <li><a href="#read-name-value-pairs"><code>read-name-value-pairs</code></a> @@ -542,6 +543,19 @@
<!-- End of entry for READ-TOKEN -->
+<!-- Entry for TOKEN-CHAR-P --> + +<p><br>[Function]<br><a class=none name='token-char-p'><b>token-char-p</b> <i>char</i> => <i>generalized-boolean</i></a> +<blockquote><br> + +Returns a true value if the Lisp character CHAR is a token constituent +according to +<a href="http://www.rfc.net/rfc2616.html">RFC 2616</a>. + +</blockquote> + +<!-- End of entry for TOKEN-CHAR-P --> + <!-- Entry for READ-NAME-VALUE-PAIR -->
<p><br>[Function]<br><a class=none name='read-name-value-pair'><b>read-name-value-pair</b> <i>stream <tt>&key</tt> value-required-p cookie-syntax</i> => <i>pair</i></a> @@ -662,10 +676,10 @@
<!-- Entry for TRIM-WHITESPACE -->
-<p><br>[Function]<br><a class=none name='trim-whitespace'><b>trim-whitespace</b> <i>string</i> => <i>string'</i></a> +<p><br>[Function]<br><a class=none name='trim-whitespace'><b>trim-whitespace</b> <i>string <tt>&key</tt> start end</i> => <i>string'</i></a> <blockquote><br>
-Returns a version of the string <code><i>string</i></code> where spaces and tab +Returns a version of the string <code><i>string</i></code> (between <code><i>start</i></code> and <code><i>end</i></code>) where spaces and tab characters are trimmed from the start and the end.
</blockquote>
Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-11-30 13:24:17 UTC (rev 4477) +++ trunk/thirdparty/chunga/packages.lisp 2009-12-01 21:58:01 UTC (rev 4478) @@ -62,6 +62,7 @@ :read-token :skip-whitespace :syntax-error + :token-char-p :trim-whitespace :with-character-stream-semantics))
Modified: trunk/thirdparty/chunga/read.lisp =================================================================== --- trunk/thirdparty/chunga/read.lisp 2009-11-30 13:24:17 UTC (rev 4477) +++ trunk/thirdparty/chunga/read.lisp 2009-12-01 21:58:01 UTC (rev 4478) @@ -120,10 +120,10 @@ (finish-output log-stream)) result))
-(defun trim-whitespace (string) - "Returns a version of the string STRING where spaces and tab -characters are trimmed from the start and the end. Might return -STRING." +(defun trim-whitespace (string &key (start 0) (end (length string))) + "Returns a version of the string STRING (between START and END) +where spaces and tab characters are trimmed from the start and the +end. Might return STRING." ;; optimized version to replace STRING-TRIM, suggested by Jason Kantz (declare (optimize speed @@ -133,18 +133,18 @@ (compilation-speed 0) #+:lispworks (hcl:fixnum-safety 0))) (declare (string string)) - (let* ((length (length string)) - (start (loop for i of-type fixnum from 0 below length - while (or (char= #\space (char string i)) - (char= #\tab (char string i))) - finally (return i))) - (end (loop for i of-type fixnum downfrom (1- length) to 0 - while (or (char= #\space (char string i)) - (char= #\tab (char string i))) - finally (return (1+ i))))) - (declare (fixnum start end)) - (cond ((and (zerop start) (= end length)) string) - (t (subseq string start end))))) + (let* ((start% (loop for i of-type fixnum from start below end + while (or (char= #\space (char string i)) + (char= #\tab (char string i))) + finally (return i))) + (end% (loop for i of-type fixnum downfrom (1- end) to start + while (or (char= #\space (char string i)) + (char= #\tab (char string i))) + finally (return (1+ i))))) + (declare (fixnum start% end%)) + (cond ((and (zerop start%) (= end% (length string))) string) + ((> start% end%) "") + (t (subseq string start% end%)))))
(defun read-http-headers (stream &optional log-stream) "Reads HTTP header lines from STREAM (except for the initial @@ -243,24 +243,14 @@ (signal-unexpected-chars stream char '(#\Space #\Tab))))) (otherwise (write-char char out))))))
-(defun read-cookie-value (stream &key name separators) +(defun read-cookie-value (stream &key (separators ";")) "Reads a cookie parameter value from STREAM which is returned as a -string. Simply reads until a comma or a semicolon is seen (or an -element of SEPARATORS)." - (when (eql #, (peek-char* stream nil)) - (return-from read-cookie-value "")) +string. Simply reads until a semicolon is seen (or an element of +SEPARATORS)." (trim-whitespace (with-output-to-string (out) - ;; special case for the `Expires' parameter - maybe skip the first comma - (loop with separators% = (cond (separators) - ((equalp name "Expires") ";") - (t ",;")) - for char = (peek-char* stream nil) - until (or (null char) (find char separators% :test #'char=)) - when (and (null separators) - (or (char= char #,) - (digit-char-p char))) - do (setq separators% '(#, #;)) + (loop for char = (peek-char* stream nil) + until (or (null char) (find char separators :test #'char=)) do (write-char (read-char* stream) out)))))
(defun read-name-value-pair (stream &key (value-required-p t) cookie-syntax) @@ -272,7 +262,7 @@ internally." (skip-whitespace stream) (let ((name (if cookie-syntax - (read-cookie-value stream :separators "=,") + (read-cookie-value stream :separators "=") (read-token stream)))) (skip-whitespace stream) (cons name @@ -280,7 +270,7 @@ (eql (peek-char* stream nil) #=)) (assert-char stream #=) (skip-whitespace stream) - (cond (cookie-syntax (read-cookie-value stream :name name)) + (cond (cookie-syntax (read-cookie-value stream)) ((char= (peek-char* stream) #") (read-quoted-string stream)) (t (read-token stream)))))))
Modified: trunk/thirdparty/chunga/util.lisp =================================================================== --- trunk/thirdparty/chunga/util.lisp 2009-11-30 13:24:17 UTC (rev 4477) +++ trunk/thirdparty/chunga/util.lisp 2009-12-01 21:58:01 UTC (rev 4478) @@ -90,4 +90,4 @@ READ-CHAR* and friends (see above) to simulate a character stream although we're reading from a binary stream." `(let ((*char-buffer* nil)) - ,@body)) \ No newline at end of file + ,@body))