[bug#48556] [PATCH 0/4] Add keep-alive support to guix publish.

[bug#48556] [PATCH 0/4] Add keep-alive support to guix publish.

[Mathieu Othacehe]

Hello,

The default Guile web server implementation supports the keep alive
mechanism. However, in our custom http-write implementation, the connection
is unconditionally close after sending NAR files.

When the publish server is sitting behind an Nginx server, like on the Berlin
build farm, Nginx is taking care of keeping the client connections
alive. However, the keep alive mechanism is not supported between Nginx and
guix publish.

Likewise, when running an independant publish server, the connection will be
closed by the publish server each time a NAR file is sent.

To prevent that, extend the keep alive mechanism support to the publish server
when sending NAR files and to the substitute script when receiving them.

Thanks,

Mathieu

Mathieu Othacehe (4):
  scripts: publish: Add keep-alive support when sending NAR.
  scripts: publish: Forward the request connection header.
  progress: Add a download-size argument to progress-report-port.
  scripts: substitute: Add keep-alive support when reading NAR.

 guix/progress.scm           |  16 +++-
 guix/scripts/publish.scm    | 171 +++++++++++++++++++++++++-----------
 guix/scripts/substitute.scm |   7 +-
 3 files changed, 139 insertions(+), 55 deletions(-)

-- 
2.31.1

[bug#48556] [PATCH 1/4] scripts: publish: Add keep-alive support when sending NAR.

[Mathieu Othacehe]

The default Guile web server implementation supports the keep alive
mechanism. However, in our custom http-write implementation, the connection
is unconditionally close after sending NAR files.

To prevent that, when supported, add the client port to the server poll set so
that further requests can be handled without closing the connection.

* guix/scripts/publish.scm (nar-response-port): Duplicate the response port.
(http-write): Add keep-alive support when sending NAR files.
---
 guix/scripts/publish.scm | 150 ++++++++++++++++++++++++++-------------
 1 file changed, 102 insertions(+), 48 deletions(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index ef6fa5f074..19fed574c2 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -25,6 +25,7 @@
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 poll)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 threads)
@@ -872,57 +873,109 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
 (define (nar-response-port response compression)
   "Return a port on which to write the body of RESPONSE, the response of a
 /nar request, according to COMPRESSION."
-  (match compression
-    (($ <compression> 'gzip level)
-     ;; Note: We cannot used chunked encoding here because
-     ;; 'make-gzip-output-port' wants a file port.
-     (make-gzip-output-port (response-port response)
-                            #:level level
-                            #:buffer-size %default-buffer-size))
-    (($ <compression> 'lzip level)
-     (make-lzip-output-port (response-port response)
-                            #:level level))
-    (($ <compression> 'zstd level)
-     (make-zstd-output-port (response-port response)
-                            #:level level))
-    (($ <compression> 'none)
-     (response-port response))
-    (#f
-     (response-port response))))
+  ;; Duplicate the response port, so that it is not automatically closed when
+  ;; closing the returned port.  This is needed for the keep-alive mechanism.
+  (let ((port (duplicate-port
+               (response-port response) "w+0b")))
+    (match compression
+      (($ <compression> 'gzip level)
+       ;; Note: We cannot used chunked encoding here because
+       ;; 'make-gzip-output-port' wants a file port.
+       (make-gzip-output-port port
+                              #:level level
+                              #:buffer-size %default-buffer-size))
+      (($ <compression> 'lzip level)
+       (make-lzip-output-port port
+                              #:level level))
+      (($ <compression> 'zstd level)
+       (make-zstd-output-port port
+                              #:level level))
+      (($ <compression> 'none)
+       port)
+      (#f
+       port))))
 
 (define (http-write server client response body)
   "Write RESPONSE and BODY to CLIENT, possibly in a separate thread to avoid
 blocking."
+  ;; XXX: The default Guile web server implementation supports the keep-alive
+  ;; mechanism.  However, as we run our own modified version of the http-write
+  ;; procedure, we need to access a few server implementation details to keep
+  ;; it functional.
+  (define *error-events*
+    (logior POLLHUP POLLERR))
+
+  (define *read-events*
+    POLLIN)
+
+  (define *events*
+    (logior *error-events* *read-events*))
+
+  ;; Access the server poll set variable.
+  (define http-poll-set
+    (@@ (web server http) http-poll-set))
+
+  ;; Copied from (web server http).
+  (define (keep-alive? response)
+    (let ((v (response-version response)))
+      (and (or (< (response-code response) 400)
+               (= (response-code response) 404))
+           (case (car v)
+             ((1)
+              (case (cdr v)
+                ((1) (not (memq 'close (response-connection response))))
+                ((0) (memq 'keep-alive (response-connection response)))))
+             (else #f)))))
+
+  (define (keep-alive port)
+    "Add the given PORT the server poll set."
+    (force-output port)
+    (poll-set-add! (http-poll-set server) port *events*))
+
+  (define compression
+    (assoc-ref (response-headers response) 'x-nar-compression))
+
   (match (response-content-type response)
     (('application/x-nix-archive . _)
-     ;; Sending the the whole archive can take time so do it in a separate
-     ;; thread so that the main thread can keep working in the meantime.
-     (call-with-new-thread
-      (lambda ()
-        (set-thread-name "publish nar")
-        (let* ((compression (assoc-ref (response-headers response)
-                                       'x-nar-compression))
-               (response    (write-response (sans-content-length response)
-                                            client))
-               (port        (begin
-                              (force-output client)
-                              (configure-socket client)
-                              (nar-response-port response compression))))
-          ;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in
-          ;; 'render-nar', BODY here is just the file name of the store item.
-          ;; We call 'write-file' from here because we know that's the only
-          ;; way to avoid building the whole nar in memory, which could
-          ;; quickly become a real problem.  As a bonus, we even do
-          ;; sendfile(2) directly from the store files to the socket.
-          (swallow-zlib-error
-           (swallow-EPIPE
-            (write-file (utf8->string body) port)))
-          (swallow-zlib-error
-           (close-port port))
-          (values)))))
+     ;; When compressing the NAR on the go, we cannot announce its size
+     ;; beforehand to the client. Hence, the keep-alive mechanism cannot work
+     ;; here.
+     (let ((keep-alive? (and (eq? (compression-type compression) 'none)
+                             (keep-alive? response))))
+       ;; Add the client to the server poll set, so that we can receive
+       ;; further requests without closing the connection.
+       (when keep-alive?
+         (keep-alive client))
+       ;; Sending the the whole archive can take time so do it in a separate
+       ;; thread so that the main thread can keep working in the meantime.
+       (call-with-new-thread
+        (lambda ()
+          (set-thread-name "publish nar")
+          (let* ((response    (write-response (sans-content-length response)
+                                              client))
+                 (port        (begin
+                                (force-output client)
+                                (configure-socket client)
+                                (nar-response-port response compression))))
+            ;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093>
+            ;; in 'render-nar', BODY here is just the file name of the store
+            ;; item.  We call 'write-file' from here because we know that's
+            ;; the only way to avoid building the whole nar in memory, which
+            ;; could quickly become a real problem.  As a bonus, we even do
+            ;; sendfile(2) directly from the store files to the socket.
+            (swallow-zlib-error
+             (swallow-EPIPE
+              (write-file (utf8->string body) port)))
+            (swallow-zlib-error
+             (close-port port)
+             (unless keep-alive?
+               (close-port client)))
+            (values))))))
     (_
      (match (assoc-ref (response-headers response) 'x-raw-file)
        ((? string? file)
+        (when (keep-alive? response)
+          (keep-alive client))
         ;; Send a raw file in a separate thread.
         (call-with-new-thread
          (lambda ()
@@ -932,19 +985,20 @@ blocking."
                (call-with-input-file file
                  (lambda (input)
                    (let* ((size     (stat:size (stat input)))
-                          (response (write-response (with-content-length response
-                                                                         size)
-                                                    client))
+                          (response (write-response
+                                     (with-content-length response size)
+                                     client))
                           (output   (response-port response)))
                      (configure-socket client)
                      (if (file-port? output)
                          (sendfile output input size)
                          (dump-port input output))
-                     (close-port output)
+                     (unless (keep-alive? response)
+                       (close-port output))
                      (values)))))
              (lambda args
-               ;; If the file was GC'd behind our back, that's fine.  Likewise if
-               ;; the client closes the connection.
+               ;; If the file was GC'd behind our back, that's fine.  Likewise
+               ;; if the client closes the connection.
                (unless (memv (system-error-errno args)
                              (list ENOENT EPIPE ECONNRESET))
                  (apply throw args))
-- 
2.31.1

[bug#48556] [PATCH 2/4] scripts: publish: Forward the request connection header.

[Mathieu Othacehe]

The Guile web server is reading the response connection header to decide
whether to close the connection. However, as the request connection header is
not forwarded to the response, this mechanism cannot work.

* guix/scripts/publish.scm (add-extra-headers): New procedure.
(make-request-handler): Use it to forward the request connection header to the
response.
---
 guix/scripts/publish.scm | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 19fed574c2..260f98edf0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -34,6 +34,7 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -1034,6 +1035,14 @@ methods, return the applicable compression."
             compressions)
       (default-compression requested-type)))
 
+(define (add-extra-headers request response)
+  "Append the REQUEST connection header to the given RESPONSE headers and
+return them."
+  (if (pair? response)
+      `(,@response
+        ,(assq 'connection (request-headers request)))
+      response))
+
 (define* (make-request-handler store
                                #:key
                                cache pool
@@ -1047,7 +1056,7 @@ methods, return the applicable compression."
     (let ((expected (split-and-decode-uri-path nar-path)))
       (cut equal? expected <>)))
 
-  (lambda (request body)
+  (define (handle request body)
     (format #t "~a ~a~%"
             (request-method request)
             (uri-path (request-uri request)))
@@ -1119,7 +1128,15 @@ methods, return the applicable compression."
                (not-found request)))
 
           (x (not-found request)))
-        (not-found request))))
+        (not-found request)))
+
+  ;; Forward the request connection header to the response, so that the server
+  ;; can close the connection if this is requested by the client.
+  (lambda (request body)
+    (let-values (((response response-body)
+                  (handle request body)))
+      (values (add-extra-headers request response)
+              response-body))))
 
 (define (service-name)
   "Return the Avahi service name of the server."
-- 
2.31.1

[bug#48556] [PATCH 3/4] progress: Add a download-size argument to progress-report-port.

[Mathieu Othacehe]

* guix/progress.scm (progress-report-port): Add a download-size argument.
---
 guix/progress.scm | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/guix/progress.scm b/guix/progress.scm
index 334bd40547..0cbc804ec1 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -347,15 +347,25 @@ should be a <progress-reporter> object."
               (report total)
               (loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
 
-(define* (progress-report-port reporter port #:key (close? #t))
+(define* (progress-report-port reporter port
+                               #:key
+                               (close? #t)
+                               download-size)
   "Return a port that continuously reports the bytes read from PORT using
 REPORTER, which should be a <progress-reporter> object.  When CLOSE? is true,
-PORT is closed when the returned port is closed."
+PORT is closed when the returned port is closed.
+
+When DOWNLOAD-SIZE is passed, do not read more than DOWNLOAD-SIZE bytes from
+PORT.  This is important to avoid blocking when the remote side won't close
+the underlying connection."
   (match reporter
     (($ <progress-reporter> start report stop)
      (let* ((total 0)
             (read! (lambda (bv start count)
-                     (let ((n (match (get-bytevector-n! port bv start count)
+                     (let* ((count (if download-size
+                                       (min count (- download-size total))
+                                       count))
+                            (n (match (get-bytevector-n! port bv start count)
                                 ((? eof-object?) 0)
                                 (x x))))
                        (set! total (+ total n))
-- 
2.31.1

[bug#48556] [PATCH 4/4] scripts: substitute: Add keep-alive support when reading NAR.

[Mathieu Othacehe]

* guix/scripts/substitute.scm (process-substitution): Pass the download size
to the progress-report-port procedure so that it doesn't block reading from
the input port when keep-alive is supported.
---
 guix/scripts/substitute.scm | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 8e4eae00b3..54311c3e08 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -518,8 +518,11 @@ PORT."
                                          (current-error-port)
                                          #:abbreviation nar-uri-abbreviation))))
                      ;; Keep RAW open upon completion so we can later reuse
-                     ;; the underlying connection.
-                     (progress-report-port reporter raw #:close? #f)))
+                     ;; the underlying connection.  Pass the download size so
+                     ;; that this procedure won't block reading from RAW.
+                     (progress-report-port reporter raw
+                                           #:close? #f
+                                           #:download-size dl-size)))
                   ((input pids)
                    ;; NOTE: This 'progress' port of current process will be
                    ;; closed here, while the child process doing the
-- 
2.31.1

[bug#48556] [PATCH 0/4] Add keep-alive support to guix publish.

[Ludovic Courtès]

Hi!

Great that you’re fixing this.

Mathieu Othacehe <othacehe@gnu.org> skribis:

> The default Guile web server implementation supports the keep alive
> mechanism. However, in our custom http-write implementation, the connection
> is unconditionally close after sending NAR files.
>
> To prevent that, when supported, add the client port to the server poll set so
> that further requests can be handled without closing the connection.
>
> * guix/scripts/publish.scm (nar-response-port): Duplicate the response port.
> (http-write): Add keep-alive support when sending NAR files.

Nitpick: you can use just “publish:” as the prefix in the subject line,
and s/NAR/nar/.  :-)

Does this patch alone work?  It seems to me that all 4 patches are
needed to actually get keep-alive support, no?

Also, this is specifically about keep-alive support for nar requests,
right?  My understanding is that other requests (narinfo in particular)
already benefit from keep-alive support in (web server).

>  (define (nar-response-port response compression)
>    "Return a port on which to write the body of RESPONSE, the response of a
>  /nar request, according to COMPRESSION."
> -  (match compression
> -    (($ <compression> 'gzip level)
> -     ;; Note: We cannot used chunked encoding here because
> -     ;; 'make-gzip-output-port' wants a file port.
> -     (make-gzip-output-port (response-port response)
> -                            #:level level
> -                            #:buffer-size %default-buffer-size))
> -    (($ <compression> 'lzip level)
> -     (make-lzip-output-port (response-port response)
> -                            #:level level))
> -    (($ <compression> 'zstd level)
> -     (make-zstd-output-port (response-port response)
> -                            #:level level))
> -    (($ <compression> 'none)
> -     (response-port response))
> -    (#f
> -     (response-port response))))
> +  ;; Duplicate the response port, so that it is not automatically closed when
> +  ;; closing the returned port.  This is needed for the keep-alive mechanism.
> +  (let ((port (duplicate-port
> +               (response-port response) "w+0b")))

Maybe it would be clearer if this were done at the call site, in
‘http-write’, where we can see the ‘close-port’ call a few lines below.

Otherwise LGTM.

Did you have a chance to try out the whole patch series “in production”?
It would be nice to try it out so we can catch any issues we might have
overlooked (random I/O errors, FD leaks, etc.)

Thanks,
Ludo’.

[bug#48556] [PATCH 0/4] Add keep-alive support to guix publish.

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

> The Guile web server is reading the response connection header to decide
> whether to close the connection. However, as the request connection header is
> not forwarded to the response, this mechanism cannot work.
>
> * guix/scripts/publish.scm (add-extra-headers): New procedure.
> (make-request-handler): Use it to forward the request connection header to the
> response.

[...]

> +(define (add-extra-headers request response)
> +  "Append the REQUEST connection header to the given RESPONSE headers and
> +return them."
> +  (if (pair? response)
> +      `(,@response
> +        ,(assq 'connection (request-headers request)))
> +      response))

How about:

  (define (preserve-connection-header request headers)
    "Add REQUEST's 'connection' header, if any, to HEADERS, a list of
  response headers.
    …)

?

> +  ;; Forward the request connection header to the response, so that the server
> +  ;; can close the connection if this is requested by the client.

I’d write: “Preserve the request's 'connection' header in the response
[…]”.  Quoting “connection” simplifies parsing IMO.

Otherwise LGTM!

Ludo’.

[bug#48556] [PATCH 0/4] Add keep-alive support to guix publish.

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

> * guix/progress.scm (progress-report-port): Add a download-size argument.

LGTM! 

[bug#48556] [PATCH 0/4] Add keep-alive support to guix publish.

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

> * guix/scripts/substitute.scm (process-substitution): Pass the download size
> to the progress-report-port procedure so that it doesn't block reading from
> the input port when keep-alive is supported.

LGTM.  I expect this one to be absolutely necessary.  Should it be
merged with #1?

Thanks,
Ludo’.

bug#48556: [PATCH 0/4] Add keep-alive support to guix publish.

[Mathieu Othacehe]

Hey Ludo!

Thanks for having a look :).

> Also, this is specifically about keep-alive support for nar requests,
> right?  My understanding is that other requests (narinfo in particular)
> already benefit from keep-alive support in (web server).

Yes that's right.

> Maybe it would be clearer if this were done at the call site, in
> ‘http-write’, where we can see the ‘close-port’ call a few lines below.

I took your remarks into account, merged two patches and reorganized
them a bit before pushing.

> Did you have a chance to try out the whole patch series “in production”?
> It would be nice to try it out so we can catch any issues we might have
> overlooked (random I/O errors, FD leaks, etc.)

I only tested it locally, but I'll monitor closely the impact of this
patchset on Berlin.

Thanks,

Mathieu