Re: Streaming responses with Guile's web modules

[Roel Janssen <roel@gnu.org>]

Roel Janssen <roel@gnu.org> writes:

> Amirouche Boubekki <amirouche@hypermove.net> writes:
>
>> On 2018-09-18 21:42, Roel Janssen wrote:
>>> Dear Guilers,
>>>
>>> I'd like to implement a web server using the (web server) module, but
>>> allow for “streaming” results.  The way I imagine this would look like,
>>> is something like this:
>>>
>>> (define (request-handler request body)
>>>   (values '((content-type . (text/plain)))
>>>           ;; This function can build its response by writing to
>>>           ;; ‘port’, rather than to return the whole body as a
>>>           ;; string.
>>>           (lambda (port)
>>>             (format port "Hello world!"))))
>>>
>>> (run-server request-handler)
>>>
>>> Is this possible with the (web server) module?  If so, how?
>>
>> What you describe is exactly how it works. The second value can
>> be a bytevector, #f or a procedure that takes a port as argument.
>>
>> Here is an example use [0] and here is the code [1]
>>
>> [0]
>> https://framagit.org/a-guile-mind/culturia.next/blob/master/culturia/web/helpers.scm#L34
>> [1]
>> https://git.savannah.gnu.org/cgit/guile.git/tree/module/web/server.scm#n198
>>
>> Regards
>
> Thanks for your quick and elaborate reply!  I didn't realize that in
> writing the example I had written a working example.
>
> Looking at memory usage, it looks as if it puts all bytes produced by
> that function into memory at once before sending the HTTP response over
> the network.  Is that observation correct?  If so, can it be avoided?

I implemented a proof-of-concept "chunked" transfer that does not
consume too much memory.  It's hacky because it (mis)uses a bytevector to
pass the input-port for a file to the new 'http-write' function.  It
also ignores any header field set when serving the large response.

The next (and hopefully final) question: Can I combine this with
'run-server' from Fibers?

Here's the code:

--8<---------------cut here---------------start------------->8---
(use-modules (web server)
             (web request)
             (web response)
             (web http)
             (web uri)
             (ice-9 format)
             (ice-9 match)
             (ice-9 receive)
             (ice-9 rdelim)
             (ice-9 iconv)
             (ice-9 binary-ports)
             (rnrs bytevectors))

(define original-http-write
  (@@ (web server http) http-write))

(define (write-buffer-to-client client input-port buffer-size)
  (let* ((buffer (get-bytevector-n input-port buffer-size))
         (buffer-length (if (eof-object? buffer) 0 (bytevector-length buffer)))
         (end (string->utf8 "\r\n")))
    (when (> buffer-length 0)
      (put-bytevector client (string->utf8 (format #f "~x\r\n" buffer-length)))
      (put-bytevector client buffer)
      (put-bytevector client end)
      (force-output client))
    (when (= buffer-length buffer-size)
      (write-buffer-to-client client input-port buffer-size))))

(define (new-http-write server client response body)
  "Allow sending raw HTTP so we can serve large responses with little memory."
  (match (response-transfer-encoding response)
    [('(chunked) . _)
     (let ((input-port (fdes->inport (string->number (utf8->string body))))
           (buffer-size (expt 2 13)))
       (setvbuf input-port 'block buffer-size)
       (setvbuf client     'block (+ buffer-size 6))

       ;; Write the HTTP header.
       (for-each (lambda (line) (put-bytevector client (string->utf8 line)))
                 '("HTTP/1.1 200 OK\r\n"
                   "Content-Type: text/html;charset=utf-8\r\n"
                   "Transfer-Encoding: chunked\r\n"
                   "Connection: close\r\n\r\n"))

       ;; Write the file contents.
       (write-buffer-to-client client input-port buffer-size)

       ;; End the stream.
       (put-bytevector client (string->utf8 "0\r\n\r\n"))
       (close-port client))]
   [_ (original-http-write server client response body)]))

(define-server-impl concurrent-http-server
  (@@ (web server http) http-open)
  (@@ (web server http) http-read)
  new-http-write
  (@@ (web server http) http-close))

(define (process-input input-port output-port)
  (unless (or (port-closed? input-port)
              (port-closed? output-port))
    (let ((line (read-line input-port)))
      (if (eof-object? line)
          (begin
            (close-port input-port)
            #t)
          (begin
            (put-bytevector output-port (string->bytevector line "UTF-8"))
            (force-output output-port)
            (process-input input-port output-port))))))

(define (request-handler request body)
  (if (string-prefix? "/large-file-request" (uri-path (request-uri request)))
      (let* ((input-port (open-file "large-file.txt" "r"))
             (bv-handle  (string->utf8 (number->string (fileno input-port)))))
        (values '((transfer-encoding . ((chunked))))
                bv-handle))
      (values '((content-type      . (text/plain)))
              (lambda (port)
                (setvbuf port 'block (expt 2 20))
                (call-with-input-file "small-file.txt"
                  (lambda (input-port) (process-input input-port port)))))))

(run-server request-handler concurrent-http-server)
--8<---------------cut here---------------end--------------->8---

Kind regards,
Roel Janssen