futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

publish: Add support for lzip.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2019-05-24 08:26:38 +02:00
parent 4e48923e75
commit 66229b04ae
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 119 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.dir-locals.el
View File

@ -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))

25
doc/guix.texi
View File

@ -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

84
guix/scripts/publish.scm
View File

@ -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)))
@ -511,6 +525,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>.)
@ -715,6 +736,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
@ -789,12 +813,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 <>)))
@ -843,13 +878,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

36
tests/publish.scm
View File

@ -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"