summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-04-17 23:13:40 +0200
committerLudovic Courtès <ludo@gnu.org>2017-04-18 23:18:41 +0200
commit00753f7038234a0f5a79be3ec9ab949840a18743 (patch)
tree69dd76db7c047953fd256933d399d3f6f0441e93 /tests
parent339a79fd6aec74f0b7520440e01b8bf79eca73e7 (diff)
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.
Diffstat (limited to 'tests')
-rw-r--r--tests/publish.scm54
1 files changed, 54 insertions, 0 deletions
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")