From 42d07286f42b82df2e4ea45e67c40da0f09f26ec Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 4 Dec 2016 00:38:30 +0100 Subject: publish: Factorize 'content-length' addition. * guix/scripts/publish.scm (with-content-length): New procedure. (http-write) : Use it. --- guix/scripts/publish.scm | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'guix/scripts') 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) -- cgit v1.2.3