diff mbox series

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

Message ID 20210521082713.20169-2-othacehe@gnu.org
State Accepted
Headers show
Series Add keep-alive support to guix publish. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Mathieu Othacehe May 21, 2021, 8:27 a.m. UTC 
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 mbox series

Patch

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."