aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/publish.scm4
-rw-r--r--guix/utils.scm6
-rw-r--r--tests/publish.scm14
3 files changed, 24 insertions, 0 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 2ca2aeebe3..8404e540f8 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -50,6 +50,7 @@
#:use-module (guix zlib)
#:use-module (guix ui)
#:use-module (guix scripts)
+ #:use-module ((guix utils) #:select (compressed-file?))
#:use-module ((guix build utils) #:select (dump-port))
#:export (guix-publish))
@@ -199,6 +200,9 @@ compression disabled~%"))
if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The
narinfo is signed with KEY."
(let* ((path-info (query-path-info store store-path))
+ (compression (if (compressed-file? store-path)
+ %no-compression
+ compression))
(url (encode-and-join-uri-path
`("nar"
,@(match compression
diff --git a/guix/utils.scm b/guix/utils.scm
index 9e1b8ead0a..c68094cf49 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -79,6 +79,7 @@
arguments-from-environment-variable
file-extension
file-sans-extension
+ compressed-file?
switch-symlinks
call-with-temporary-output-file
call-with-temporary-directory
@@ -551,6 +552,11 @@ minor version numbers from version-string."
(substring file 0 dot)
file)))
+(define (compressed-file? file)
+ "Return true if FILE denotes a compressed file."
+ (->bool (member (file-extension file)
+ '("gz" "bz2" "xz" "lz" "tgz" "tbz2" "zip"))))
+
(define (switch-symlinks link target)
"Atomically switch LINK, a symbolic link, to point to TARGET. Works
both when LINK already exists and when it does not."
diff --git a/tests/publish.scm b/tests/publish.scm
index 4dc807505c..7499553aeb 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -200,6 +200,20 @@ References: ~%"
(_ #f)))
(recutils->alist body)))))
+(unless (zlib-available?)
+ (test-skip 1))
+(test-equal "/*.narinfo for a compressed file"
+ '("none" "nar") ;compression-less nar
+ ;; Assume 'guix publish -C' is already running on port 6799.
+ (let* ((item (add-text-to-store %store "fake.tar.gz"
+ "This is a fake compressed file."))
+ (url (string-append "http://localhost:6799/"
+ (store-path-hash-part item) ".narinfo"))
+ (body (http-get-port url))
+ (info (recutils->alist body)))
+ (list (assoc-ref info "Compression")
+ (dirname (assoc-ref info "URL")))))
+
(test-equal "/nar/ with properly encoded '+' sign"
"Congrats!"
(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))