mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 15:36:20 -05:00
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
1 changed files with 10 additions and 7 deletions
|
@ -365,6 +365,14 @@ (define (sans-content-length response)
|
|||
(response-headers response)
|
||||
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 ...)
|
||||
"Swallow EPIPE errors raised by EXP..."
|
||||
(catch 'system-error
|
||||
|
@ -432,13 +440,8 @@ (define (http-write server client response body)
|
|||
(call-with-input-file (utf8->string body)
|
||||
(lambda (input)
|
||||
(let* ((size (stat:size (stat input)))
|
||||
(headers (alist-cons 'content-length size
|
||||
(alist-delete 'content-length
|
||||
(response-headers response)
|
||||
eq?)))
|
||||
(response (write-response (set-field response
|
||||
(response-headers)
|
||||
headers)
|
||||
(response (write-response (with-content-length response
|
||||
size)
|
||||
client))
|
||||
(output (response-port response)))
|
||||
(dump-port input output)
|
||||
|
|
Loading…
Reference in a new issue