Skip to content
Snippets Groups Projects
Unverified Commit 42d07286 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

publish: Factorize 'content-length' addition.

* guix/scripts/publish.scm (with-content-length): New procedure.
(http-write) <application/octet-stream>: Use it.
parent ba9f0db0
No related branches found
No related tags found
No related merge requests found
...@@ -365,6 +365,14 @@ (define (sans-content-length response) ...@@ -365,6 +365,14 @@ (define (sans-content-length response)
(response-headers response) (response-headers response)
eq?))) eq?)))
(define (with-content-length response length)
"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?))))
(define-syntax-rule (swallow-EPIPE exp ...) (define-syntax-rule (swallow-EPIPE exp ...)
"Swallow EPIPE errors raised by EXP..." "Swallow EPIPE errors raised by EXP..."
(catch 'system-error (catch 'system-error
...@@ -432,13 +440,8 @@ (define (http-write server client response body) ...@@ -432,13 +440,8 @@ (define (http-write server client response body)
(call-with-input-file (utf8->string body) (call-with-input-file (utf8->string body)
(lambda (input) (lambda (input)
(let* ((size (stat:size (stat input))) (let* ((size (stat:size (stat input)))
(headers (alist-cons 'content-length size (response (write-response (with-content-length response
(alist-delete 'content-length size)
(response-headers response)
eq?)))
(response (write-response (set-field response
(response-headers)
headers)
client)) client))
(output (response-port response))) (output (response-port response)))
(dump-port input output) (dump-port input output)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment