02/04: publish: Factorize 'content-length' addition.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 42d07286f42b82df2e4ea45e67c40da0f09f26ec
Author: Ludovic Courtès <address@hidden>
Date:   Sun Dec 4 00:38:30 2016 +0100

    publish: Factorize 'content-length' addition.
    
    * guix/scripts/publish.scm (with-content-length): New procedure.
    (http-write) <application/octet-stream>: Use it.
---
 guix/scripts/publish.scm |   17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 1b32f63..33a7b3b 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)