publish: Factorize 'content-length' addition.
* guix/scripts/publish.scm (with-content-length): New procedure. (http-write) <application/octet-stream>: Use it.
This commit is contained in:
parent
ba9f0db08c
commit
42d07286f4
|
@ -365,6 +365,14 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
|
||||||
(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 @@ blocking."
|
||||||
(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)
|
||||||
|
|
Loading…
Reference in New Issue