mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
publish: '--compression' can be repeated.
This allows 'guix publish' to compress and advertise multiple
compression methods from which users can choose.
* guix/scripts/publish.scm (actual-compression): Rename to...
(actual-compressions): ... this. Expect REQUESTED to be a list, and
always return a list.
(%default-options): Remove 'compression.
(store-item->recutils): New procedure.
(narinfo-string): Change #:compression to #:compressions (plural).
Adjust accordingly.
(render-narinfo, render-narinfo/cached): Likewise.
(bake-narinfo+nar): Change #:compression to #:compressions.
[compressed-nar-size]: New procedure.
Call 'compress-nar' for each item returned by 'actual-compressions'.
Create a narinfo for each compression.
(effective-compression): New procedure.
(make-request-handler): Change #:compression to #:compressions.
Use 'effective-compression' to determine the applicable compression.
(guix-publish): Adjust handling of '--compression'.
Print a message for each compression that is enabled.
* tests/publish.scm ("/*.narinfo"): Adjust to new narinfo field
ordering.
("/*.narinfo with properly encoded '+' sign"): Likewise.
("/*.narinfo with lzip + gzip"): New test.
("with cache, lzip + gzip"): New test.
* doc/guix.texi (Invoking guix publish): Document it.
This commit is contained in:
Ludovic Courtès
parent
dec4b3aa18
commit
b8fa86adfc
3 changed files with 210 additions and 88 deletions
|
|
@ -9685,6 +9685,11 @@ run @command{guix publish} behind a caching proxy, or to use
|
|||
allows @command{guix publish} to add @code{Content-Length} HTTP header
|
||||
to its responses.
|
||||
|
||||
This option can be repeated, in which case every substitute gets compressed
|
||||
using all the selected methods, and all of them are advertised. This is
|
||||
useful when users may not support all the compression methods: they can select
|
||||
the one they support.
|
||||
|
||||
@item --cache=@var{directory}
|
||||
@itemx -c @var{directory}
|
||||
Cache archives and meta-data (@code{.narinfo} URLs) to @var{directory}
|
||||
|
|
|
|||
|
|
@ -125,11 +125,11 @@ (define %default-gzip-compression
|
|||
(define (default-compression type)
|
||||
(compression type 3))
|
||||
|
||||
(define (actual-compression item requested)
|
||||
"Return the actual compression used for ITEM, which may be %NO-COMPRESSION
|
||||
(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
|
||||
|
|
@ -217,11 +217,6 @@ (define %default-options
|
|||
(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))
|
||||
|
||||
|
|
@ -249,29 +244,40 @@ (define (signed-string s)
|
|||
(define base64-encode-string
|
||||
(compose base64-encode string->utf8))
|
||||
|
||||
(define* (narinfo-string store store-path key
|
||||
#:key (compression %no-compression)
|
||||
(nar-path "nar") file-size)
|
||||
"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."
|
||||
(let* ((path-info (query-path-info store store-path))
|
||||
(compression (actual-compression store-path compression))
|
||||
(url (encode-and-join-uri-path
|
||||
(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-path))))
|
||||
,(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 (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-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))
|
||||
(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))
|
||||
" "))
|
||||
|
|
@ -279,17 +285,21 @@ (define* (narinfo-string store store-path key
|
|||
(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)
|
||||
|
|
@ -332,7 +342,7 @@ (define (render-nix-cache-info)
|
|||
%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
|
||||
|
|
@ -348,7 +358,7 @@ (define* (render-narinfo store request hash
|
|||
(cut display
|
||||
(narinfo-string store store-path (%private-key)
|
||||
#:nar-path nar-path
|
||||
#:compression compression)
|
||||
#:compressions compressions)
|
||||
<>)))))
|
||||
|
||||
(define* (nar-cache-file directory item
|
||||
|
|
@ -442,7 +452,7 @@ (define (hash-part->path* store hash cache)
|
|||
(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
|
||||
|
|
@ -461,10 +471,11 @@ (define (delete-entry narinfo)
|
|||
(delete-file* mapping)))
|
||||
|
||||
(let* ((item (hash-part->path* store hash cache))
|
||||
(compression (actual-compression item compression))
|
||||
(compressions (actual-compressions item compressions))
|
||||
(cached (and (not (string-null? item))
|
||||
(narinfo-cache-file cache item
|
||||
#:compression compression))))
|
||||
#:compression
|
||||
(first compressions)))))
|
||||
(cond ((string-null? item)
|
||||
(not-found request))
|
||||
((file-exists? cached)
|
||||
|
|
@ -488,7 +499,7 @@ (define (delete-entry narinfo)
|
|||
;; (format #t "baking ~s~%" item)
|
||||
(bake-narinfo+nar cache item
|
||||
#:ttl ttl
|
||||
#:compression compression
|
||||
#:compressions compressions
|
||||
#:nar-path nar-path)))
|
||||
|
||||
(when ttl
|
||||
|
|
@ -535,30 +546,45 @@ (define nar
|
|||
(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)))
|
||||
(compress-nar cache item compression)
|
||||
(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)))))
|
||||
|
||||
(mkdir-p (dirname narinfo))
|
||||
(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
|
||||
#:compression compression
|
||||
#:file-size (and=> (stat nar #f)
|
||||
stat:size))
|
||||
port))))))
|
||||
#: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
|
||||
|
|
@ -827,12 +853,22 @@ (define (string->compression-type string)
|
|||
("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)
|
||||
|
||||
|
|
@ -860,11 +896,11 @@ (define nar-path?
|
|||
#: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)
|
||||
|
|
@ -885,15 +921,8 @@ (define nar-path?
|
|||
((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)))))
|
||||
(compression (effective-compression compression-type
|
||||
compressions)))
|
||||
(if cache
|
||||
(render-nar/cached store cache request store-item
|
||||
#:ttl narinfo-ttl
|
||||
|
|
@ -917,7 +946,8 @@ (define nar-path?
|
|||
(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
|
||||
|
|
@ -925,7 +955,7 @@ (define* (run-publish-server socket store
|
|||
#:pool pool
|
||||
#:nar-path nar-path
|
||||
#:narinfo-ttl narinfo-ttl
|
||||
#:compression compression)
|
||||
#:compressions compressions)
|
||||
concurrent-http-server
|
||||
`(#:socket ,socket)))
|
||||
|
||||
|
|
@ -964,7 +994,17 @@ (define (guix-publish . args)
|
|||
(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)
|
||||
|
|
@ -996,9 +1036,11 @@ (define (guix-publish . args)
|
|||
(inet-ntop (sockaddr:fam address) (sockaddr:addr address))
|
||||
(sockaddr:port address))
|
||||
|
||||
(when compression
|
||||
(for-each (lambda (compression)
|
||||
(info (G_ "using '~a' compression method, level ~a~%")
|
||||
(compression-type compression) (compression-level compression)))
|
||||
(compression-type compression)
|
||||
(compression-level compression)))
|
||||
compressions)
|
||||
|
||||
(when repl-port
|
||||
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
|
||||
|
|
@ -1013,7 +1055,7 @@ (define (guix-publish . args)
|
|||
#:thread-name
|
||||
"publish worker"))
|
||||
#:nar-path nar-path
|
||||
#:compression compression
|
||||
#:compressions compressions
|
||||
#:narinfo-ttl ttl))))))
|
||||
|
||||
;;; Local Variables:
|
||||
|
|
|
|||
|
|
@ -138,17 +138,17 @@ (define %gzip-magic-bytes
|
|||
"StorePath: ~a
|
||||
URL: nar/~a
|
||||
Compression: none
|
||||
FileSize: ~a
|
||||
NarHash: sha256:~a
|
||||
NarSize: ~d
|
||||
References: ~a
|
||||
FileSize: ~a~%"
|
||||
References: ~a~%"
|
||||
%item
|
||||
(basename %item)
|
||||
(path-info-nar-size info)
|
||||
(bytevector->nix-base32-string
|
||||
(path-info-hash info))
|
||||
(path-info-nar-size info)
|
||||
(basename (first (path-info-references info)))
|
||||
(path-info-nar-size info)))
|
||||
(basename (first (path-info-references info)))))
|
||||
(signature (base64-encode
|
||||
(string->utf8
|
||||
(canonical-sexp->string
|
||||
|
|
@ -170,15 +170,15 @@ (define %gzip-magic-bytes
|
|||
"StorePath: ~a
|
||||
URL: nar/~a
|
||||
Compression: none
|
||||
FileSize: ~a
|
||||
NarHash: sha256:~a
|
||||
NarSize: ~d
|
||||
References: ~%\
|
||||
FileSize: ~a~%"
|
||||
References: ~%"
|
||||
item
|
||||
(uri-encode (basename item))
|
||||
(path-info-nar-size info)
|
||||
(bytevector->nix-base32-string
|
||||
(path-info-hash info))
|
||||
(path-info-nar-size info)
|
||||
(path-info-nar-size info)))
|
||||
(signature (base64-encode
|
||||
(string->utf8
|
||||
|
|
@ -301,6 +301,35 @@ (define %gzip-magic-bytes
|
|||
(list (assoc-ref info "Compression")
|
||||
(dirname (assoc-ref info "URL")))))
|
||||
|
||||
(unless (and (zlib-available?) (lzlib-available?))
|
||||
(test-skip 1))
|
||||
(test-equal "/*.narinfo with lzip + gzip"
|
||||
`((("StorePath" . ,%item)
|
||||
("URL" . ,(string-append "nar/gzip/" (basename %item)))
|
||||
("Compression" . "gzip")
|
||||
("URL" . ,(string-append "nar/lzip/" (basename %item)))
|
||||
("Compression" . "lzip"))
|
||||
200
|
||||
200)
|
||||
(call-with-temporary-directory
|
||||
(lambda (cache)
|
||||
(let ((thread (with-separate-output-ports
|
||||
(call-with-new-thread
|
||||
(lambda ()
|
||||
(guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
|
||||
(wait-until-ready 6793)
|
||||
(let* ((base "http://localhost:6793/")
|
||||
(part (store-path-hash-part %item))
|
||||
(url (string-append base part ".narinfo"))
|
||||
(body (http-get-port url)))
|
||||
(list (take (recutils->alist body) 5)
|
||||
(response-code
|
||||
(http-get (string-append base "nar/gzip/"
|
||||
(basename %item))))
|
||||
(response-code
|
||||
(http-get (string-append base "nar/lzip/"
|
||||
(basename %item))))))))))
|
||||
|
||||
(test-equal "custom nar path"
|
||||
;; Serve nars at /foo/bar/chbouib instead of /nar.
|
||||
(list `(("StorePath" . ,%item)
|
||||
|
|
@ -441,6 +470,52 @@ (define %gzip-magic-bytes
|
|||
(stat:size (stat nar)))
|
||||
(response-code uncompressed)))))))))
|
||||
|
||||
(unless (and (zlib-available?) (lzlib-available?))
|
||||
(test-skip 1))
|
||||
(test-equal "with cache, lzip + gzip"
|
||||
'(200 200 404)
|
||||
(call-with-temporary-directory
|
||||
(lambda (cache)
|
||||
(let ((thread (with-separate-output-ports
|
||||
(call-with-new-thread
|
||||
(lambda ()
|
||||
(guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
|
||||
(string-append "--cache=" cache)))))))
|
||||
(wait-until-ready 6794)
|
||||
(let* ((base "http://localhost:6794/")
|
||||
(part (store-path-hash-part %item))
|
||||
(url (string-append base part ".narinfo"))
|
||||
(nar-url (cute string-append "nar/" <> "/"
|
||||
(basename %item)))
|
||||
(cached (cute string-append cache "/" <> "/"
|
||||
(basename %item) ".narinfo"))
|
||||
(nar (cute string-append cache "/" <> "/"
|
||||
(basename %item) ".nar"))
|
||||
(response (http-get url)))
|
||||
(wait-for-file (cached "gzip"))
|
||||
(let* ((body (http-get-port url))
|
||||
(narinfo (recutils->alist body))
|
||||
(uncompressed (string-append base "nar/"
|
||||
(basename %item))))
|
||||
(and (file-exists? (nar "gzip"))
|
||||
(file-exists? (nar "lzip"))
|
||||
(equal? (take (pk 'narinfo/gzip+lzip narinfo) 7)
|
||||
`(("StorePath" . ,%item)
|
||||
("URL" . ,(nar-url "gzip"))
|
||||
("Compression" . "gzip")
|
||||
("FileSize" . ,(number->string
|
||||
(stat:size (stat (nar "gzip")))))
|
||||
("URL" . ,(nar-url "lzip"))
|
||||
("Compression" . "lzip")
|
||||
("FileSize" . ,(number->string
|
||||
(stat:size (stat (nar "lzip")))))))
|
||||
(list (response-code
|
||||
(http-get (string-append base (nar-url "gzip"))))
|
||||
(response-code
|
||||
(http-get (string-append base (nar-url "lzip"))))
|
||||
(response-code
|
||||
(http-get uncompressed))))))))))
|
||||
|
||||
(unless (zlib-available?)
|
||||
(test-skip 1))
|
||||
(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
|
||||
|
|
|
|||
Loading…
Reference in a new issue