04/04: publish: Produce a "FileSize" narinfo field when possible.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit dff3189c7d5d95177ff592789e1bcb73a4adcc9e
Author: Ludovic Courtès <address@hidden>
Date:   Mon May 1 17:24:41 2017 +0200

    publish: Produce a "FileSize" narinfo field when possible.
    
    * guix/scripts/publish.scm (narinfo-string): Add #:file-size parameter.
    Produce a "FileSize" field when COMPRESSION is eq? to '%no-compression'
    or when FILE-SIZE is true.
    (bake-narinfo+nar): Pass #:file-size.
    * tests/publish.scm ("/*.narinfo")
    ("/*.narinfo with properly encoded '+' sign")
    ("with cache"): Check for "FileSize".
---
 guix/scripts/publish.scm | 18 +++++++++++++-----
 tests/publish.scm        | 25 +++++++++++++++++--------
 2 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 3faff06..a589f14 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -240,10 +240,12 @@ compression disabled~%"))
 
 (define* (narinfo-string store store-path key
                          #:key (compression %no-compression)
-                         (nar-path "nar"))
+                         (nar-path "nar") file-size)
   "Generate a narinfo key/value string for STORE-PATH; an exception is raised
 if STORE-PATH is invalid.  Produce a URL that corresponds to COMPRESSION.  The
-narinfo is signed with KEY.  NAR-PATH specifies the prefix for nar URLs."
+narinfo is signed with KEY.  NAR-PATH specifies the prefix for nar URLs.
+Optionally, FILE-SIZE can specify the size in bytes of the compressed NAR; it
+informs the client of how much needs to be downloaded."
   (let* ((path-info  (query-path-info store store-path))
          (compression (actual-compression store-path compression))
          (url        (encode-and-join-uri-path
@@ -257,6 +259,8 @@ narinfo is signed with KEY.  NAR-PATH specifies the prefix 
for nar URLs."
          (hash       (bytevector->nix-base32-string
                       (path-info-hash path-info)))
          (size       (path-info-nar-size path-info))
+         (file-size  (or file-size
+                         (and (eq? compression %no-compression) size)))
          (references (string-join
                       (map basename (path-info-references path-info))
                       " "))
@@ -268,10 +272,13 @@ URL: ~a
 Compression: ~a
 NarHash: sha256:~a
 NarSize: ~d
-References: ~a~%"
+References: ~a~%~a"
                              store-path url
                              (compression-type compression)
-                             hash size references))
+                             hash size references
+                             (if file-size
+                                 (format #f "FileSize: ~a~%" file-size)
+                                 "")))
          ;; Do not render a "Deriver" or "System" line if we are rendering
          ;; info for a derivation.
          (info       (if (not deriver)
@@ -465,7 +472,8 @@ requested using POOL."
           (display (narinfo-string store item
                                    (%private-key)
                                    #:nar-path nar-path
-                                   #:compression compression)
+                                   #:compression compression
+                                   #:file-size (stat:size (stat nar)))
                    port))))))
 
 ;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for
diff --git a/tests/publish.scm b/tests/publish.scm
index 233b71c..6238f37 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -122,13 +122,15 @@ URL: nar/~a
 Compression: none
 NarHash: sha256:~a
 NarSize: ~d
-References: ~a~%"
+References: ~a
+FileSize: ~a~%"
                   %item
                   (basename %item)
                   (bytevector->nix-base32-string
                    (path-info-hash info))
                   (path-info-nar-size info)
-                  (basename (first (path-info-references info)))))
+                  (basename (first (path-info-references info)))
+                  (path-info-nar-size info)))
          (signature (base64-encode
                      (string->utf8
                       (canonical-sexp->string
@@ -152,11 +154,13 @@ URL: nar/~a
 Compression: none
 NarHash: sha256:~a
 NarSize: ~d
-References: ~%"
+References: ~%\
+FileSize: ~a~%"
                   item
                   (uri-encode (basename item))
                   (bytevector->nix-base32-string
                    (path-info-hash info))
+                  (path-info-nar-size info)
                   (path-info-nar-size info)))
          (signature (base64-encode
                      (string->utf8
@@ -323,6 +327,7 @@ References: ~%"
           ("Compression" . "gzip"))
         200                                       ;nar/gzip/…
         #t                                        ;Content-Length
+        #t                                        ;FileSize
         200)                                      ;nar/…
   (call-with-temporary-directory
    (lambda (cache)
@@ -351,10 +356,11 @@ References: ~%"
               (response (http-get url)))
          (and (= 404 (response-code response))
               (wait-for-file cached)
-              (let ((body         (http-get-port url))
-                    (compressed   (http-get nar-url))
-                    (uncompressed (http-get (string-append base "nar/"
-                                                           (basename %item)))))
+              (let* ((body         (http-get-port url))
+                     (compressed   (http-get nar-url))
+                     (uncompressed (http-get (string-append base "nar/"
+                                                            (basename %item))))
+                     (narinfo      (recutils->alist body)))
                 (list (file-exists? nar)
                       (filter (lambda (item)
                                 (match item
@@ -362,10 +368,13 @@ References: ~%"
                                   (("StorePath" . _)  #t)
                                   (("URL" . _) #t)
                                   (_ #f)))
-                              (recutils->alist body))
+                              narinfo)
                       (response-code compressed)
                       (= (response-content-length compressed)
                          (stat:size (stat nar)))
+                      (= (string->number
+                          (assoc-ref narinfo "FileSize"))
+                         (stat:size (stat nar)))
                       (response-code uncompressed)))))))))
 
 (test-end "publish")