ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-07 03:44:06 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

publish: Preserve the request connection header.

Browse source 
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.
This commit is contained in:
Mathieu Othacehe 2021-05-21 10:19:20 +02:00
parent 4f2fa2f980
commit 2acc114a96
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 23 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
guix/scripts/publish.scm
View file

@ -33,6 +33,7 @@ (define-module (guix scripts publish)
#: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)
@ -980,6 +981,18 @@ (define (effective-compression requested-type compressions)
compressions)
(default-compression requested-type)))
(define (preserve-connection-headers request response)
"Add REQUEST's 'connection' header, if any, to HEADERS, a list of response
headers."
(if (pair? response)
(let ((connection
(assq 'connection (request-headers request))))
(append response
(if connection
(list connection)
'())))
response))
(define* (make-request-handler store
#:key
cache pool
@ -993,7 +1006,7 @@ (define nar-path?
(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)))
@ -1065,7 +1078,15 @@ (define nar-path?
(not-found request)))
(x (not-found request)))
(not-found request))))
(not-found request)))
;; Preserve the request's 'connection' header in 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 (preserve-connection-headers request response)
response-body))))
(define (service-name)
"Return the Avahi service name of the server."