Browse files

v1.3.51: add get-request-body-incremental

Add get-request-body-incremental to retrieve the body of a PUT or POST
and pass it to the caller a chunk at a time.

  Added test to t-aserve.html.

Add function get-request-body-incremental to allow the server
to retrieve a potentially large request body in pieces.
See aserve.html for details

updated aserve.html to describe get-request-body-incremental

Change-Id: I723ae36f7ba60657825ed7e5a781835ab1f4e5d3
Reviewed-by: John Foderaro <>
Reviewed-by: Kevin Layer <>
Tested-by: Kevin Layer <>
  • Loading branch information...
John Foderaro authored and dklayer committed May 10, 2017
1 parent 6bebe0f commit 5cb0c9bc267c906965b4ae179596bc7411af8a5b
Showing with 241 additions and 5 deletions.
  1. +27 −0 doc/aserve.html
  2. +149 −1
  3. +7 −4
  4. +58 −0 test/
@@ -67,6 +67,7 @@ <h2 align="left">Table of Contents</h2>
<font face="Courier New">&nbsp; <a href="#f-with-http-response">with-http-response</a><br>
&nbsp; <a href="#f-with-http-body">with-http-body</a><br>
&nbsp; <a href="#f-get-request-body">get-request-body</a><br>
&nbsp; <a href="#f-get-request-body-incremental">get-request-body-incremental</a><br>
&nbsp; <a href="#f-header-slot-value">header-slot-value</a><br>
&nbsp; <a href="#f-reply-header-slot-value">reply-header-slot-value</a><br>
&nbsp; <a href="#f-request-query">request-query</a><br>
@@ -1500,6 +1501,31 @@ <h2><a name="generating-a-computed-response"></a>Generating a computed
function.&nbsp;&nbsp; This
reconversion does not affect the cached value.</p>
<p><a name="f-get-request-body-incremental"></a><strong><font face="Courier New">(get-request-body-incremental
request function
Reads the body of a PUT or POST <b>request</b> and passes it to a <b>function</b>
given by the caller. The function should take two arguments: vector and count.
The vector is a simple-array of (unsigned-byte 8) and count is the number
of bytes of data in the vector. The final time the function
is called the value of count will be zero indicating there is no more
data to follow.
The same vector will be passed on each call.
The caller can pass in a simple-array of (unsigned-byte 8) as the value
of the <b>:buffer</b> argument. If no buffer is supplied by the caller one will
be allocated by the function.
This function or <b>get-request-body</b> can be called but not both.
This function treats the body of the request as a sequence of bytes.
If you wish to convert it to a string you'll need to collect
the whole body and call <b>octets-to-string</b> with the appropriate
external format.
<p><a name="f-header-slot-value"></a><strong><font face="Courier New">(header-slot-value
@@ -1516,6 +1542,7 @@ <h2><a name="generating-a-computed-response"></a>Generating a computed
a string..</em></p>
<p><a name="f-reply-header-slot-value"></a><font face="Courier New"><strong>(reply-header-slot-value
@@ -19,7 +19,7 @@
(defparameter *aserve-version* '(1 3 50))
(defparameter *aserve-version* '(1 3 51))
(eval-when (eval load)
(require :sock)
@@ -2203,6 +2203,154 @@ by keyword symbols and not by strings"
(setf (stream-external-format (request-socket req)) original-ef)
(defmethod get-request-body-incremental ((req http-request)
&key (buffer
(make-array 4096
:element-type '(unsigned-byte 8))))
;; Read the data sent with a :put or :post request as binary
;; data, and send it a chunk at a time to a caller supplied
;; function. The function will be passed two arguments
;; buffer vector of (unsigned-byte 8)
;; count number of bytes of data in the buffer
;; When the count it zero it means "end of file"
(declare (optimize speed))
(let* ((original-ef (stream-external-format (request-socket req)))
(buffsize (length buffer)))
(if* (not (typep buffer '(simple-array (unsigned-byte 8) (*))))
then (error "buffer ~s is not a (simple-array (unsigned-byte 8) (*))"
(if* (or (request-request-body req)
(not (member (request-method req) '(:put :post))))
then ; Either this is not a put or post
; or the body has already been retrieved, can't do again
; so just indicate eof and leave.
(funcall function buffer 0)
(return-from get-request-body-incremental nil))
; this indicates that we've read the body, so we don't try to read
; it again
(setf (request-request-body req) "")
(if* (request-has-continue-expectation req)
then (send-100-continue req))
(setf (stream-external-format (request-socket req))
(find-external-format :octets))
(multiple-value-bind (length believe-it)
(header-slot-value-integer req :content-length)
(if* believe-it
then ; we know the length
(let ((left length)
(setq this (min left buffsize))
buffer this
(request-socket req)
(wserver-read-request-body-timeout *wserver*))
(funcall function buffer this)
(decf left this)
(if* (<= left 0)
then (return))))
(funcall function buffer 0)
; netscape (at least) is buggy in that
; it sends a crlf after
; the body. We have to eat that crlf.
; We could check
; which browser is calling us but it's
; not clear what
; is the set of buggy browsers
(let ((ch (read-char-no-hang
(request-socket req)
nil nil)))
(if* (eq ch #\return)
then ; now look for linefeed
(setq ch (read-char-no-hang
(request-socket req)
nil nil))
(if* (eq ch #\linefeed)
else (unread-char
ch (request-socket req)))
elseif ch
then (unread-char ch (request-socket
elseif (equalp "chunked" (header-slot-value req
then ; chunked body
((wserver-read-request-body-timeout *wserver*) nil)
(let ((index 0)
(sock (make-instance-unchunking-stream+input-handle (request-socket req)))
(loop (if* (eq :eof
(setq ch (read-char sock nil :eof)))
;; Chunked requests may contain trailing 'headers'
(if* (> index 0)
then (funcall function buffer index))
; send
(funcall function buffer 0)
(close sock) ;; this *only* closes the unchunker
(let ((trailers
(unchunking-trailers sock))))
(if* trailers
then (setf (request-headers req)
(append (request-headers req) trailers))))
(return nil)
else (setf (ausb8 buffer index)
(char-code ch))
(if* (>= (incf index) buffsize)
then (funcall function buffsize)
(setq index 0))))))
else ; no content length given
(if* (keep-alive-specified req)
then ; must be no body
(funcall function nil 0)
else ; read until the end of file
((wserver-read-request-body-timeout *wserver*)
(let ((index 0)
(sock (request-socket req))
(loop (if* (eq :eof
(setq ch
sock nil :eof)))
then (if* (> index 0)
then (funcall function buffer index))
(funcall function buffer 0)
(return nil)
else (setf (ausb8 buffer index)
(char-code ch))
(if* (>= (incf index) buffsize)
then (funcall function buffsize)
(setq index 0)))))))))
; uwp cleanup
(setf (stream-external-format (request-socket req)) original-ef))))
;; multipart code
;; used when enctype=multipart/form-data is used
@@ -5,15 +5,17 @@
;; See the file LICENSE for the full license governing this code.
#+(version= 10 1)
(sys:defpatch "aserve" 2
"v2: 1.3.50: define deflate-stream methods all the time;
(sys:defpatch "aserve" 3
"v3: 1.3.51 add get-request-body-incremental;
v2: 1.3.50: define deflate-stream methods all the time;
v1: 1.3.49: speed up read-sock-line."
:type :system
:post-loadable t)
#+(version= 10 0)
(sys:defpatch "aserve" 13
"v13: 1.3.50: define deflate-stream methods all the time;
(sys:defpatch "aserve" 14
"v14: 1.3.51 add get-request-body-incremental;
v13: 1.3.50: define deflate-stream methods all the time;
v12: 1.3.49: speed up read-sock-line;
v11: 1.3.45 - avoid races in constructor initialization;
v10: no version change, fix defpatch;
@@ -119,6 +121,7 @@ without compression. Original error loading deflate was:~%~a~%~:@>" c)
#:handle-uri ; add-on component..
@@ -281,6 +281,7 @@
(test-authorization port)
(test-forms port)
(test-get-request-body-incr port)
(test-client port)
(test-cgi port)
(test-http-copy-file port)
@@ -1412,6 +1413,63 @@ Returns a vector."
:content-type "text/plain")
(defvar *get-request-body-incr-value*
(let* ((size 16000)
(vec (make-array size :element-type '(unsigned-byte 8))))
(dotimes (i size) (setf (aref vec i) (random 255)))
(defun test-get-request-body-incr (port)
:path "/get-request-body-incr-test"
:content-type "text/plain"
:function #'(lambda (req ent)
(let (bufs
req #'(lambda (buffer size)
(if* got-zero
then ; never should get
; callback after zero
(setq after-zero t))
(if* (eql size 0)
then (setq got-zero t)
else (push (subseq buffer 0 size) bufs))))
; test that the callback function got a zero size
(test t got-zero)
; test that the zero was the last value sent the
; callback function
(test nil after-zero)
; test that the callback function received
; the correct value
(let ((res (apply #'concatenate
(nreverse bufs))))
(test t
(equalp res *get-request-body-incr-value*))))
; response doesn't matter, we'e done the testing already
(with-http-response (req ent)
(with-http-body (req ent)
(net.html.generator:html "foo the bar")
(let ((prefix-local (format nil "http://localhost:~a" port)))
(x-do-http-request (format nil "~a/get-request-body-incr-test"
:method :put
:content *get-request-body-incr-value*
:content-type "application/binary")

0 comments on commit 5cb0c9b

Please sign in to comment.