;;; 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.
;;;
#:use-module (guix base64)
#:use-module (guix config)
#:use-module (guix derivations)
- #:use-module (guix hash)
+ #:use-module (gcrypt hash)
#:use-module (guix pki)
- #:use-module (guix pk-crypto)
+ #:use-module (gcrypt pk-crypto)
#:use-module (guix workers)
#: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)
(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_ "
;; Since we compress on the fly, default to fast compression.
(compression 'gzip 3))
-(define (actual-compression item requested)
- "Return the actual compression used for ITEM, which may be %NO-COMPRESSION
+(define (default-compression type)
+ (compression type 3))
+
+(define (actual-compressions item requested)
+ "Return the actual compressions used for ITEM, which may be %NO-COMPRESSION
if ITEM is already compressed."
(if (compressed-file? item)
- %no-compression
+ (list %no-compression)
requested))
(define %options
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)))
(public-key-file . ,%public-key-file)
(private-key-file . ,%private-key-file)
- ;; Default to fast & low compression.
- (compression . ,(if (zlib-available?)
- %default-gzip-compression
- %no-compression))
-
;; Default number of workers when caching is enabled.
(workers . ,(current-processor-count))
(define base64-encode-string
(compose base64-encode string->utf8))
+(define* (store-item->recutils store-item
+ #:key
+ (nar-path "nar")
+ (compression %no-compression)
+ file-size)
+ "Return the 'Compression' and 'URL' fields of the narinfo for STORE-ITEM,
+with COMPRESSION, starting at NAR-PATH."
+ (let ((url (encode-and-join-uri-path
+ `(,@(split-and-decode-uri-path nar-path)
+ ,@(match compression
+ (($ <compression> 'none)
+ '())
+ (($ <compression> type)
+ (list (symbol->string type))))
+ ,(basename store-item)))))
+ (format #f "URL: ~a~%Compression: ~a~%~@[FileSize: ~a~%~]"
+ url (compression-type compression) file-size)))
+
(define* (narinfo-string store store-path key
- #:key (compression %no-compression)
- (nar-path "nar") file-size)
+ #:key (compressions (list %no-compression))
+ (nar-path "nar") (file-sizes '()))
"Generate a narinfo key/value string for STORE-PATH; an exception is raised
if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The
narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs.
-Optionally, FILE-SIZE can specify the size in bytes of the compressed NAR; it
-informs the client of how much needs to be downloaded."
+
+Optionally, FILE-SIZES is a list of compression/integer pairs, where the
+integer is size in bytes of the compressed NAR; it informs the client of how
+much needs to be downloaded."
(let* ((path-info (query-path-info store store-path))
- (compression (actual-compression store-path compression))
- (url (encode-and-join-uri-path
- `(,@(split-and-decode-uri-path nar-path)
- ,@(match compression
- (($ <compression> 'none)
- '())
- (($ <compression> type)
- (list (symbol->string type))))
- ,(basename store-path))))
+ (compressions (actual-compressions store-path compressions))
(hash (bytevector->nix-base32-string
(path-info-hash path-info)))
(size (path-info-nar-size path-info))
- (file-size (or file-size
- (and (eq? compression %no-compression) size)))
+ (file-sizes `((,%no-compression . ,size) ,@file-sizes))
(references (string-join
(map basename (path-info-references path-info))
" "))
(base-info (format #f
"\
StorePath: ~a
-URL: ~a
-Compression: ~a
+~{~a~}\
NarHash: sha256:~a
NarSize: ~d
-References: ~a~%~a"
- store-path url
- (compression-type compression)
- hash size references
- (if file-size
- (format #f "FileSize: ~a~%" file-size)
- "")))
+References: ~a~%"
+ store-path
+ (map (lambda (compression)
+ (let ((size (assoc-ref file-sizes
+ compression)))
+ (store-item->recutils store-path
+ #:file-size size
+ #:nar-path nar-path
+ #:compression
+ compression)))
+ compressions)
+ hash size references))
;; Do not render a "Deriver" or "System" line if we are rendering
;; info for a derivation.
(info (if (not deriver)
%nix-cache-info))))
(define* (render-narinfo store request hash
- #:key ttl (compression %no-compression)
+ #:key ttl (compressions (list %no-compression))
(nar-path "nar"))
"Render metadata for the store path corresponding to HASH. If TTL is true,
advertise it as the maximum validity period (in seconds) via the
(cut display
(narinfo-string store store-path (%private-key)
#:nar-path nar-path
- #:compression compression)
+ #:compressions compressions)
<>)))))
(define* (nar-cache-file directory item
"/" (basename item)
".narinfo"))
+(define (hash-part-mapping-cache-file directory hash)
+ (string-append directory "/hashes/" hash))
+
(define run-single-baker
(let ((baking (make-weak-value-hash-table))
(mutex (make-mutex)))
+inf.0
(expiration-time file))))))
+(define (hash-part->path* store hash cache)
+ "Like 'hash-part->path' but cached results under CACHE. This ensures we can
+still map HASH to the corresponding store file name, even if said store item
+vanished from the store in the meantime."
+ (let ((cached (hash-part-mapping-cache-file cache hash)))
+ (catch 'system-error
+ (lambda ()
+ (call-with-input-file cached read-string))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ (match (hash-part->path store hash)
+ ("" "")
+ (result
+ (mkdir-p (dirname cached))
+ (call-with-output-file (string-append cached ".tmp")
+ (lambda (port)
+ (display result port)))
+ (rename-file (string-append cached ".tmp") cached)
+ result))
+ (apply throw args))))))
+
(define* (render-narinfo/cached store request hash
- #:key ttl (compression %no-compression)
+ #:key ttl (compressions (list %no-compression))
(nar-path "nar")
cache pool)
"Respond to the narinfo request for REQUEST. If the narinfo is available in
requested using POOL."
(define (delete-entry narinfo)
;; Delete NARINFO and the corresponding nar from CACHE.
- (let ((nar (string-append (string-drop-right narinfo
- (string-length ".narinfo"))
- ".nar")))
+ (let* ((nar (string-append (string-drop-right narinfo
+ (string-length ".narinfo"))
+ ".nar"))
+ (base (basename narinfo ".narinfo"))
+ (hash (string-take base (string-index base #\-)))
+ (mapping (hash-part-mapping-cache-file cache hash)))
(delete-file* narinfo)
- (delete-file* nar)))
-
- (let* ((item (hash-part->path store hash))
- (compression (actual-compression item compression))
- (cached (and (not (string-null? item))
- (narinfo-cache-file cache item
- #:compression compression))))
+ (delete-file* nar)
+ (delete-file* mapping)))
+
+ (let* ((item (hash-part->path* store hash cache))
+ (compressions (actual-compressions item compressions))
+ (cached (and (not (string-null? item))
+ (narinfo-cache-file cache item
+ #:compression
+ (first compressions)))))
(cond ((string-null? item)
(not-found request))
((file-exists? cached)
;; (format #t "baking ~s~%" item)
(bake-narinfo+nar cache item
#:ttl ttl
- #:compression compression
+ #:compressions compressions
#:nar-path nar-path)))
(when ttl
(else
(not-found request #:phrase "")))))
+(define (compress-nar cache item compression)
+ "Save in directory CACHE the nar for ITEM compressed with COMPRESSION."
+ (define nar
+ (nar-cache-file cache item #:compression compression))
+
+ (mkdir-p (dirname nar))
+ (match (compression-type compression)
+ ('gzip
+ ;; Note: the file port gets closed along with the gzip port.
+ (call-with-gzip-output-port (open-output-file (string-append nar ".tmp"))
+ (lambda (port)
+ (write-file item port))
+ #: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>.)
+ (with-atomic-file-output nar
+ (lambda (port)
+ (write-file item port))))))
+
(define* (bake-narinfo+nar cache item
- #:key ttl (compression %no-compression)
+ #:key ttl (compressions (list %no-compression))
(nar-path "/nar"))
"Write the narinfo and nar for ITEM to CACHE."
- (let* ((compression (actual-compression item compression))
- (nar (nar-cache-file cache item
- #:compression compression))
- (narinfo (narinfo-cache-file cache item
- #:compression compression)))
-
- (mkdir-p (dirname nar))
- (match (compression-type compression)
- ('gzip
- ;; Note: the file port gets closed along with the gzip port.
- (call-with-gzip-output-port (open-output-file (string-append nar ".tmp"))
- (lambda (port)
- (write-file item port))
- #:level (compression-level compression)
- #:buffer-size (* 128 1024))
- (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>.)
- (with-atomic-file-output nar
- (lambda (port)
- (write-file item port)))))
-
- (mkdir-p (dirname narinfo))
- (with-atomic-file-output narinfo
- (lambda (port)
- ;; Open a new connection to the store. We cannot reuse the main
- ;; thread's connection to the store since we would end up sending
- ;; stuff concurrently on the same channel.
- (with-store store
- (display (narinfo-string store item
- (%private-key)
- #:nar-path nar-path
- #:compression compression
- #:file-size (and=> (stat nar #f)
- stat:size))
- port))))))
-
-;; XXX: Declare the 'Guix-Compression' HTTP header, which is in fact for
+ (define (compressed-nar-size compression)
+ (let* ((nar (nar-cache-file cache item #:compression compression))
+ (stat (stat nar #f)))
+ (and stat
+ (cons compression (stat:size stat)))))
+
+ (let ((compression (actual-compressions item compressions)))
+
+ (for-each (cut compress-nar cache item <>) compressions)
+
+ (match compressions
+ ((main others ...)
+ (let ((narinfo (narinfo-cache-file cache item
+ #:compression main)))
+ (with-atomic-file-output narinfo
+ (lambda (port)
+ ;; Open a new connection to the store. We cannot reuse the main
+ ;; thread's connection to the store since we would end up sending
+ ;; stuff concurrently on the same channel.
+ (with-store store
+ (let ((sizes (filter-map compressed-nar-size compression)))
+ (display (narinfo-string store item
+ (%private-key)
+ #:nar-path nar-path
+ #:compressions compressions
+ #:file-sizes sizes)
+ port)))))
+
+ ;; Make narinfo files for OTHERS hard links to NARINFO such that the
+ ;; atime-based cache eviction considers either all the nars or none
+ ;; of them as candidates.
+ (for-each (lambda (other)
+ (let ((other (narinfo-cache-file cache item
+ #:compression other)))
+ (link narinfo other)))
+ others))))))
+
+;; XXX: Declare the 'X-Nar-Compression' HTTP header, which is in fact for
;; internal consumption: it allows us to pass the compression info to
;; 'http-write', as part of the workaround to <http://bugs.gnu.org/21093>.
-(declare-header! "Guix-Nar-Compression"
+(declare-header! "X-Nar-Compression"
(lambda (str)
(match (call-with-input-string str read)
(('compression type level)
(if (valid-path? store store-path)
(values `((content-type . (application/x-nix-archive
(charset . "ISO-8859-1")))
- (guix-nar-compression . ,compression))
+ (x-nar-compression . ,compression))
;; XXX: We're not returning the actual contents, deferring
;; instead to 'http-write'. This is a hack to work around
;; <http://bugs.gnu.org/21093>.
(not-found request))))
(define* (render-nar/cached store cache request store-item
- #:key (compression %no-compression))
+ #:key ttl (compression %no-compression))
"Respond to REQUEST with a nar for STORE-ITEM. If the nar is in CACHE,
-return it; otherwise, return 404."
+return it; otherwise, return 404. When TTL is true, use it as the
+'Cache-Control' expiration time."
(let ((cached (nar-cache-file cache store-item
#:compression compression)))
(if (file-exists? cached)
(values `((content-type . (application/octet-stream
- (charset . "ISO-8859-1"))))
- ;; XXX: We're not returning the actual contents, deferring
- ;; instead to 'http-write'. This is a hack to work around
- ;; <http://bugs.gnu.org/21093>.
- cached)
+ (charset . "ISO-8859-1")))
+ ,@(if ttl
+ `((cache-control (max-age . ,ttl)))
+ '())
+
+ ;; XXX: We're not returning the actual contents, deferring
+ ;; instead to 'http-write'. This is a hack to work around
+ ;; <http://bugs.gnu.org/21093>.
+ (x-raw-file . ,cached))
+ #f)
(not-found request))))
(define (render-content-addressed-file store request
#:recursive? #f)))
(if (valid-path? store item)
(values `((content-type . (application/octet-stream
- (charset . "ISO-8859-1"))))
- ;; XXX: We're not returning the actual contents, deferring
- ;; instead to 'http-write'. This is a hack to work around
- ;; <http://bugs.gnu.org/21093>.
- item)
+ (charset . "ISO-8859-1")))
+ ;; XXX: We're not returning the actual contents,
+ ;; deferring instead to 'http-write'. This is a hack to
+ ;; work around <http://bugs.gnu.org/21093>.
+ (x-raw-file . ,item))
+ #f)
(not-found request)))
(not-found request)))
+(define (render-log-file store request name)
+ "Render the log file for NAME, the base name of a store item. Don't attempt
+to compress or decompress the log file; just return it as-is."
+ (define (response-headers file)
+ ;; XXX: We're not returning the actual contents, deferring instead to
+ ;; 'http-write'. This is a hack to work around
+ ;; <http://bugs.gnu.org/21093>.
+ (cond ((string-suffix? ".gz" file)
+ `((content-type . (text/plain (charset . "UTF-8")))
+ (content-encoding . (gzip))
+ (x-raw-file . ,file)))
+ ((string-suffix? ".bz2" file)
+ `((content-type . (application/x-bzip2
+ (charset . "ISO-8859-1")))
+ (x-raw-file . ,file)))
+ (else ;uncompressed
+ `((content-type . (text/plain (charset . "UTF-8")))
+ (x-raw-file . ,file)))))
+
+ (let ((log (log-file store
+ (string-append (%store-prefix) "/" name))))
+ (if log
+ (values (response-headers log) log)
+ (not-found request))))
+
(define (render-home-page request)
"Render the home page."
(values `((content-type . (text/html (charset . "UTF-8"))))
(define %http-write
(@@ (web server http) http-write))
+(define (strip-headers response)
+ "Return RESPONSE's headers minus 'Content-Length' and our internal headers."
+ (fold alist-delete
+ (response-headers response)
+ '(content-length x-raw-file x-nar-compression)))
+
(define (sans-content-length response)
"Return RESPONSE without its 'content-length' header."
(set-field response (response-headers)
- (alist-delete 'content-length
- (response-headers response)
- eq?)))
+ (strip-headers response)))
(define (with-content-length response length)
"Return RESPONSE with a 'content-length' header set to LENGTH."
(set-field response (response-headers)
(alist-cons 'content-length length
- (alist-delete 'content-length
- (response-headers response)
- eq?))))
+ (strip-headers response))))
(define-syntax-rule (swallow-EPIPE exp ...)
"Swallow EPIPE errors raised by EXP..."
exp ...)
(const #f)))
-(define (nar-response-port response)
+(define (nar-response-port response compression)
"Return a port on which to write the body of RESPONSE, the response of a
/nar request, according to COMPRESSION."
- (match (assoc-ref (response-headers response) 'guix-nar-compression)
+ (match compression
(($ <compression> 'gzip level)
;; Note: We cannot used chunked encoding here because
;; 'make-gzip-output-port' wants a file port.
(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
(call-with-new-thread
(lambda ()
(set-thread-name "publish nar")
- (let* ((response (write-response (sans-content-length response)
- client))
- (port (begin
- (force-output client)
- (nar-response-port response))))
+ (let* ((compression (assoc-ref (response-headers response)
+ 'x-nar-compression))
+ (response (write-response (sans-content-length response)
+ client))
+ (port (begin
+ (force-output client)
+ (nar-response-port response compression))))
;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in
;; 'render-nar', BODY here is just the file name of the store item.
;; We call 'write-file' from here because we know that's the only
(swallow-zlib-error
(close-port port))
(values)))))
- (('application/octet-stream . _)
- ;; Send a raw file in a separate thread.
- (call-with-new-thread
- (lambda ()
- (set-thread-name "publish file")
- (catch 'system-error
- (lambda ()
- (call-with-input-file (utf8->string body)
- (lambda (input)
- (let* ((size (stat:size (stat input)))
- (response (write-response (with-content-length response
- size)
- client))
- (output (response-port response)))
- (if (file-port? output)
- (sendfile output input size)
- (dump-port input output))
- (close-port output)
- (values)))))
- (lambda args
- ;; If the file was GC'd behind our back, that's fine. Likewise if
- ;; the client closes the connection.
- (unless (memv (system-error-errno args)
- (list ENOENT EPIPE ECONNRESET))
- (apply throw args))
- (values))))))
(_
- ;; Handle other responses sequentially.
- (%http-write server client response body))))
+ (match (assoc-ref (response-headers response) 'x-raw-file)
+ ((? string? file)
+ ;; Send a raw file in a separate thread.
+ (call-with-new-thread
+ (lambda ()
+ (set-thread-name "publish file")
+ (catch 'system-error
+ (lambda ()
+ (call-with-input-file file
+ (lambda (input)
+ (let* ((size (stat:size (stat input)))
+ (response (write-response (with-content-length response
+ size)
+ client))
+ (output (response-port response)))
+ (if (file-port? output)
+ (sendfile output input size)
+ (dump-port input output))
+ (close-port output)
+ (values)))))
+ (lambda args
+ ;; If the file was GC'd behind our back, that's fine. Likewise if
+ ;; the client closes the connection.
+ (unless (memv (system-error-errno args)
+ (list ENOENT EPIPE ECONNRESET))
+ (apply throw args))
+ (values))))))
+ (#f
+ ;; Handle other responses sequentially.
+ (%http-write server client response body))))))
(define-server-impl concurrent-http-server
;; A variant of Guile's built-in HTTP server that offloads possibly long
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 (effective-compression requested-type compressions)
+ "Given the REQUESTED-TYPE for compression and the set of chosen COMPRESSION
+methods, return the applicable compression."
+ (or (find (match-lambda
+ (($ <compression> type)
+ (and (eq? type requested-type)
+ compression)))
+ compressions)
+ (default-compression requested-type)))
+
(define* (make-request-handler store
#:key
cache pool
narinfo-ttl
(nar-path "nar")
- (compression %no-compression))
+ (compressions (list %no-compression)))
+ (define compression-type?
+ string->compression-type)
+
(define nar-path?
(let ((expected (split-and-decode-uri-path nar-path)))
(cut equal? expected <>)))
(render-home-page request))
;; /<hash>.narinfo
(((= extract-narinfo-hash (? string? hash)))
- ;; TODO: Register roots for HASH that will somehow remain for
- ;; NARINFO-TTL.
(if cache
(render-narinfo/cached store request hash
#:cache cache
#:pool pool
#:ttl narinfo-ttl
#:nar-path nar-path
- #:compression compression)
+ #:compressions compressions)
(render-narinfo store request hash
#:ttl narinfo-ttl
#:nar-path nar-path
- #:compression compression)))
+ #:compressions compressions)))
;; /nar/file/NAME/sha256/HASH
(("file" name "sha256" hash)
(guard (c ((invalid-base32-character? c)
(render-content-addressed-file store request
name 'sha256 hash))))
+ ;; /log/OUTPUT
+ (("log" name)
+ (render-log-file store request name))
+
;; Use different URLs depending on the compression type. This
;; guarantees that /nar URLs remain valid even when 'guix publish'
;; 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 (effective-compression compression-type
+ compressions)))
(if cache
(render-nar/cached store cache request store-item
+ #:ttl narinfo-ttl
#:compression compression)
(render-nar store request store-item
#:compression compression)))
(if (nar-path? components)
(if cache
(render-nar/cached store cache request store-item
+ #:ttl narinfo-ttl
#:compression %no-compression)
(render-nar store request store-item
#:compression %no-compression))
(not-found request))))
(define* (run-publish-server socket store
- #:key (compression %no-compression)
+ #:key
+ (compressions (list %no-compression))
(nar-path "nar") narinfo-ttl
cache pool)
(run-server (make-request-handler store
#:pool pool
#:nar-path nar-path
#:narinfo-ttl narinfo-ttl
- #:compression compression)
+ #:compressions compressions)
concurrent-http-server
`(#:socket ,socket)))
(user (assoc-ref opts 'user))
(port (assoc-ref opts 'port))
(ttl (assoc-ref opts 'narinfo-ttl))
- (compression (assoc-ref opts 'compression))
+ (compressions (match (filter-map (match-lambda
+ (('compression . compression)
+ compression)
+ (_ #f))
+ opts)
+ (()
+ ;; Default to fast & low compression.
+ (list (if (zlib-available?)
+ %default-gzip-compression
+ %no-compression)))
+ (lst (reverse lst))))
(address (let ((addr (assoc-ref opts 'address)))
(make-socket-address (sockaddr:fam addr)
(sockaddr:addr addr)
(parameterize ((%public-key public-key)
(%private-key private-key))
- (format #t (G_ "publishing ~a on ~a, port ~d~%")
- %store-directory
- (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
- (sockaddr:port address))
+ (info (G_ "publishing ~a on ~a, port ~d~%")
+ %store-directory
+ (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
+ (sockaddr:port address))
+
+ (for-each (lambda (compression)
+ (info (G_ "using '~a' compression method, level ~a~%")
+ (compression-type compression)
+ (compression-level compression)))
+ compressions)
+
(when repl-port
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
#:thread-name
"publish worker"))
#:nar-path nar-path
- #:compression compression
+ #:compressions compressions
#:narinfo-ttl ttl))))))
;;; Local Variables:
HCoop / jackhill / guix / guix.git / blobdiff