mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 15:36:20 -05:00
publish: Do not load archive content in memory.
Previously, before replying to a /nar/* request, 'guix publish' would first build up the whole nar into memory (as a consequence of <http://bugs.gnu.org/21093>), which obviously doesn't scale. * guix/scripts/publish.scm (render-nar): Return STORE-PATH instead of a procedure that calls 'write-file'. (sans-content-length): New procedure. (http-write): For 'x-nix-archive', don't call '%http-write'. Instead, call 'write-file' right from here, using BODY as the file name.
This commit is contained in:
parent
7f23fb0088
commit
94080a7263
1 changed files with 24 additions and 3 deletions
|
@ -27,6 +27,7 @@ (define-module (guix scripts publish)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-2)
|
#:use-module (srfi srfi-2)
|
||||||
|
#:use-module (srfi srfi-9 gnu)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (web http)
|
#:use-module (web http)
|
||||||
|
@ -207,8 +208,10 @@ (define (render-nar request store-item)
|
||||||
(if (file-exists? store-path)
|
(if (file-exists? store-path)
|
||||||
(values '((content-type . (application/x-nix-archive
|
(values '((content-type . (application/x-nix-archive
|
||||||
(charset . "ISO-8859-1"))))
|
(charset . "ISO-8859-1"))))
|
||||||
(lambda (port)
|
;; XXX: We're not returning the actual contents, deferring
|
||||||
(write-file store-path port)))
|
;; instead to 'http-write'. This is a hack to work around
|
||||||
|
;; <http://bugs.gnu.org/21093>.
|
||||||
|
store-path)
|
||||||
(not-found request))))
|
(not-found request))))
|
||||||
|
|
||||||
(define extract-narinfo-hash
|
(define extract-narinfo-hash
|
||||||
|
@ -236,6 +239,13 @@ (define (request-path-components request)
|
||||||
(define %http-write
|
(define %http-write
|
||||||
(@@ (web server http) http-write))
|
(@@ (web server http) http-write))
|
||||||
|
|
||||||
|
(define (sans-content-length response)
|
||||||
|
"Return RESPONSE without its 'content-length' header."
|
||||||
|
(set-field response (response-headers)
|
||||||
|
(alist-delete 'content-length
|
||||||
|
(response-headers response)
|
||||||
|
eq?)))
|
||||||
|
|
||||||
(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."
|
||||||
|
@ -245,7 +255,18 @@ (define (http-write server client response body)
|
||||||
;; thread so that the main thread can keep working in the meantime.
|
;; thread so that the main thread can keep working in the meantime.
|
||||||
(call-with-new-thread
|
(call-with-new-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(%http-write server client response body))))
|
(let* ((response (write-response (sans-content-length response)
|
||||||
|
client))
|
||||||
|
(port (response-port response)))
|
||||||
|
;; 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.
|
||||||
|
(write-file (utf8->string body) port)
|
||||||
|
(close-port port)
|
||||||
|
(values)))))
|
||||||
(_
|
(_
|
||||||
;; Handle other responses sequentially.
|
;; Handle other responses sequentially.
|
||||||
(%http-write server client response body))))
|
(%http-write server client response body))))
|
||||||
|
|
Loading…
Reference in a new issue