Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 31 May 2019 14:49:02 UTC
Severity: normal
Tags: fixed, patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 36029 in the body.
You can then email your comments to 36029 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#36029; Package guix-patches.
(Fri, 31 May 2019 14:49:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:guix-patches <at> gnu.org.
(Fri, 31 May 2019 14:49:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Pierre Neidhardt <mail <at> ambrevar.xyz> Subject: [PATCH 0/2] 'publish' and 'substitute' support several compression methods Date: Fri, 31 May 2019 16:48:28 +0200
Hello Guix! This is a followup to <https://issues.guix.gnu.org/issue/35880>. One idea we discussed there was to allow clients to pass an ‘X-Guix-Accepted-Encoding’ header in HTTP requests, and the server would return an lzip narinfo or a gzip narinfo depending on that. However, I thought that this was not very flexible, and that we were bound to mess up with caching. This patch implements a different solution: ‘guix publish’ can be passed multiple ‘-C’ options, in which case it compresses substitutes with all these compression methods. The corresponding narinfo looks like this: --8<---------------cut here---------------start------------->8--- StorePath: /gnu/store/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 URL: nar/gzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 Compression: gzip FileSize: 40308611 URL: nar/lzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 Compression: lzip FileSize: 19867767 NarHash: sha256:1jv4nkq68a7zwqhi9inrnh340a4jxcpb91wq7d25hgw0nk8isbbk NarSize: 136499024 References: … --8<---------------cut here---------------end--------------->8--- IOW, it’s like before, except that there are multiple URL/Compression/FileSize fields instead of just one of each. The trick is that old clients take the first occurrence of each of these fields and ignore subsequent occurrences. In the example above, they’d just take gzip and ignore the rest. The new ‘guix substitute’ (second patch) “sees” all these fields and is able to choose the most appropriate compression method (i.e., the best one among those it supports.) This adds a bit of complexity that is useless beyond the transitioning period from gzip to lzip, but I think that’s OK; plus there might be an lzip to super-lzip transition in the future, who knows. Thoughts? When we deploy that, we’ll obviously more use storage and more CPU on the build farm, but that seems unavoidable. OTOH, we’ll progressively end up sending less data over the wire (and paying less for the CDN!), given that lzip compresses better. Ludo’. Ludovic Courtès (2): publish: '--compression' can be repeated. substitute: Select the best compression methods. doc/guix.texi | 5 + guix/scripts/challenge.scm | 4 +- guix/scripts/publish.scm | 204 ++++++++++++++++++++++-------------- guix/scripts/substitute.scm | 141 ++++++++++++++++++------- guix/scripts/weather.scm | 5 +- tests/publish.scm | 89 ++++++++++++++-- tests/substitute.scm | 51 ++++++++- 7 files changed, 370 insertions(+), 129 deletions(-) -- 2.21.0
guix-patches <at> gnu.org:bug#36029; Package guix-patches.
(Fri, 31 May 2019 15:01:01 GMT) Full text and rfc822 format available.Message #8 received at 36029 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 36029 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Pierre Neidhardt <mail <at> ambrevar.xyz> Subject: [PATCH 2/2] substitute: Select the best compression methods. Date: Fri, 31 May 2019 17:00:24 +0200
When a server publishes several URLs with different compression methods,
'guix substitute' can now choose the best one among the compression
methods that it supports.
* guix/scripts/substitute.scm (<narinfo>)[uri]: Replace with...
[uris]: ... this.
[compression]: Replace with...
[compressions]: ... this.
[file-size]: Replace with...
[file-sizes]: ... this.
[file-hash]: Replace with...
[file-hashes]: ... this.
(narinfo-maker): Adjust accordingly. Ensure 'file-sizes' and
'file-hashes' have the right length.
(assert-valid-signature, valid-narinfo?): Use the first element of
'narinfo-uris' in error messages.
(read-narinfo): Expect "URL", "Compression", "FileSize", and "FileHash"
to occur multiple times.
(display-narinfo-data): Call 'select-uri' to determine the file size.
(%compression-methods): New variable.
(supported-compression?, compresses-better?, select-uri): New
procedures.
(process-substitution): Call 'select-uri' to select the URI and
compression.
* guix/scripts/weather.scm (report-server-coverage): Account for all the
values returned by 'narinfo-file-sizes'.
* tests/substitute.scm ("substitute, narinfo with several URLs"): New
test.
---
guix/scripts/challenge.scm | 4 +-
guix/scripts/substitute.scm | 141 ++++++++++++++++++++++++++----------
guix/scripts/weather.scm | 5 +-
tests/substitute.scm | 51 ++++++++++++-
4 files changed, 160 insertions(+), 41 deletions(-)
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 65de42053d..17e87f0291 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo <at> gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -192,7 +192,7 @@ inconclusive reports."
(report (G_ " no local build for '~a'~%") item))
(for-each (lambda (narinfo)
(report (G_ " ~50a: ~a~%")
- (uri->string (narinfo-uri narinfo))
+ (uri->string (first (narinfo-uris narinfo)))
(hash->string
(narinfo-hash->sha256 (narinfo-hash narinfo)))))
narinfos))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 135398ba48..dba08edf50 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -42,6 +42,7 @@
#:use-module (guix progress)
#:use-module ((guix build syscalls)
#:select (set-thread-name))
+ #:autoload (guix lzlib) (lzlib-available?)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
@@ -66,11 +67,11 @@
narinfo?
narinfo-path
- narinfo-uri
+ narinfo-uris
narinfo-uri-base
- narinfo-compression
- narinfo-file-hash
- narinfo-file-size
+ narinfo-compressions
+ narinfo-file-hashes
+ narinfo-file-sizes
narinfo-hash
narinfo-size
narinfo-references
@@ -280,15 +281,16 @@ failure, return #f and #f."
(define-record-type <narinfo>
- (%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size
- references deriver system signature contents)
+ (%make-narinfo path uri-base uris compressions file-sizes file-hashes
+ nar-hash nar-size references deriver system
+ signature contents)
narinfo?
(path narinfo-path)
- (uri narinfo-uri)
- (uri-base narinfo-uri-base) ; URI of the cache it originates from
- (compression narinfo-compression)
- (file-hash narinfo-file-hash)
- (file-size narinfo-file-size)
+ (uri-base narinfo-uri-base) ;URI of the cache it originates from
+ (uris narinfo-uris) ;list of strings
+ (compressions narinfo-compressions) ;list of strings
+ (file-sizes narinfo-file-sizes) ;list of (integers | #f)
+ (file-hashes narinfo-file-hashes)
(nar-hash narinfo-hash)
(nar-size narinfo-size)
(references narinfo-references)
@@ -334,17 +336,25 @@ s-expression: ~s~%")
(define (narinfo-maker str cache-url)
"Return a narinfo constructor for narinfos originating from CACHE-URL. STR
must contain the original contents of a narinfo file."
- (lambda (path url compression file-hash file-size nar-hash nar-size
- references deriver system signature)
+ (lambda (path urls compressions file-hashes file-sizes
+ nar-hash nar-size references deriver system
+ signature)
"Return a new <narinfo> object."
- (%make-narinfo path
+ (define len (length urls))
+ (%make-narinfo path cache-url
;; Handle the case where URL is a relative URL.
- (or (string->uri url)
- (string->uri (string-append cache-url "/" url)))
- cache-url
-
- compression file-hash
- (and=> file-size string->number)
+ (map (lambda (url)
+ (or (string->uri url)
+ (string->uri
+ (string-append cache-url "/" url))))
+ urls)
+ compressions
+ (match file-sizes
+ (() (make-list len #f))
+ ((lst ...) (map string->number lst)))
+ (match file-hashes
+ (() (make-list len #f))
+ ((lst ...) (map string->number lst)))
nar-hash
(and=> nar-size string->number)
(string-tokenize references)
@@ -360,7 +370,7 @@ must contain the original contents of a narinfo file."
#:optional (acl (current-acl)))
"Bail out if SIGNATURE, a canonical sexp representing the signature of
NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO."
- (let ((uri (uri->string (narinfo-uri narinfo))))
+ (let ((uri (uri->string (first (narinfo-uris narinfo)))))
(signature-case (signature hash acl)
(valid-signature #t)
(invalid-signature
@@ -387,7 +397,8 @@ No authentication and authorization checks are performed here!"
'("StorePath" "URL" "Compression"
"FileHash" "FileSize" "NarHash" "NarSize"
"References" "Deriver" "System"
- "Signature"))))
+ "Signature")
+ '("URL" "Compression" "FileSize" "FileHash"))))
(define (narinfo-sha256 narinfo)
"Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
@@ -414,7 +425,7 @@ No authentication and authorization checks are performed here!"
(or %allow-unauthenticated-substitutes?
(let ((hash (narinfo-sha256 narinfo))
(signature (narinfo-signature narinfo))
- (uri (uri->string (narinfo-uri narinfo))))
+ (uri (uri->string (first (narinfo-uris narinfo)))))
(and hash signature
(signature-case (signature hash acl)
(valid-signature #t)
@@ -919,9 +930,11 @@ expected by the daemon."
(length (narinfo-references narinfo)))
(for-each (cute format #t "~a/~a~%" (%store-prefix) <>)
(narinfo-references narinfo))
- (format #t "~a\n~a\n"
- (or (narinfo-file-size narinfo) 0)
- (or (narinfo-size narinfo) 0)))
+
+ (let-values (((uri compression file-size) (select-uri narinfo)))
+ (format #t "~a\n~a\n"
+ (or file-size 0)
+ (or (narinfo-size narinfo) 0))))
(define* (process-query command
#:key cache-urls acl)
@@ -947,17 +960,73 @@ authorized substitutes."
(wtf
(error "unknown `--query' command" wtf))))
+(define %compression-methods
+ ;; Known compression methods and a thunk to determine whether they're
+ ;; supported. See 'decompressed-port' in (guix utils).
+ `(("gzip" . ,(const #t))
+ ("lzip" . ,lzlib-available?)
+ ("xz" . ,(const #t))
+ ("bzip2" . ,(const #t))
+ ("none" . ,(const #t))))
+
+(define (supported-compression? compression)
+ "Return true if COMPRESSION, a string, denotes a supported compression
+method."
+ (match (assoc-ref %compression-methods compression)
+ (#f #f)
+ (supported? (supported?))))
+
+(define (compresses-better? compression1 compression2)
+ "Return true if COMPRESSION1 generally compresses better than COMPRESSION2;
+this is a rough approximation."
+ (match compression1
+ ("none" #f)
+ ("gzip" (string=? compression2 "none"))
+ (_ (or (string=? compression2 "none")
+ (string=? compression2 "gzip")))))
+
+(define (select-uri narinfo)
+ "Select the \"best\" URI to download NARINFO's nar, and return three values:
+the URI, its compression method (a string), and the compressed file size."
+ (define choices
+ (filter (match-lambda
+ ((uri compression file-size)
+ (supported-compression? compression)))
+ (zip (narinfo-uris narinfo)
+ (narinfo-compressions narinfo)
+ (narinfo-file-sizes narinfo))))
+
+ (define (file-size<? c1 c2)
+ (match c1
+ ((uri1 compression1 (? integer? file-size1))
+ (match c2
+ ((uri2 compression2 (? integer? file-size2))
+ (< file-size1 file-size2))
+ (_ #t)))
+ ((uri compression1 #f)
+ (match c2
+ ((uri2 compression2 _)
+ (compresses-better? compression1 compression2))))
+ (_ #f))) ;we can't tell
+
+ (match (sort choices file-size<?)
+ (((uri compression file-size) _ ...)
+ (values uri compression file-size))))
+
(define* (process-substitution store-item destination
#:key cache-urls acl print-build-trace?)
"Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
DESTINATION as a nar file. Verify the substitute against ACL."
- (let* ((narinfo (lookup-narinfo cache-urls store-item
- (cut valid-narinfo? <> acl)))
- (uri (and=> narinfo narinfo-uri)))
- (unless uri
- (leave (G_ "no valid substitute for '~a'~%")
- store-item))
+ (define narinfo
+ (lookup-narinfo cache-urls store-item
+ (cut valid-narinfo? <> acl)))
+ (unless narinfo
+ (leave (G_ "no valid substitute for '~a'~%")
+ store-item))
+
+ (let-values (((uri compression file-size)
+ (select-uri narinfo)))
;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo))
@@ -971,9 +1040,8 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; DOWNLOAD-SIZE is #f in practice.
(fetch uri #:buffered? #f #:timeout? #f))
((progress)
- (let* ((comp (narinfo-compression narinfo))
- (dl-size (or download-size
- (and (equal? comp "none")
+ (let* ((dl-size (or download-size
+ (and (equal? compression "none")
(narinfo-size narinfo))))
(reporter (if print-build-trace?
(progress-reporter/trace
@@ -989,8 +1057,7 @@ DESTINATION as a nar file. Verify the substitute against ACL."
;; NOTE: This 'progress' port of current process will be
;; closed here, while the child process doing the
;; reporting will close it upon exit.
- (decompressed-port (and=> (narinfo-compression narinfo)
- string->symbol)
+ (decompressed-port (string->symbol compression)
progress)))
;; Unpack the Nar at INPUT into DESTINATION.
(restore-file input destination)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 78b8674e0c..1701772bc1 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -175,7 +175,10 @@ about the derivations queued, as is the case with Hydra."
(requested (length items))
(missing (lset-difference string=?
items (map narinfo-path narinfos)))
- (sizes (filter-map narinfo-file-size narinfos))
+ (sizes (append-map (lambda (narinfo)
+ (filter integer?
+ (narinfo-file-sizes narinfo)))
+ narinfos))
(time (+ (time-second time)
(/ (time-nanosecond time) 1e9))))
(format #t (G_ " ~2,1f% substitutes available (~h out of ~h)~%")
diff --git a/tests/substitute.scm b/tests/substitute.scm
index f4f2e9512d..ff2be662be 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -28,8 +28,10 @@
#:use-module (guix base32)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module ((guix ui) #:select (guix-warning-port))
+ #:use-module ((guix utils) #:select (call-with-compressed-output-port))
+ #:use-module ((guix lzlib) #:select (lzlib-available?))
#:use-module ((guix build utils)
- #:select (mkdir-p delete-file-recursively))
+ #:select (mkdir-p delete-file-recursively dump-port))
#:use-module (guix tests http)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
@@ -475,6 +477,53 @@ System: mips64el-linux\n")
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"substitute-retrieved"))))
+(test-equal "substitute, narinfo with several URLs"
+ "Substitutable data."
+ (let ((narinfo (string-append "StorePath: " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+URL: example.nar.gz
+Compression: gzip
+URL: example.nar.lz
+Compression: lzip
+URL: example.nar
+Compression: none
+NarHash: sha256:" (bytevector->nix-base32-string
+ (sha256 (string->utf8 "Substitutable data."))) "
+NarSize: 42
+References: bar baz
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")))
+ (with-narinfo (string-append narinfo "Signature: "
+ (signature-field narinfo))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (define (compress input output compression)
+ (call-with-output-file output
+ (lambda (port)
+ (call-with-compressed-output-port compression port
+ (lambda (port)
+ (call-with-input-file input
+ (lambda (input)
+ (dump-port input port))))))))
+
+ (let ((nar (string-append %main-substitute-directory
+ "/example.nar")))
+ (compress nar (string-append nar ".gz") 'gzip)
+ (when (lzlib-available?)
+ (compress nar (string-append nar ".lz") 'lzip)))
+
+ (parameterize ((substitute-urls
+ (list (string-append "file://"
+ %main-substitute-directory))))
+ (guix-substitute "--substitute"
+ (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
+ (call-with-input-file "substitute-retrieved" get-string-all))
+ (lambda ()
+ (false-if-exception (delete-file "substitute-retrieved")))))))
+
(test-end "substitute")
;;; Local Variables:
--
2.21.0
guix-patches <at> gnu.org:bug#36029; Package guix-patches.
(Fri, 31 May 2019 15:01:02 GMT) Full text and rfc822 format available.Message #11 received at 36029 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 36029 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Pierre Neidhardt <mail <at> ambrevar.xyz> Subject: [PATCH 1/2] publish: '--compression' can be repeated. Date: Fri, 31 May 2019 17:00:23 +0200
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.
---
doc/guix.texi | 5 +
guix/scripts/publish.scm | 204 +++++++++++++++++++++++----------------
tests/publish.scm | 89 +++++++++++++++--
3 files changed, 210 insertions(+), 88 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 340b806962..59743330c4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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}
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c55873db78..b4334b3f16 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -125,11 +125,11 @@ Publish ~a over HTTP.\n") %store-directory)
(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 @@ if ITEM is already compressed."
(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 @@ if ITEM is already compressed."
(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))
" "))
@@ -279,17 +285,21 @@ informs the client of how much needs to be downloaded."
(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 @@ References: ~a~%~a"
%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 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs."
(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 @@ vanished from the store in the meantime."
(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
@@ -460,11 +470,12 @@ requested using POOL."
(delete-file* nar)
(delete-file* mapping)))
- (let* ((item (hash-part->path* store hash cache))
- (compression (actual-compression item compression))
- (cached (and (not (string-null? item))
- (narinfo-cache-file cache item
- #:compression compression))))
+ (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)
@@ -488,7 +499,7 @@ requested using POOL."
;; (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 @@ requested using POOL."
(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))
- (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))))))
+ (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
@@ -827,12 +853,22 @@ blocking."
("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 @@ blocking."
#: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 @@ blocking."
((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 @@ blocking."
(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 @@ blocking."
#:pool pool
#:nar-path nar-path
#:narinfo-ttl narinfo-ttl
- #:compression compression)
+ #:compressions compressions)
concurrent-http-server
`(#:socket ,socket)))
@@ -964,7 +994,17 @@ blocking."
(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 @@ consider using the '--user' option!~%")))
(inet-ntop (sockaddr:fam address) (sockaddr:addr address))
(sockaddr:port address))
- (when compression
- (info (G_ "using '~a' compression method, level ~a~%")
- (compression-type compression) (compression-level compression)))
+ (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)))
@@ -1013,7 +1055,7 @@ consider using the '--user' option!~%")))
#:thread-name
"publish worker"))
#:nar-path nar-path
- #:compression compression
+ #:compressions compressions
#:narinfo-ttl ttl))))))
;;; Local Variables:
diff --git a/tests/publish.scm b/tests/publish.scm
index 80e0977cd5..64a8ff3cae 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -138,17 +138,17 @@
"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 @@ FileSize: ~a~%"
"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 @@ FileSize: ~a~%"
(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 @@ FileSize: ~a~%"
(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"
--
2.21.0
guix-patches <at> gnu.org:bug#36029; Package guix-patches.
(Sat, 01 Jun 2019 06:21:01 GMT) Full text and rfc822 format available.Message #14 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Pierre Neidhardt <mail <at> ambrevar.xyz> To: Ludovic Courtès <ludo <at> gnu.org>, guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: Re: [PATCH 0/2] 'publish' and 'substitute' support several compression methods Date: Sat, 01 Jun 2019 08:19:52 +0200
[Message part 1 (text/plain, inline)]
Hi! > One idea we discussed there was to allow clients to pass an > ‘X-Guix-Accepted-Encoding’ header in HTTP requests, and the server > would return an lzip narinfo or a gzip narinfo depending on that. > However, I thought that this was not very flexible, and that we > were bound to mess up with caching. > > This patch implements a different solution: ‘guix publish’ can > be passed multiple ‘-C’ options, in which case it compresses > substitutes with all these compression methods. The corresponding > narinfo looks like this: > > --8<---------------cut here---------------start------------->8--- > StorePath: /gnu/store/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 > URL: nar/gzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 > Compression: gzip > FileSize: 40308611 > URL: nar/lzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 > Compression: lzip > FileSize: 19867767 > NarHash: sha256:1jv4nkq68a7zwqhi9inrnh340a4jxcpb91wq7d25hgw0nk8isbbk > NarSize: 136499024 > References: … > --8<---------------cut here---------------end--------------->8--- Huhu, inkscape's size is already halved ;) > IOW, it’s like before, except that there are multiple > URL/Compression/FileSize fields instead of just one of each. > > The trick is that old clients take the first occurrence of each > of these fields and ignore subsequent occurrences. In the example > above, they’d just take gzip and ignore the rest. Smart! I like it! I gave the patches a quick skim but I'm not very knowledgeable of those parts, so there is little for me to comment about I'm afraid. Other than that, excited to see .lz substitutes becoming a reality! -- Pierre Neidhardt https://ambrevar.xyz/
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#36029; Package guix-patches.
(Sun, 02 Jun 2019 20:45:01 GMT) Full text and rfc822 format available.Message #17 received at 36029 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Pierre Neidhardt <mail <at> ambrevar.xyz> Cc: 36029 <at> debbugs.gnu.org Subject: Re: [bug#36029] [PATCH 0/2] 'publish' and 'substitute' support several compression methods Date: Sun, 02 Jun 2019 22:44:04 +0200
Hello! Pierre Neidhardt <mail <at> ambrevar.xyz> skribis: >> --8<---------------cut here---------------start------------->8--- >> StorePath: /gnu/store/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 >> URL: nar/gzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 >> Compression: gzip >> FileSize: 40308611 >> URL: nar/lzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4 >> Compression: lzip >> FileSize: 19867767 >> NarHash: sha256:1jv4nkq68a7zwqhi9inrnh340a4jxcpb91wq7d25hgw0nk8isbbk >> NarSize: 136499024 >> References: … >> --8<---------------cut here---------------end--------------->8--- > > Huhu, inkscape's size is already halved ;) Yup, I’d be curious to gather more stats once it’s running! >> IOW, it’s like before, except that there are multiple >> URL/Compression/FileSize fields instead of just one of each. >> >> The trick is that old clients take the first occurrence of each >> of these fields and ignore subsequent occurrences. In the example >> above, they’d just take gzip and ignore the rest. > > Smart! I like it! Cool! I’ve pushed these: b90ae065b5 substitute: Select the best compression methods. b8fa86adfc publish: '--compression' can be repeated. Now I’d like to run a test instance on berlin before we deploy it “for real.” To be continued… Ludo’.
Ludovic Courtès <ludo <at> gnu.org>
to control <at> debbugs.gnu.org.
(Sun, 02 Jun 2019 20:45:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>
to control <at> debbugs.gnu.org.
(Sun, 02 Jun 2019 20:45:02 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Mon, 01 Jul 2019 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.