diff options
| -rw-r--r-- | guix/scripts/publish.scm | 18 | ||||
| -rw-r--r-- | tests/publish.scm | 25 |
2 files changed, 30 insertions, 13 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 3faff061a7..a589f149d3 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 233b71ce93..6238f37bc1 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") |