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:
Ludovic Courtès 2015-07-20 00:37:47 +02:00
parent 7f23fb0088
commit 94080a7263

View file

@ -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))))