Toggle diff (275 lines)
diff --git a/.dir-locals.el b/.dir-locals.el
index 550e06ef09..f1196fd781 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -53,6 +53,8 @@
(eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
(eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1))
(eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1))
+ (eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1))
+ (eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1))
(eval . (put 'signature-case 'scheme-indent-function 1))
(eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
diff --git a/doc/guix.texi b/doc/guix.texi
index f176bb0163..b0de5632e7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -757,6 +757,11 @@ Support for build offloading (@pxref{Daemon Offload Setup}) and
@uref{https://github.com/artyom-poptsov/guile-ssh, Guile-SSH},
version 0.10.2 or later.
+@item
+When @url{https://www.nongnu.org/lzip/lzlib.html, lzlib} is available, lzlib
+substitutes can be used and @command{guix publish} can compress substitutes
+with lzlib.
+
@item
When @url{http://www.bzip.org, libbz2} is available,
@command{guix-daemon} can use it to compress build logs.
@@ -9656,12 +9661,20 @@ accept connections from any interface.
Change privileges to @var{user} as soon as possible---i.e., once the
server socket is open and the signing key has been read.
-@item --compression[=@var{level}]
-@itemx -C [@var{level}]
-Compress data using the given @var{level}. When @var{level} is zero,
-disable compression. The range 1 to 9 corresponds to different gzip
-compression levels: 1 is the fastest, and 9 is the best (CPU-intensive).
-The default is 3.
+@item --compression[=@var{method}[:@var{level}]]
+@itemx -C [@var{method}[:@var{level}]]
+Compress data using the given @var{method} and @var{level}. @var{method} is
+one of @code{lzip} and @code{gzip}; when @var{method} is omitted, @code{gzip}
+is used.
+
+When @var{level} is zero, disable compression. The range 1 to 9 corresponds
+to different compression levels: 1 is the fastest, and 9 is the best
+(CPU-intensive). The default is 3.
+
+Usually, @code{lzip} compresses noticeably better than @code{gzip} for a small
+increase in CPU usage; see
+@uref{https://nongnu.org/lzip/lzip_benchmark.html,benchmarks on the lzip Web
+page}.
Unless @option{--cache} is used, compression occurs on the fly and
the compressed streams are not
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index a236f3e45c..9e74d789ce 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,6 +51,7 @@
#:use-module (guix store)
#:use-module ((guix serialization) #:select (write-file))
#:use-module (guix zlib)
+ #:autoload (guix lzlib) (lzlib-available?)
#:use-module (guix cache)
#:use-module (guix ui)
#:use-module (guix scripts)
@@ -74,8 +75,8 @@ Publish ~a over HTTP.\n") %store-directory)
(display (G_ "
-u, --user=USER change privileges to USER as soon as possible"))
(display (G_ "
- -C, --compression[=LEVEL]
- compress archives at LEVEL"))
+ -C, --compression[=METHOD:LEVEL]
+ compress archives with METHOD at LEVEL"))
(display (G_ "
-c, --cache=DIRECTORY cache published items to DIRECTORY"))
(display (G_ "
@@ -121,6 +122,9 @@ Publish ~a over HTTP.\n") %store-directory)
;; Since we compress on the fly, default to fast compression.
(compression 'gzip 3))
+(define (default-compression type)
+ (compression type 3))
+
(define (actual-compression item requested)
"Return the actual compression used for ITEM, which may be %NO-COMPRESSION
if ITEM is already compressed."
@@ -153,18 +157,28 @@ if ITEM is already compressed."
name)))))
(option '(#\C "compression") #f #t
(lambda (opt name arg result)
- (match (if arg (string->number* arg) 3)
- (0
- (alist-cons 'compression %no-compression result))
- (level
- (if (zlib-available?)
- (alist-cons 'compression
- (compression 'gzip level)
- result)
- (begin
- (warning (G_ "zlib support is missing; \
-compression disabled~%"))
- result))))))
+ (let* ((colon (string-index arg #\:))
+ (type (cond
+ (colon (string-take arg colon))
+ ((string->number arg) "gzip")
+ (else arg)))
+ (level (if colon
+ (string->number*
+ (string-drop arg (+ 1 colon)))
+ (or (string->number arg) 3))))
+ (match level
+ (0
+ (alist-cons 'compression %no-compression result))
+ (level
+ (match (string->compression-type type)
+ ((? symbol? type)
+ (alist-cons 'compression
+ (compression type level)
+ result))
+ (_
+ (warning (G_ "~a: unsupported compression type~%")
+ type)
+ result)))))))
(option '(#\c "cache") #t #f
(lambda (opt name arg result)
(alist-cons 'cache arg result)))
@@ -483,6 +497,13 @@ requested using POOL."
#:level (compression-level compression)
#:buffer-size (* 128 1024))
(rename-file (string-append nar ".tmp") nar))
+ ('lzip
+ ;; Note: the file port gets closed along with the lzip port.
+ (call-with-lzip-output-port (open-output-file (string-append nar ".tmp"))
+ (lambda (port)
+ (write-file item port))
+ #:level (compression-level compression))
+ (rename-file (string-append nar ".tmp") nar))
('none
;; Cache nars even when compression is disabled so that we can
;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
@@ -687,6 +708,9 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(make-gzip-output-port (response-port response)
#:level level
#:buffer-size (* 64 1024)))
+ (($ <compression> 'lzip level)
+ (make-lzip-output-port (response-port response)
+ #:level level))
(($ <compression> 'none)
(response-port response))
(#f
@@ -761,12 +785,23 @@ blocking."
http-write
(@@ (web server http) http-close))
+(define (string->compression-type string)
+ "Return a symbol denoting the compression method expressed by STRING; return
+#f if STRING doesn't match any supported method."
+ (match string
+ ("gzip" (and (zlib-available?) 'gzip))
+ ("lzip" (and (lzlib-available?) 'lzip))
+ (_ #f)))
+
(define* (make-request-handler store
#:key
cache pool
narinfo-ttl
(nar-path "nar")
(compression %no-compression))
+ (define compression-type?
+ string->compression-type)
+
(define nar-path?
(let ((expected (split-and-decode-uri-path nar-path)))
(cut equal? expected <>)))
@@ -815,13 +850,18 @@ blocking."
;; is restarted with different compression parameters.
;; /nar/gzip/<store-item>
- ((components ... "gzip" store-item)
- (if (and (nar-path? components) (zlib-available?))
- (let ((compression (match compression
- (($ <compression> 'gzip)
- compression)
- (_
- %default-gzip-compression))))
+ ((components ... (? compression-type? type) store-item)
+ (if (nar-path? components)
+ (let* ((compression-type (string->compression-type type))
+ (compression (match compression
+ (($ <compression> type)
+ (if (eq? type compression-type)
+ compression
+ (default-compression
+ compression-type)))
+ (_
+ (default-compression
+ compression-type)))))
(if cache
(render-nar/cached store cache request store-item
#:ttl narinfo-ttl
diff --git a/tests/publish.scm b/tests/publish.scm
index 097ac036e0..10bc859695 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -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)
@@ -229,6 +230,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 +265,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"
--
2.21.0
