From ee2691fa33f117bcf51b148b81bb8bc4e7b13a58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 3 Jun 2019 22:27:25 +0200 Subject: [PATCH] services: guix-publish: Allow for multi-compression. This is a followup to b8fa86adfc01205f1d942af8cb57515eb3726c52. * guix/deprecation.scm (warn-about-deprecation): Make public. * gnu/services/base.scm ()[compression]: New field. [compression-level]: Default to #f. Add '%' to getter name. (guix-publish-configuration-compression-level): Define as deprecated. (default-compression): New procedure. (guix-publish-shepherd-service)[config->compression-options]: New procedure. Use 'match-record' instead of 'match'. * doc/guix.texi (Base Services): Remove 'compression-level' and document 'compression'. --- doc/guix.texi | 17 +++++-- gnu/services/base.scm | 107 +++++++++++++++++++++++++++--------------- guix/deprecation.scm | 1 + 3 files changed, 83 insertions(+), 42 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index c01eb3a656..a8f3a5ad27 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12232,10 +12232,19 @@ The TCP port to listen for connections. The host (and thus, network interface) to listen to. Use @code{"0.0.0.0"} to listen on all the network interfaces. -@item @code{compression-level} (default: @code{3}) -The gzip compression level at which substitutes are compressed. Use -@code{0} to disable compression altogether, and @code{9} to get the best -compression ratio at the expense of increased CPU usage. +@item @code{compression} (default: @code{'(("gzip" 3))}) +This is a list of compression method/level tuple used when compressing +substitutes. For example, to compress all substitutes with @emph{both} lzip +at level 7 and gzip at level 9, write: + +@example +'(("lzip" 7) ("gzip" 9)) +@end example + +Level 9 achieves the best compression ratio at the expense of increased CPU +usage, whereas level 1 achieves fast compression. + +An empty list disables compression altogether. @item @code{nar-path} (default: @code{"nar"}) The URL path at which ``nars'' can be fetched. @xref{Invoking guix diff --git a/gnu/services/base.scm b/gnu/services/base.scm index f709ca5519..c88a6ddec6 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -142,7 +142,8 @@ guix-publish-configuration-guix guix-publish-configuration-port guix-publish-configuration-host - guix-publish-configuration-compression-level + guix-publish-configuration-compression + guix-publish-configuration-compression-level ;deprecated guix-publish-configuration-nar-path guix-publish-configuration-cache guix-publish-configuration-ttl @@ -1748,8 +1749,12 @@ archive' public keys, with GUIX." (default 80)) (host guix-publish-configuration-host ;string (default "localhost")) - (compression-level guix-publish-configuration-compression-level ;integer - (default 3)) + (compression guix-publish-configuration-compression + (thunked) + (default (default-compression this-record + (current-source-location)))) + (compression-level %guix-publish-configuration-compression-level ;deprecated + (default #f)) (nar-path guix-publish-configuration-nar-path ;string (default "nar")) (cache guix-publish-configuration-cache ;#f | string @@ -1759,42 +1764,68 @@ archive' public keys, with GUIX." (ttl guix-publish-configuration-ttl ;#f | integer (default #f))) -(define guix-publish-shepherd-service - (match-lambda - (($ guix port host compression - nar-path cache workers ttl) - (list (shepherd-service - (provision '(guix-publish)) - (requirement '(guix-daemon)) - (start #~(make-forkexec-constructor - (list #$(file-append guix "/bin/guix") - "publish" "-u" "guix-publish" - "-p" #$(number->string port) - "-C" #$(number->string compression) - (string-append "--nar-path=" #$nar-path) - (string-append "--listen=" #$host) - #$@(if workers - #~((string-append "--workers=" - #$(number->string - workers))) - #~()) - #$@(if ttl - #~((string-append "--ttl=" - #$(number->string ttl) - "s")) - #~()) - #$@(if cache - #~((string-append "--cache=" #$cache)) - #~())) +(define-deprecated (guix-publish-configuration-compression-level config) + "Return a compression level, the old way." + (match (guix-publish-configuration-compression config) + (((_ level) _ ...) level))) - ;; Make sure we run in a UTF-8 locale so we can produce - ;; nars for packages that contain UTF-8 file names such - ;; as 'nss-certs'. See . - #:environment-variables - (list (string-append "GUIX_LOCPATH=" - #$glibc-utf8-locales "/lib/locale") - "LC_ALL=en_US.utf8"))) - (stop #~(make-kill-destructor))))))) +(define (default-compression config properties) + "Return the default 'guix publish' compression according to CONFIG, and +raise a deprecation warning if the 'compression-level' field was used." + (match (%guix-publish-configuration-compression-level config) + (#f + '(("gzip" 3))) + (level + (warn-about-deprecation 'compression-level properties + #:replacement 'compression) + `(("gzip" ,level))))) + +(define (guix-publish-shepherd-service config) + (define (config->compression-options config) + (match (guix-publish-configuration-compression config) + (() ;empty list means "no compression" + '("-C0")) + (lst + (append-map (match-lambda + ((type level) + `("-C" ,(string-append type ":" + (number->string level))))) + lst)))) + + (match-record config + (guix port host nar-path cache workers ttl) + (list (shepherd-service + (provision '(guix-publish)) + (requirement '(guix-daemon)) + (start #~(make-forkexec-constructor + (list #$(file-append guix "/bin/guix") + "publish" "-u" "guix-publish" + "-p" #$(number->string port) + #$@(config->compression-options config) + (string-append "--nar-path=" #$nar-path) + (string-append "--listen=" #$host) + #$@(if workers + #~((string-append "--workers=" + #$(number->string + workers))) + #~()) + #$@(if ttl + #~((string-append "--ttl=" + #$(number->string ttl) + "s")) + #~()) + #$@(if cache + #~((string-append "--cache=" #$cache)) + #~())) + + ;; Make sure we run in a UTF-8 locale so we can produce + ;; nars for packages that contain UTF-8 file names such + ;; as 'nss-certs'. See . + #:environment-variables + (list (string-append "GUIX_LOCPATH=" + #$glibc-utf8-locales "/lib/locale") + "LC_ALL=en_US.utf8"))) + (stop #~(make-kill-destructor)))))) (define %guix-publish-accounts (list (user-group (name "guix-publish") (system? #t)) diff --git a/guix/deprecation.scm b/guix/deprecation.scm index 2f7c058940..d704e7ec61 100644 --- a/guix/deprecation.scm +++ b/guix/deprecation.scm @@ -21,6 +21,7 @@ #:use-module (ice-9 format) #:export (define-deprecated define-deprecated/alias + warn-about-deprecation deprecation-warning-port)) ;;; Commentary: