diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-12-04 00:38:30 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-12-04 22:32:26 +0100 |
| commit | 42d07286f42b82df2e4ea45e67c40da0f09f26ec (patch) | |
| tree | 3eab045621c02f4c17fd226ba5b280868a644753 | |
| parent | ba9f0db08cca257d167a2e5900f350b50323d13f (diff) | |
| download | guix-42d07286f42b82df2e4ea45e67c40da0f09f26ec.tar guix-42d07286f42b82df2e4ea45e67c40da0f09f26ec.tar.gz | |
publish: Factorize 'content-length' addition.
* guix/scripts/publish.scm (with-content-length): New procedure.
(http-write) <application/octet-stream>: Use it.
| -rw-r--r-- | guix/scripts/publish.scm | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 1b32f639ea..33a7b3bd42 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -365,6 +365,14 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")." (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 @@ blocking." (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) |