From: "Ludovic Courtès" <ludo@gnu.org>
To: 35880@debbugs.gnu.org
Cc: Pierre Neidhardt <mail@ambrevar.xyz>
Subject: [bug#35880] [PATCH 4/7] publish: Add support for lzip.
Date: Fri, 24 May 2019 15:42:35 +0200 [thread overview]
Message-ID: <20190524134238.22802-4-ludo@gnu.org> (raw)
In-Reply-To: <20190524134238.22802-1-ludo@gnu.org>
* guix/scripts/publish.scm (show-help, %options): Support '-C METHOD'
and '-C METHOD:LEVEL'.
(default-compression): New procedure.
(bake-narinfo+nar): Add lzip.
(nar-response-port): Likewise.
(string->compression-type): New procedure.
(make-request-handler): Generalize /nar/gzip handler to handle /nar/lzip
as well.
* tests/publish.scm ("/nar/lzip/*"): New test.
("/*.narinfo with lzip compression"): New test.
* doc/guix.texi (Invoking guix publish): Document it.
(Requirements): Mention lzlib.
---
.dir-locals.el | 2 +
doc/guix.texi | 25 +++++++++---
guix/scripts/publish.scm | 84 +++++++++++++++++++++++++++++-----------
tests/publish.scm | 36 +++++++++++++++++
4 files changed, 119 insertions(+), 28 deletions(-)
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
next prev parent reply other threads:[~2019-05-24 13:44 UTC|newest]
Thread overview: 31+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-24 13:31 [bug#35880] [PATCH 0/7] Lzip support for 'guix publish' and 'guix substitute' Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 1/7] lzlib: Add 'make-lzip-input-port/compressed' Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 2/7] utils: Test 'compressed-port' and 'decompressed-port' for both gzip and xz Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 3/7] utils: Support compression and decompression with lzip Ludovic Courtès
2019-05-25 17:27 ` Pierre Neidhardt
2019-05-26 19:52 ` Ludovic Courtès
2019-05-24 13:42 ` Ludovic Courtès [this message]
2019-05-24 13:42 ` [bug#35880] [PATCH 5/7] self: Add dependency on lzlib Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 6/7] gnu: guix: " Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 7/7] lzlib: 'lzread!' never returns more than it was asked for Ludovic Courtès
2019-05-25 17:31 ` Pierre Neidhardt
2019-05-26 19:54 ` Ludovic Courtès
2019-05-26 20:57 ` Pierre Neidhardt
2019-05-26 21:28 ` Ludovic Courtès
2019-05-27 7:00 ` Pierre Neidhardt
2019-05-27 10:00 ` Ludovic Courtès
2019-05-25 17:24 ` [bug#35880] [PATCH 1/7] lzlib: Add 'make-lzip-input-port/compressed' Pierre Neidhardt
2019-05-26 19:51 ` Ludovic Courtès
2019-05-27 15:45 ` Ludovic Courtès
2019-05-27 16:24 ` Pierre Neidhardt
2019-05-27 20:53 ` bug#35880: " Ludovic Courtès
2019-05-27 21:12 ` [bug#35880] " Pierre Neidhardt
2019-05-28 7:52 ` Ludovic Courtès
2019-05-28 8:46 ` Pierre Neidhardt
2019-05-28 13:47 ` Ludovic Courtès
2019-05-29 14:57 ` Pierre Neidhardt
2019-05-31 20:54 ` Ludovic Courtès
2019-06-01 6:02 ` Pierre Neidhardt
2019-06-01 9:41 ` Ludovic Courtès
2019-06-01 9:58 ` Pierre Neidhardt
2019-06-01 12:21 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190524134238.22802-4-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=35880@debbugs.gnu.org \
--cc=mail@ambrevar.xyz \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.