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:
		
							parent
							
								
									1acd107c6b
								
							
						
					
					
						commit
						ee2691fa33
					
				
					 3 changed files with 83 additions and 42 deletions
				
			
		|  | @ -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,10 +1764,36 @@ 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) | ||||
| (define-deprecated (guix-publish-configuration-compression-level config) | ||||
|   "Return a compression level, the old way." | ||||
|   (match (guix-publish-configuration-compression config) | ||||
|     (((_ level) _ ...) level))) | ||||
| 
 | ||||
| (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)) | ||||
|  | @ -1770,7 +1801,7 @@ archive' public keys, with GUIX." | |||
|                      (list #$(file-append guix "/bin/guix") | ||||
|                            "publish" "-u" "guix-publish" | ||||
|                            "-p" #$(number->string port) | ||||
|                             "-C" #$(number->string compression) | ||||
|                            #$@(config->compression-options config) | ||||
|                            (string-append "--nar-path=" #$nar-path) | ||||
|                            (string-append "--listen=" #$host) | ||||
|                            #$@(if workers | ||||
|  | @ -1794,7 +1825,7 @@ archive' public keys, with GUIX." | |||
|                      (list (string-append "GUIX_LOCPATH=" | ||||
|                                           #$glibc-utf8-locales "/lib/locale") | ||||
|                            "LC_ALL=en_US.utf8"))) | ||||
|             (stop #~(make-kill-destructor))))))) | ||||
|            (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: | ||||
|  |  | |||
		Reference in a new issue