Skip to content

Commit

Permalink
Add an option :want-stream to get the response body as a stream.
Browse files Browse the repository at this point in the history
  • Loading branch information
@fukamachi
fukamachi committed Jul 28, 2015
1 parent 308f483 commit e5fe1f7
Show file tree
Hide file tree
Showing 4 changed files with 75 additions and 36 deletions.
14 changes: 8 additions & 6 deletions README.markdown
View file
Original file line number Diff line number Diff line change
Expand Up @@ -229,6 +229,8 @@ All functions take similar arguments.
- The limit of redirections. The default is `5`. If the redirection exceeds the limit, functions return the last response (not raise a condition).
- `force-binary` (boolean)
- A flag for suppressing auto-decoding of the response body.
- `want-stream` (boolean)
- A flag to get the response body as a stream.
- `ssl-key-file`, `ssl-cert-file`, `ssl-key-password`
- for HTTPS connection
- `stream`
Expand All @@ -242,7 +244,7 @@ All functions take similar arguments.
(dex:request uri &key method version content headers basic-auth cookie-jar timeout
(keep-alive t) (use-connection-pool t) (max-redirects 5)
ssl-key-file ssl-cert-file ssl-key-password
stream verbose force-binary)
stream verbose force-binary want-stream)
;=> body
; status
; response-headers
Expand All @@ -267,39 +269,39 @@ This function signals `http-request-failed` when the HTTP status code is 4xx or
### \[Function\] get

```common-lisp
(dex:get uri &key version headers basic-auth cookie-jar keep-alive timeout max-redirects force-binary
(dex:get uri &key version headers basic-auth cookie-jar keep-alive timeout max-redirects force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password
stream verbose)
```

### \[Function\] post

```common-lisp
(dex:post uri &key version headers content cookie-jar keep-alive timeout force-binary
(dex:post uri &key version headers content cookie-jar keep-alive timeout force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password
stream verbose)
```

### \[Function\] head

```common-lisp
(dex:head uri &key version headers cookie-jar timeout max-redirects force-binary
(dex:head uri &key version headers cookie-jar timeout max-redirects
ssl-key-file ssl-cert-file ssl-key-password
stream verbose)
```

### \[Function\] put

```common-lisp
(dex:put uri &key version headers content cookie-jar keep-alive timeout force-binary
(dex:put uri &key version headers content cookie-jar keep-alive timeout force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password
stream verbose)
```

### \[Function\] delete

```common-lisp
(dex:delete uri &key version headers cookie-jar keep-alive timeout force-binary
(dex:delete uri &key version headers cookie-jar keep-alive timeout force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password
stream verbose)
```
Expand Down
2 changes: 2 additions & 0 deletions dexador.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@
:quri
:fast-io
:babel
:chunga
:flexi-streams
:cl-ppcre
:cl-cookie
:trivial-mimes
Expand Down
71 changes: 51 additions & 20 deletions src/backend/usocket.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,11 @@
:with-fast-output
:fast-write-sequence
:fast-write-byte)
(:import-from :chunga
:chunked-stream-input-chunking-p
:make-chunked-stream)
(:import-from :flexi-streams
:make-flexi-stream)
(:import-from :trivial-mimes
:mime)
(:import-from :cl-cookie
Expand All @@ -41,6 +46,7 @@
:url-encode-params
:merge-uris)
(:import-from :chipz
:make-decompressing-stream
:decompress
:make-dstate)
(:import-from :cl-base64
Expand Down Expand Up @@ -87,9 +93,10 @@
(go read-cr))))
eof)))

(defun read-response (stream has-body collect-headers)
(defun read-response (stream has-body collect-headers read-body)
(let* ((http (make-http-response))
(body-data (make-output-buffer))
(body-data (and read-body
(make-output-buffer)))
(headers-data (and collect-headers
(make-output-buffer)))
(header-finished-p nil)
Expand All @@ -107,8 +114,9 @@
transfer-encoding-p))
(setq finishedp t)))
:body-callback
(lambda (data start end)
(fast-write-sequence data body-data start end))
(and read-body
(lambda (data start end)
(fast-write-sequence data body-data start end)))
:finish-callback
(lambda ()
(setq finishedp t)))))
Expand All @@ -123,12 +131,17 @@
(not header-finished-p))
(fast-write-sequence buf headers-data))
(funcall parser buf)
until (or finishedp
(zerop (length buf))))
until (if read-body
(or finishedp
(zerop (length buf)))
header-finished-p))
(values http
(finish-output-buffer body-data)
(if read-body
(finish-output-buffer body-data)
stream)
(and collect-headers
(finish-output-buffer headers-data)))))
(finish-output-buffer headers-data))
transfer-encoding-p)))

(defun print-verbose-data (direction &rest data)
(flet ((boundary-line ()
Expand All @@ -152,24 +165,42 @@

(cond
((string= content-encoding "gzip")
(chipz:decompress nil (chipz:make-dstate :gzip) body))
(if (streamp body)
(chipz:make-decompressing-stream :gzip body)
(chipz:decompress nil (chipz:make-dstate :gzip) body)))
((string= content-encoding "deflate")
(chipz:decompress nil (chipz:make-dstate :deflate) body))
(if (streamp body)
(chipz:make-decompressing-stream :deflate body)
(chipz:decompress nil (chipz:make-dstate :deflate) body)))
(T body)))

(defun decode-body (content-type body)
(let ((charset (and content-type
(detect-charset content-type))))
(if charset
(handler-case
(babel:octets-to-string body :encoding charset)
(if (streamp body)
(flex:make-flexi-stream body :external-format charset)
(babel:octets-to-string body :encoding charset))
(error (e)
(warn (format nil "Failed to decode the body to ~S due to the following error (falling back to binary):~% ~A"
charset
e))
(return-from decode-body body)))
body)))

(defun convert-body (body content-encoding content-type chunkedp force-binary)
(let ((body (decompress-body content-encoding
(if (and (streamp body)
chunkedp)
(let ((chunked-stream (chunga:make-chunked-stream body)))
(setf (chunga:chunked-stream-input-chunking-p chunked-stream) t)
chunked-stream)
body))))
(if force-binary
body
(decode-body content-type body))))

(defun content-disposition (key val)
(format nil "Content-Disposition: form-data; name=\"~A\"~:[~;~:*; filename=\"~A\"~]~C~C"
key
Expand Down Expand Up @@ -260,7 +291,8 @@
(max-redirects 5)
ssl-key-file ssl-cert-file ssl-key-password
stream verbose
force-binary)
force-binary
want-stream)
(declare (ignorable ssl-key-file ssl-cert-file ssl-key-password)
(type float version))
(flet ((make-new-connection (uri)
Expand Down Expand Up @@ -389,9 +421,9 @@
(with-retrying (force-output stream)))

start-reading
(multiple-value-bind (http body response-headers-data)
(multiple-value-bind (http body response-headers-data transfer-encoding-p)
(with-retrying
(read-response stream (not (eq method :head)) verbose))
(read-response stream (not (eq method :head)) verbose (not want-stream)))
(let ((status (http-status http))
(response-headers (http-headers http)))
(when (= status 0)
Expand Down Expand Up @@ -453,12 +485,11 @@
(return-from request
(apply #'request location-uri args))))))
(finalize-connection stream (gethash "connection" response-headers) uri)
(let ((body (decompress-body (gethash "content-encoding" response-headers) body)))
(setf body
(if force-binary
body
(decode-body (gethash "content-type" response-headers)
body)))
(let ((body (convert-body body
(gethash "content-encoding" response-headers)
(gethash "content-type" response-headers)
transfer-encoding-p
force-binary)))
;; Raise an error when the HTTP response status code is 4xx or 50x.
(when (<= 400 status)
(http-request-failed-with-restarts status
Expand Down
24 changes: 14 additions & 10 deletions src/dexador.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,33 +33,37 @@
(cl-reexport:reexport-from :dexador.error)

(defun get (uri &rest args
&key version headers basic-auth cookie-jar keep-alive use-connection-pool timeout max-redirects force-binary
&key version headers basic-auth cookie-jar keep-alive use-connection-pool timeout max-redirects
force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password stream verbose)
(declare (ignore version headers basic-auth cookie-jar keep-alive use-connection-pool timeout max-redirects force-binary ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(declare (ignore version headers basic-auth cookie-jar keep-alive use-connection-pool timeout max-redirects force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(apply #'request uri :method :get args))

(defun post (uri &rest args
&key version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary
&key version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout
force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password stream verbose)
(declare (ignore version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(declare (ignore version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(apply #'request uri :method :post args))

(defun head (uri &rest args
&key version headers basic-auth cookie-jar timeout max-redirects force-binary
&key version headers basic-auth cookie-jar timeout max-redirects
ssl-key-file ssl-cert-file ssl-key-password stream verbose)
(declare (ignore version headers basic-auth cookie-jar timeout max-redirects force-binary ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(declare (ignore version headers basic-auth cookie-jar timeout max-redirects ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(apply #'request uri :method :head :use-connection-pool nil args))

(defun put (uri &rest args
&key version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary
&key version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout
force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password stream verbose)
(declare (ignore version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(declare (ignore version content headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(apply #'request uri :method :put args))

(defun delete (uri &rest args
&key version headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary
&key version headers basic-auth cookie-jar keep-alive use-connection-pool timeout
force-binary want-stream
ssl-key-file ssl-cert-file ssl-key-password stream verbose)
(declare (ignore version headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(declare (ignore version headers basic-auth cookie-jar keep-alive use-connection-pool timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose))
(apply #'request uri :method :delete args))

(defun ignore-and-continue (e)
Expand Down

0 comments on commit e5fe1f7

Please sign in to comment.