From 00753f7038234a0f5a79be3ec9ab949840a18743 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 17 Apr 2017 23:13:40 +0200
Subject: publish: Add '--cache' and '--workers'.

Fixes <http://bugs.gnu.org/26201>.
Reported by <dian_cecht@zoho.com>.

These options allow nars to be "baked" off-line and cached instead of
being compressed on the fly.  As a side-effect, this allows us to
provide a 'Content-Length' header for nars.

* guix/scripts/publish.scm (show-help, %options): Add '--cache' and
'--workers'.
(%default-options): Add 'workers'.
(nar-cache-file, narinfo-cache-file, run-single-baker): New procedures.
(single-baker): New macro.
(render-narinfo/cached, bake-narinfo+nar)
(render-nar/cached): New procedures.
(make-request-handler): Add #:cache and #:pool parameters and honor
them.
(run-publish-server): Likewise.
(guix-publish): Honor '--cache' and '--workers'.
* tests/publish.scm ("with cache"): New test.
* doc/guix.texi (Invoking guix publish): Document it.
---
 tests/publish.scm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)

(limited to 'tests/publish.scm')

diff --git a/tests/publish.scm b/tests/publish.scm
index ea0f4a3477..233b71ce93 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -314,4 +314,58 @@ References: ~%"
                               (call-with-input-string "" port-sha256))))))
     (response-code (http-get uri))))
 
+(unless (zlib-available?)
+  (test-skip 1))
+(test-equal "with cache"
+  (list #t
+        `(("StorePath" . ,%item)
+          ("URL" . ,(string-append "nar/gzip/" (basename %item)))
+          ("Compression" . "gzip"))
+        200                                       ;nar/gzip/…
+        #t                                        ;Content-Length
+        200)                                      ;nar/…
+  (call-with-temporary-directory
+   (lambda (cache)
+     (define (wait-for-file file)
+       (let loop ((i 20))
+         (or (file-exists? file)
+             (begin
+               (pk 'wait-for-file file)
+               (sleep 1)
+               (loop (- i 1))))))
+
+     (let ((thread (with-separate-output-ports
+                    (call-with-new-thread
+                     (lambda ()
+                       (guix-publish "--port=6797" "-C2"
+                                     (string-append "--cache=" cache)))))))
+       (wait-until-ready 6797)
+       (let* ((base     "http://localhost:6797/")
+              (part     (store-path-hash-part %item))
+              (url      (string-append base part ".narinfo"))
+              (nar-url  (string-append base "/nar/gzip/" (basename %item)))
+              (cached   (string-append cache "/gzip/" (basename %item)
+                                       ".narinfo"))
+              (nar      (string-append cache "/gzip/"
+                                       (basename %item) ".nar"))
+              (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)))))
+                (list (file-exists? nar)
+                      (filter (lambda (item)
+                                (match item
+                                  (("Compression" . _) #t)
+                                  (("StorePath" . _)  #t)
+                                  (("URL" . _) #t)
+                                  (_ #f)))
+                              (recutils->alist body))
+                      (response-code compressed)
+                      (= (response-content-length compressed)
+                         (stat:size (stat nar)))
+                      (response-code uncompressed)))))))))
+
 (test-end "publish")
-- 
cgit 1.4.1


From dff3189c7d5d95177ff592789e1bcb73a4adcc9e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 1 May 2017 17:24:41 +0200
Subject: 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(-)

(limited to 'tests/publish.scm')

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")
-- 
cgit 1.4.1


From 24b21720f7c3a368efc32017c126e107a5d76f52 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 11 May 2017 10:23:27 +0200
Subject: publish: Advertise a short TTL for "baking" 404s.

* guix/scripts/publish.scm (not-found): Add #:phrase and #:ttl
parameters and honor them.
* tests/publish.scm ("with cache"): Check the 'cache-control' header on
of the 404 response.
---
 guix/scripts/publish.scm | 15 +++++++++++----
 tests/publish.scm        |  7 +++++++
 2 files changed, 18 insertions(+), 4 deletions(-)

(limited to 'tests/publish.scm')

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index efaa549676..8da75cb825 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -300,10 +300,15 @@ References: ~a~%~a"
                       (canonical-sexp->string (signed-string info)))))
     (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
 
-(define (not-found request)
+(define* (not-found request
+                    #:key (phrase "Resource not found")
+                    ttl)
   "Render 404 response for REQUEST."
-  (values (build-response #:code 404)
-          (string-append "Resource not found: "
+  (values (build-response #:code 404
+                          #:headers (if ttl
+                                        `((cache-control (max-age . ,ttl)))
+                                        '()))
+          (string-append phrase ": "
                          (uri-path (request-uri request)))))
 
 (define (render-nix-cache-info)
@@ -434,7 +439,9 @@ requested using POOL."
                                                      (file-expiration-time ttl)
                                                      #:delete-entry delete-entry
                                                      #:cleanup-period ttl))))
-           (not-found request))
+           (not-found request
+                      #:phrase "We're baking it"
+                      #:ttl 300))              ;should be available within 5m
           (else
            (not-found request)))))
 
diff --git a/tests/publish.scm b/tests/publish.scm
index 6238f37bc1..268c324551 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -355,6 +355,13 @@ FileSize: ~a~%"
                                        (basename %item) ".nar"))
               (response (http-get url)))
          (and (= 404 (response-code response))
+
+              ;; We should get an explicitly short TTL for 404 in this case
+              ;; because it's going to become 200 shortly.
+              (match (assq-ref (response-headers response) 'cache-control)
+                ((('max-age . ttl))
+                 (< ttl 3600)))
+
               (wait-for-file cached)
               (let* ((body         (http-get-port url))
                      (compressed   (http-get nar-url))
-- 
cgit 1.4.1


From ffa5e0a6d2851832b7f0e6f943bc69e69e1bc8b0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 18 May 2017 21:19:49 +0200
Subject: publish: Fix narinfo rendering for already-compressed items.

Fixes <http://bugs.gnu.org/26975>.
Reported by Mark H Weaver <mhw@netris.org>.

* guix/scripts/publish.scm (bake-narinfo+nar): Pass #f as the 2nd
argument to 'stat' and properly handle #f.
* tests/publish.scm (wait-for-file): New procedure.
("with cache"): Remove 'wait-for-file' procedure.
("with cache, uncompressed"): New test.
---
 guix/scripts/publish.scm |  3 +-
 tests/publish.scm        | 71 ++++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 65 insertions(+), 9 deletions(-)

(limited to 'tests/publish.scm')

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 8da75cb825..db7f6a957e 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -481,7 +481,8 @@ requested using POOL."
                                    (%private-key)
                                    #:nar-path nar-path
                                    #:compression compression
-                                   #:file-size (stat:size (stat nar)))
+                                   #:file-size (and=> (stat nar #f)
+                                                      stat:size))
                    port))))))
 
 ;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for
diff --git a/tests/publish.scm b/tests/publish.scm
index 268c324551..31043f71fa 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -98,6 +98,18 @@
                (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
         (loop)))))
 
+(define (wait-for-file file)
+  ;; Wait until FILE shows up.
+  (let loop ((i 20))
+    (cond ((file-exists? file)
+           #t)
+          ((zero? i)
+           (error "file didn't show up" file))
+          (else
+           (pk 'wait-for-file file)
+           (sleep 1)
+           (loop (- i 1))))))
+
 ;; Wait until the two servers are ready.
 (wait-until-ready 6789)
 
@@ -331,14 +343,6 @@ FileSize: ~a~%"
         200)                                      ;nar/…
   (call-with-temporary-directory
    (lambda (cache)
-     (define (wait-for-file file)
-       (let loop ((i 20))
-         (or (file-exists? file)
-             (begin
-               (pk 'wait-for-file file)
-               (sleep 1)
-               (loop (- i 1))))))
-
      (let ((thread (with-separate-output-ports
                     (call-with-new-thread
                      (lambda ()
@@ -384,4 +388,55 @@ FileSize: ~a~%"
                          (stat:size (stat nar)))
                       (response-code uncompressed)))))))))
 
+(unless (zlib-available?)
+  (test-skip 1))
+(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
+                               (random-text))))
+  (test-equal "with cache, uncompressed"
+    (list #f
+          `(("StorePath" . ,item)
+            ("URL" . ,(string-append "nar/" (basename item)))
+            ("Compression" . "none"))
+          200                                     ;nar/…
+          (path-info-nar-size
+           (query-path-info %store item))         ;FileSize
+          404)                                    ;nar/gzip/…
+    (call-with-temporary-directory
+     (lambda (cache)
+       (let ((thread (with-separate-output-ports
+                      (call-with-new-thread
+                       (lambda ()
+                         (guix-publish "--port=6796" "-C2"
+                                       (string-append "--cache=" cache)))))))
+         (wait-until-ready 6796)
+         (let* ((base     "http://localhost:6796/")
+                (part     (store-path-hash-part item))
+                (url      (string-append base part ".narinfo"))
+                (cached   (string-append cache "/none/"
+                                         (basename item) ".narinfo"))
+                (nar      (string-append cache "/none/"
+                                         (basename item) ".nar"))
+                (response (http-get url)))
+           (and (= 404 (response-code response))
+
+                (wait-for-file cached)
+                (let* ((body         (http-get-port url))
+                       (compressed   (http-get (string-append base "nar/gzip/"
+                                                              (basename item))))
+                       (uncompressed (http-get (string-append base "nar/"
+                                                              (basename item))))
+                       (narinfo      (recutils->alist body)))
+                  (list (file-exists? nar)
+                        (filter (lambda (item)
+                                  (match item
+                                    (("Compression" . _) #t)
+                                    (("StorePath" . _)  #t)
+                                    (("URL" . _) #t)
+                                    (_ #f)))
+                                narinfo)
+                        (response-code uncompressed)
+                        (string->number
+                         (assoc-ref narinfo "FileSize"))
+                        (response-code compressed))))))))))
+
 (test-end "publish")
-- 
cgit 1.4.1