mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-07 11:29:59 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

publish: Add keep-alive support when sending nar.

Browse source 
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): Rename it into ...
(nar-compressed-port): ... this procedure. Operate directly on a given PORT.
(http-write): Add keep-alive support when sending nar files.
* 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.
This commit is contained in:
Mathieu Othacehe 2021-05-20 10:42:56 +02:00
parent 2acc114a96
commit 0b8fa24bbd
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 101 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

135
guix/scripts/publish.scm
View file

@ -25,6 +25,7 @@
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 poll)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 threads) #:use-module (ice-9 threads)
@ -870,60 +871,115 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
exp ...) exp ...)
(const #f))) (const #f)))
(define (nar-response-port response compression) (define (nar-compressed-port port compression)
"Return a port on which to write the body of RESPONSE, the response of a "Return a port on which to write the body of the response of a /nar request,
/nar request, according to COMPRESSION." according to COMPRESSION."
(match compression (match compression
(($ <compression> 'gzip level) (($ <compression> 'gzip level)
;; Note: We cannot used chunked encoding here because ;; Note: We cannot used chunked encoding here because
;; 'make-gzip-output-port' wants a file port. ;; 'make-gzip-output-port' wants a file port.
(make-gzip-output-port (response-port response) (make-gzip-output-port port
#:level level #:level level
#:buffer-size %default-buffer-size)) #:buffer-size %default-buffer-size))
(($ <compression> 'lzip level) (($ <compression> 'lzip level)
(make-lzip-output-port (response-port response) (make-lzip-output-port port
#:level level)) #:level level))
(($ <compression> 'zstd level) (($ <compression> 'zstd level)
(make-zstd-output-port (response-port response) (make-zstd-output-port port
#:level level)) #:level level))
(($ <compression> 'none) (($ <compression> 'none)
(response-port response)) port)
(#f (#f
(response-port response)))) port)))
(define (http-write server client response body) (define (http-write server client response body)
"Write RESPONSE and BODY to CLIENT, possibly in a separate thread to avoid "Write RESPONSE and BODY to CLIENT, possibly in a separate thread to avoid
blocking." 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) (match (response-content-type response)
(('application/x-nix-archive . _) (('application/x-nix-archive . _)
;; Sending the the whole archive can take time so do it in a separate ;; When compressing the NAR on the go, we cannot announce its size
;; thread so that the main thread can keep working in the meantime. ;; beforehand to the client. Hence, the keep-alive mechanism cannot work
(call-with-new-thread ;; here.
(lambda () (let ((keep-alive? (and (eq? (compression-type compression) 'none)
(set-thread-name "publish nar") (keep-alive? response))))
(let* ((compression (assoc-ref (response-headers response) ;; Add the client to the server poll set, so that we can receive
'x-nar-compression)) ;; further requests without closing the connection.
(response (write-response (sans-content-length response) (when keep-alive?
client)) (keep-alive client))
(port (begin ;; Sending the the whole archive can take time so do it in a separate
(force-output client) ;; thread so that the main thread can keep working in the meantime.
(configure-socket client) (call-with-new-thread
(nar-response-port response compression)))) (lambda ()
;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in (set-thread-name "publish nar")
;; 'render-nar', BODY here is just the file name of the store item. (let* ((response (write-response (sans-content-length response)
;; We call 'write-file' from here because we know that's the only client))
;; way to avoid building the whole nar in memory, which could (port (begin
;; quickly become a real problem. As a bonus, we even do (force-output client)
;; sendfile(2) directly from the store files to the socket. (configure-socket client)
(swallow-zlib-error ;; Duplicate the response port, so that it is
(swallow-EPIPE ;; not automatically closed when closing the
(write-file (utf8->string body) port))) ;; returned port. This is needed for the
(swallow-zlib-error ;; keep-alive mechanism.
(close-port port)) (nar-compressed-port
(values))))) (duplicate-port
(response-port response) "w+0b")
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) (match (assoc-ref (response-headers response) 'x-raw-file)
((? string? file) ((? string? file)
(when (keep-alive? response)
(keep-alive client))
;; Send a raw file in a separate thread. ;; Send a raw file in a separate thread.
(call-with-new-thread (call-with-new-thread
(lambda () (lambda ()
@ -933,19 +989,20 @@ blocking."
(call-with-input-file file (call-with-input-file file
(lambda (input) (lambda (input)
(let* ((size (stat:size (stat input))) (let* ((size (stat:size (stat input)))
(response (write-response (with-content-length response (response (write-response
size) (with-content-length response size)
client)) client))
(output (response-port response))) (output (response-port response)))
(configure-socket client) (configure-socket client)
(if (file-port? output) (if (file-port? output)
(sendfile output input size) (sendfile output input size)
(dump-port input output)) (dump-port input output))
(close-port output) (unless (keep-alive? response)
(close-port output))
(values))))) (values)))))
(lambda args (lambda args
;; If the file was GC'd behind our back, that's fine. Likewise if ;; If the file was GC'd behind our back, that's fine. Likewise
;; the client closes the connection. ;; if the client closes the connection.
(unless (memv (system-error-errno args) (unless (memv (system-error-errno args)
(list ENOENT EPIPE ECONNRESET)) (list ENOENT EPIPE ECONNRESET))
(apply throw args)) (apply throw args))

7
guix/scripts/substitute.scm
View file

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