X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/0aeb13485055975d71ec8283040f007c79599bba..20710b911f7784c5602799181d6f108814695b31:/tests/publish.scm diff --git a/tests/publish.scm b/tests/publish.scm index 0e793c1ee5..e43310ef00 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson -;;; Copyright © 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +36,7 @@ #:use-module (gcrypt pk-crypto) #:use-module ((guix pki) #:select (%public-key-file %private-key-file)) #:use-module (guix zlib) + #:use-module (guix lzlib) #:use-module (web uri) #:use-module (web client) #:use-module (web response) @@ -44,6 +45,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (ice-9 threads) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 rdelim)) @@ -63,12 +65,12 @@ (let ((socket (open-socket-for-uri uri))) ;; Make sure to use an unbuffered port so that we can then peek at the ;; underlying file descriptor via 'call-with-gzip-input-port'. - (setvbuf socket _IONBF) + (setvbuf socket 'none) (call-with-values (lambda () (http-get uri #:port socket #:streaming? #t)) (lambda (response port) - ;; Don't (setvbuf port _IONBF) because of + ;; Don't (setvbuf port 'none) because of ;; (PORT might be a custom binary input port). port)))) @@ -137,22 +139,21 @@ "StorePath: ~a URL: nar/~a Compression: none +FileSize: ~a NarHash: sha256:~a NarSize: ~d -References: ~a -FileSize: ~a~%" +References: ~a~%" %item (basename %item) + (path-info-nar-size info) (bytevector->nix-base32-string (path-info-hash info)) (path-info-nar-size info) - (basename (first (path-info-references info))) - (path-info-nar-size info))) + (basename (first (path-info-references info))))) (signature (base64-encode (string->utf8 (canonical-sexp->string - ((@@ (guix scripts publish) signed-string) - unsigned-info)))))) + (signed-string unsigned-info)))))) (format #f "~aSignature: 1;~a;~a~%" unsigned-info (gethostname) signature)) (utf8->string @@ -169,21 +170,20 @@ FileSize: ~a~%" "StorePath: ~a URL: nar/~a Compression: none +FileSize: ~a NarHash: sha256:~a NarSize: ~d -References: ~%\ -FileSize: ~a~%" +References: ~%" item (uri-encode (basename item)) + (path-info-nar-size info) (bytevector->nix-base32-string (path-info-hash info)) - (path-info-nar-size info) (path-info-nar-size info))) (signature (base64-encode (string->utf8 (canonical-sexp->string - ((@@ (guix scripts publish) signed-string) - unsigned-info)))))) + (signed-string unsigned-info)))))) (format #f "~aSignature: 1;~a;~a~%" unsigned-info (gethostname) signature)) @@ -229,6 +229,19 @@ FileSize: ~a~%" (string-append "/nar/gzip/" (basename %item)))))) (get-bytevector-n nar (bytevector-length %gzip-magic-bytes)))) +(unless (lzlib-available?) + (test-skip 1)) +(test-equal "/nar/lzip/*" + "bar" + (call-with-temporary-output-file + (lambda (temp port) + (let ((nar (http-get-port + (publish-uri + (string-append "/nar/lzip/" (basename %item)))))) + (call-with-lzip-input-port nar + (cut restore-file <> temp))) + (call-with-input-file temp read-string)))) + (unless (zlib-available?) (test-skip 1)) (test-equal "/*.narinfo with compression" @@ -251,6 +264,28 @@ FileSize: ~a~%" (_ #f))) (recutils->alist body))))) +(unless (lzlib-available?) + (test-skip 1)) +(test-equal "/*.narinfo with lzip compression" + `(("StorePath" . ,%item) + ("URL" . ,(string-append "nar/lzip/" (basename %item))) + ("Compression" . "lzip")) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6790" "-Clzip")))))) + (wait-until-ready 6790) + (let* ((url (string-append "http://localhost:6790/" + (store-path-hash-part %item) ".narinfo")) + (body (http-get-port url))) + (filter (lambda (item) + (match item + (("Compression" . _) #t) + (("StorePath" . _) #t) + (("URL" . _) #t) + (_ #f))) + (recutils->alist body))))) + (unless (zlib-available?) (test-skip 1)) (test-equal "/*.narinfo for a compressed file" @@ -265,6 +300,35 @@ FileSize: ~a~%" (list (assoc-ref info "Compression") (dirname (assoc-ref info "URL"))))) +(unless (and (zlib-available?) (lzlib-available?)) + (test-skip 1)) +(test-equal "/*.narinfo with lzip + gzip" + `((("StorePath" . ,%item) + ("URL" . ,(string-append "nar/gzip/" (basename %item))) + ("Compression" . "gzip") + ("URL" . ,(string-append "nar/lzip/" (basename %item))) + ("Compression" . "lzip")) + 200 + 200) + (call-with-temporary-directory + (lambda (cache) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2")))))) + (wait-until-ready 6793) + (let* ((base "http://localhost:6793/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (body (http-get-port url))) + (list (take (recutils->alist body) 5) + (response-code + (http-get (string-append base "nar/gzip/" + (basename %item)))) + (response-code + (http-get (string-append base "nar/lzip/" + (basename %item)))))))))) + (test-equal "custom nar path" ;; Serve nars at /foo/bar/chbouib instead of /nar. (list `(("StorePath" . ,%item) @@ -405,16 +469,64 @@ FileSize: ~a~%" (stat:size (stat nar))) (response-code uncompressed))))))))) +(unless (and (zlib-available?) (lzlib-available?)) + (test-skip 1)) +(test-equal "with cache, lzip + gzip" + '(200 200 404) + (call-with-temporary-directory + (lambda (cache) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2" + (string-append "--cache=" cache))))))) + (wait-until-ready 6794) + (let* ((base "http://localhost:6794/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (nar-url (cute string-append "nar/" <> "/" + (basename %item))) + (cached (cute string-append cache "/" <> "/" + (basename %item) ".narinfo")) + (nar (cute string-append cache "/" <> "/" + (basename %item) ".nar")) + (response (http-get url))) + (wait-for-file (cached "gzip")) + (let* ((body (http-get-port url)) + (narinfo (recutils->alist body)) + (uncompressed (string-append base "nar/" + (basename %item)))) + (and (file-exists? (nar "gzip")) + (file-exists? (nar "lzip")) + (equal? (take (pk 'narinfo/gzip+lzip narinfo) 7) + `(("StorePath" . ,%item) + ("URL" . ,(nar-url "gzip")) + ("Compression" . "gzip") + ("FileSize" . ,(number->string + (stat:size (stat (nar "gzip"))))) + ("URL" . ,(nar-url "lzip")) + ("Compression" . "lzip") + ("FileSize" . ,(number->string + (stat:size (stat (nar "lzip"))))))) + (list (response-code + (http-get (string-append base (nar-url "gzip")))) + (response-code + (http-get (string-append base (nar-url "lzip")))) + (response-code + (http-get 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 #t + (* 42 3600) ;TTL on narinfo `(("StorePath" . ,item) ("URL" . ,(string-append "nar/" (basename item))) ("Compression" . "none")) 200 ;nar/… + (* 42 3600) ;TTL on nar/… (path-info-nar-size (query-path-info %store item)) ;FileSize 404) ;nar/gzip/… @@ -423,7 +535,7 @@ FileSize: ~a~%" (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () - (guix-publish "--port=6796" "-C2" + (guix-publish "--port=6796" "-C2" "--ttl=42h" (string-append "--cache=" cache))))))) (wait-until-ready 6796) (let* ((base "http://localhost:6796/") @@ -437,13 +549,19 @@ FileSize: ~a~%" (and (= 404 (response-code response)) (wait-for-file cached) - (let* ((body (http-get-port url)) + (let* ((response (http-get url)) + (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) + (match (assq-ref (response-headers response) + 'cache-control) + ((('max-age . ttl)) ttl) + (_ #f)) + (filter (lambda (item) (match item (("Compression" . _) #t) @@ -452,10 +570,44 @@ FileSize: ~a~%" (_ #f))) narinfo) (response-code uncompressed) + (match (assq-ref (response-headers uncompressed) + 'cache-control) + ((('max-age . ttl)) ttl) + (_ #f)) + (string->number (assoc-ref narinfo "FileSize")) (response-code compressed)))))))))) +(test-equal "with cache, vanishing item" ; + 200 + (call-with-temporary-directory + (lambda (cache) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6795" + (string-append "--cache=" cache))))))) + (wait-until-ready 6795) + + ;; Make sure that, even if ITEM disappears, we're still able to fetch + ;; it. + (let* ((base "http://localhost:6795/") + (item (add-text-to-store %store "random" (random-text))) + (part (store-path-hash-part item)) + (url (string-append base part ".narinfo")) + (cached (string-append cache + (if (zlib-available?) + "/gzip/" "/none/") + (basename item) + ".narinfo")) + (response (http-get url))) + (and (= 404 (response-code response)) + (wait-for-file cached) + (begin + (delete-paths %store (list item)) + (response-code (pk 'response (http-get url)))))))))) + (test-equal "/log/NAME" `(200 #t application/x-bzip2) (let ((drv (run-with-store %store