Dear drakma users,
I made drakma accept gzipped message bodies by default, and also
automatically decode them. A patch is attached.
Unfortunately this adds a new dependency on gzip-sequence (which in
turn depends on salza2). See the docstrings for more details. To sum
it up: if WANT-STREAM is T, It wraps the returned stream in a
flexi-stream that wraps a gzip-input-stream. Otherwise, it decodes
the sequence before returning from HTTP-REQUEST.
Thanks,
Red
Only in patched/: conditions.fasl
Only in patched/: cookies.fasl
Common subdirectories: drakma-1.1.0/doc and patched/doc
diff -u drakma-1.1.0/drakma.asd patched/drakma.asd
--- drakma-1.1.0/drakma.asd 2009-12-01 14:44:55.000000000 -0800
+++ patched/drakma.asd 2010-01-20 15:16:35.135381687 -0800
@@ -58,5 +58,6 @@
:cl-base64
:chunga
:flexi-streams
+ :gzip-stream
#-:lispworks :usocket
#-(or :lispworks :allegro) :cl+ssl))
Only in patched/: drakma.asd~
Only in patched/: packages.fasl
Only in patched/: read.fasl
Only in patched/: request.fasl
diff -u drakma-1.1.0/request.lisp patched/request.lisp
--- drakma-1.1.0/request.lisp 2009-12-01 14:36:55.000000000 -0800
+++ patched/request.lisp 2010-01-20 16:32:47.674544332 -0800
@@ -47,7 +47,7 @@
'("chunked" "identity")
:test #'equalp))
(null (set-difference content-encodings
- '("identity")
+ *decodable-content-encodings*
:test #'equalp)))
(let* ((charset (parameter-value "charset" params))
(name (cond (charset (as-keyword charset))
@@ -131,15 +131,19 @@
(format stream "--~A--" boundary)
(crlf))))
-(defun read-body (stream headers must-close textp)
+(defun read-body (stream headers must-close textp decodep)
"Reads the message body from the HTTP stream STREAM using the
information contained in HEADERS \(as produced by HTTP-REQUEST). If
-TEXTP is true, the body is assumed to be of content type `text' and
-will be returned as a string. Otherwise an array of octets \(or NIL
-for an empty body) is returned. Returns the optional `trailer' HTTP
-headers of the chunked stream \(if any) as a second value."
+DECODEP is true and a gzip `Content-Encoding' header is found, the
+body is gunzipped. If TEXTP is true, the body is assumed to be of
+content type `text' and will be returned as a string. Otherwise an
+array of octets \(or NIL for an empty body) is returned. Returns the
+optional `trailer' HTTP headers of the chunked stream \(if any) as a
+second value."
(let ((content-length (ignore-errors
(parse-integer (header-value :content-length headers))))
+ (gzip-encoded? (ignore-errors
+ (string-equal "gzip" (header-value :content-encoding headers))))
(element-type (if textp
#+:lispworks 'lw:simple-char #-:lispworks 'character
'octet))
@@ -154,6 +158,8 @@
#+:clisp
(setf (flexi-stream-element-type stream) 'octet)
(read-sequence result stream)
+ (when (and decodep gzip-encoded?)
+ (setf result (gzip-stream:gunzip-sequence result)))
(when textp
(setf result
(octets-to-string result :external-format (flexi-stream-external-format stream))
@@ -187,6 +193,8 @@
basic-authorization
(user-agent :drakma)
(accept "*/*")
+ (accept-encoding "gzip")
+ (decompress t)
proxy
proxy-basic-authorization
additional-headers
@@ -313,6 +321,15 @@
be a string which is used directly. ACCEPT, if not NIL, is the
`Accept' header sent.
+ACCEPT-ENCODING denotes the value for the `Accept-Encoding' header.
+The default value is \"gzip\" and a null value prevents the header
+from being sent. If DECOMPRESS is not NIL, and the resulting value
+has a \"gzip\" `Content-Encoding' header, then the content will
+automatically be decompressed: if the body is returned, it will be the
+decompressed body sequence or string; if WANT-STREAM is T, then
+BODY-OR-STREAM is a flexi-stream backed by a gzip-input-stream, which
+in turn wraps the socket stream.
+
If PROXY is not NIL, it should be a string denoting a proxy
server through which the request should be sent. Or it can be a
list of two values - a string denoting the proxy server and an
@@ -482,6 +499,7 @@
(cl+ssl:make-ssl-client-stream
(cl+ssl:stream-fd s)
:close-callback (lambda () (close s)))))))
+
(cond (stream
(setf (flexi-stream-element-type http-stream)
#+:lispworks 'lw:simple-char #-:lispworks 'character
@@ -532,6 +550,8 @@
(second proxy-basic-authorization)))))
(when accept
(write-header "Accept" "~A" accept))
+ (when accept-encoding
+ (write-header "Accept-Encoding" "~A" accept-encoding))
(when cookie-jar
;; write all cookies in one fell swoop, so even Sun's
;; web server has a chance to get it
@@ -669,30 +689,47 @@
(when (member "chunked" transfer-encodings :test #'equalp)
(setf (chunked-stream-input-chunking-p
(flexi-stream-stream http-stream)) t)))
- (when (setq external-format-body
- (and (not force-binary)
- (funcall *body-format-function*
- headers external-format-in)))
- (setf (flexi-stream-external-format http-stream)
- external-format-body))
+ (when (and
+ (setq external-format-body
+ (and (not force-binary)
+ (let ((*decodable-content-encodings*
+ (if (not decompress)
+ (remove "gzip" *decodable-content-encodings* :test #'equal)
+ *decodable-content-encodings*)))
+ (funcall *body-format-function*
+ headers external-format-in))))
+ (not (and decompress
+ (ignore-errors
+ (string-equal "gzip" (header-value :content-encoding headers))))))
+ (setf (flexi-stream-external-format http-stream)
+ external-format-body))
(when force-binary
(setf (flexi-stream-element-type http-stream) 'octet))
(unless (or want-stream (eq method :head))
(let (trailers)
(multiple-value-setq (body trailers)
- (read-body http-stream headers must-close external-format-body))
+ (read-body http-stream headers must-close external-format-body decompress))
(when trailers
(drakma-warn "Adding trailers from chunked encoding to HTTP headers.")
(setq headers (nconc headers trailers)))))
(setq done t)
- (values (cond (want-stream http-stream)
- (t body))
- status-code
- headers
- uri
- http-stream
- must-close
- status-text))))))
+ (let* ((client-stream
+ (cond ((and want-stream decompress
+ (ignore-errors
+ (string-equal "gzip" (header-value :content-encoding headers))))
+ (setf must-close t)
+ (make-flexi-stream (gzip-stream:make-gzip-input-stream http-stream)
+ :external-format external-format-body))
+ (t http-stream)))
+ (body-or-stream (cond (want-stream http-stream)
+ (t body))))
+ (values body-or-stream
+ status-code
+ headers
+ uri
+ client-stream
+ must-close
+ status-text)))))))
(when (eq content :continuation)
(return-from http-request #'finish-request))
(finish-request content))))
Only in patched/: request.lisp~
Only in patched/: specials.fasl
diff -u drakma-1.1.0/specials.lisp patched/specials.lisp
--- drakma-1.1.0/specials.lisp 2009-11-25 09:03:40.000000000 -0800
+++ patched/specials.lisp 2010-01-20 15:05:58.316225197 -0800
@@ -90,6 +90,12 @@
STRING-EQUAL to the car or if the car is NIL and if the subtype part
is STRING-EQUAL to the cdr or if the cdr is NIL.")
+(defvar *decodable-content-encodings* '("identity" "gzip")
+ "A list of values for the `Content-Encoding' header that Draka will
+decode before the body sequence is processed further in READ-BODY.
+This value may affect whether *BODY-FORMAT-FUNCTION* returns NIL or
+not.")
+
(defvar *body-format-function* 'determine-body-format
"A function which determines whether the content body returned by
the server is text and should be treated as such or not. The function
Only in patched/: specials.lisp~
Only in patched/: util.fasl
_______________________________________________
drakma-devel mailing list
drakma-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel
