[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/07: publish: Use 'x-raw-file' internal response header.
From: |
Ludovic Courtès |
Subject: |
06/07: publish: Use 'x-raw-file' internal response header. |
Date: |
Sun, 7 Jan 2018 17:57:20 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 152b7beeacb72fe96fd5d3c0fd8b321e247c2c6c
Author: Ludovic Courtès <address@hidden>
Date: Fri Jan 5 00:15:51 2018 +0100
publish: Use 'x-raw-file' internal response header.
This adjusts the workaround for <http://bugs.gnu.org/21093> so that it's
not limited to a single content-type.
* guix/scripts/publish.scm (render-nar/cached): Add the 'x-raw-file'
header on the response.
(render-content-addressed-file): Likewise.
(with-content-length): Remove the 'x-raw-file' header.
(http-write): Instead of dispatching on 'application/octet-stream',
check whether 'x-raw-file' is set to determine whether to spawn a
thread.
---
guix/scripts/publish.scm | 86 +++++++++++++++++++++++++-----------------------
1 file changed, 45 insertions(+), 41 deletions(-)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 3f3bc26..3f73197 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -544,11 +544,12 @@ return it; otherwise, return 404."
#:compression compression)))
(if (file-exists? cached)
(values `((content-type . (application/octet-stream
- (charset . "ISO-8859-1"))))
- ;; XXX: We're not returning the actual contents, deferring
- ;; instead to 'http-write'. This is a hack to work around
- ;; <http://bugs.gnu.org/21093>.
- cached)
+ (charset . "ISO-8859-1")))
+ ;; XXX: We're not returning the actual contents, deferring
+ ;; instead to 'http-write'. This is a hack to work around
+ ;; <http://bugs.gnu.org/21093>.
+ (x-raw-file . ,cached))
+ #f)
(not-found request))))
(define (render-content-addressed-file store request
@@ -562,11 +563,12 @@ has the given HASH of type ALGO."
#:recursive? #f)))
(if (valid-path? store item)
(values `((content-type . (application/octet-stream
- (charset . "ISO-8859-1"))))
- ;; XXX: We're not returning the actual contents, deferring
- ;; instead to 'http-write'. This is a hack to work around
- ;; <http://bugs.gnu.org/21093>.
- item)
+ (charset . "ISO-8859-1")))
+ ;; XXX: We're not returning the actual contents,
+ ;; deferring instead to 'http-write'. This is a hack to
+ ;; work around <http://bugs.gnu.org/21093>.
+ (x-raw-file . ,item))
+ #f)
(not-found request)))
(not-found request)))
@@ -622,9 +624,9 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
"Return RESPONSE with a 'content-length' header set to LENGTH."
(set-field response (response-headers)
(alist-cons 'content-length length
- (alist-delete 'content-length
- (response-headers response)
- eq?))))
+ (fold alist-delete
+ (response-headers response)
+ '(content-length x-raw-file)))))
(define-syntax-rule (swallow-EPIPE exp ...)
"Swallow EPIPE errors raised by EXP..."
@@ -685,35 +687,37 @@ blocking."
(swallow-zlib-error
(close-port port))
(values)))))
- (('application/octet-stream . _)
- ;; Send a raw file in a separate thread.
- (call-with-new-thread
- (lambda ()
- (set-thread-name "publish file")
- (catch 'system-error
- (lambda ()
- (call-with-input-file (utf8->string body)
- (lambda (input)
- (let* ((size (stat:size (stat input)))
- (response (write-response (with-content-length response
- size)
- client))
- (output (response-port response)))
- (if (file-port? output)
- (sendfile output input size)
- (dump-port input output))
- (close-port output)
- (values)))))
- (lambda args
- ;; If the file was GC'd behind our back, that's fine. Likewise if
- ;; the client closes the connection.
- (unless (memv (system-error-errno args)
- (list ENOENT EPIPE ECONNRESET))
- (apply throw args))
- (values))))))
(_
- ;; Handle other responses sequentially.
- (%http-write server client response body))))
+ (match (assoc-ref (response-headers response) 'x-raw-file)
+ ((? string? file)
+ ;; Send a raw file in a separate thread.
+ (call-with-new-thread
+ (lambda ()
+ (set-thread-name "publish file")
+ (catch 'system-error
+ (lambda ()
+ (call-with-input-file file
+ (lambda (input)
+ (let* ((size (stat:size (stat input)))
+ (response (write-response (with-content-length
response
+ size)
+ client))
+ (output (response-port response)))
+ (if (file-port? output)
+ (sendfile output input size)
+ (dump-port input output))
+ (close-port output)
+ (values)))))
+ (lambda args
+ ;; If the file was GC'd behind our back, that's fine. Likewise
if
+ ;; the client closes the connection.
+ (unless (memv (system-error-errno args)
+ (list ENOENT EPIPE ECONNRESET))
+ (apply throw args))
+ (values))))))
+ (#f
+ ;; Handle other responses sequentially.
+ (%http-write server client response body))))))
(define-server-impl concurrent-http-server
;; A variant of Guile's built-in HTTP server that offloads possibly long
- branch master updated (b94f250 -> c04ffad), Ludovic Courtès, 2018/01/07
- 01/07: ui: Display hints that come along with '&message' conditions., Ludovic Courtès, 2018/01/07
- 02/07: ssh: Improve error reporting when retrieving files., Ludovic Courtès, 2018/01/07
- 06/07: publish: Use 'x-raw-file' internal response header.,
Ludovic Courtès <=
- 05/07: doc: Mark zlib as mandatory, libbz2 as optional., Ludovic Courtès, 2018/01/07
- 07/07: publish: Publish build logs., Ludovic Courtès, 2018/01/07
- 04/07: daemon: Make libbz2 an optional dependency., Ludovic Courtès, 2018/01/07
- 03/07: daemon: Add gzip log compression., Ludovic Courtès, 2018/01/07