services: guix-publish: Allow for multi-compression.
This is a followup to b8fa86adfc.
* guix/deprecation.scm (warn-about-deprecation): Make public.
* gnu/services/base.scm (<guix-publish-configuration>)[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'.
This commit is contained in:
Ludovic Courtès
parent
1acd107c6b
commit
ee2691fa33
@ -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
|
||||
|
||||
@ -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-publish-configuration> 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 <https://bugs.gnu.org/26948>.
|
||||
#: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-publish-configuration>
|
||||
(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 <https://bugs.gnu.org/26948>.
|
||||
#: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))
|
||||
|
||||
@ -21,6 +21,7 @@
|
||||
#:use-module (ice-9 format)
|
||||
#:export (define-deprecated
|
||||
define-deprecated/alias
|
||||
warn-about-deprecation
|
||||
deprecation-warning-port))
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user