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