[PATCH 0/2] 'publish' and 'substitute' support several compression methods

DoneSubmitted by Ludovic Courtès.
Details
2 participants
  • Ludovic Courtès
  • Pierre Neidhardt
Owner
unassigned
Severity
normal
L
L
Ludovic Courtès wrote on 31 May 2019 16:48
(address . guix-patches@gnu.org)
20190531144828.9585-1-ludo@gnu.org
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 serverwould return an lzip narinfo or a gzip narinfo depending on that.However, I thought that this was not very flexible, and that wewere bound to mess up with caching.
This patch implements a different solution: ‘guix publish’ canbe passed multiple ‘-C’ options, in which case it compressessubstitutes with all these compression methods. The correspondingnarinfo looks like this:
Toggle snippet (12 lines)StorePath: /gnu/store/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4URL: nar/gzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4Compression: gzipFileSize: 40308611URL: nar/lzip/9czlz7ss3187l2vi1hvrlkwlgrggdg5p-inkscape-0.92.4Compression: lzipFileSize: 19867767NarHash: sha256:1jv4nkq68a7zwqhi9inrnh340a4jxcpb91wq7d25hgw0nk8isbbkNarSize: 136499024References: …
IOW, it’s like before, except that there are multipleURL/Compression/FileSize fields instead of just one of each.
The trick is that old clients take the first occurrence of eachof these fields and ignore subsequent occurrences. In the exampleabove, they’d just take gzip and ignore the rest.
The new ‘guix substitute’ (second patch) “sees” all these fieldsand 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 transitioningperiod from gzip to lzip, but I think that’s OK; plus there might bean lzip to super-lzip transition in the future, who knows.
Thoughts?
When we deploy that, we’ll obviously more use storage and more CPU onthe build farm, but that seems unavoidable. OTOH, we’ll progressivelyend 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
L
L
Ludovic Courtès wrote on 31 May 2019 17:00
[PATCH 2/2] substitute: Select the best compression methods.
(address . 36029@debbugs.gnu.org)
20190531150024.9868-2-ludo@gnu.org
When a server publishes several URLs with different compression methods,'guix substitute' can now choose the best one among the compressionmethods 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): Newprocedures.(process-substitution): Call 'select-uri' to select the URI andcompression.* guix/scripts/weather.scm (report-server-coverage): Account for all thevalues returned by 'narinfo-file-sizes'.* tests/substitute.scm ("substitute, narinfo with several URLs"): Newtest.--- 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(-)
Toggle diff (340 lines)diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scmindex 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@gnu.org>+;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@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.scmindex 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.scmindex 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.scmindex 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
L
L
Ludovic Courtès wrote on 31 May 2019 17:00
[PATCH 1/2] publish: '--compression' can be repeated.
(address . 36029@debbugs.gnu.org)
20190531150024.9868-1-ludo@gnu.org
This allows 'guix publish' to compress and advertise multiplecompression methods from which users can choose.
* guix/scripts/publish.scm (actual-compression): Rename to...(actual-compressions): ... this. Expect REQUESTED to be a list, andalways 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 fieldordering.("/*.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(-)
Toggle diff (509 lines)diff --git a/doc/guix.texi b/doc/guix.texiindex 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.scmindex 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.scmindex 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
P
P
Pierre Neidhardt wrote on 1 Jun 2019 08:19
Re: [PATCH 0/2] 'publish' and 'substitute' support several compression methods
(name . Ludovic Courtès)(address . ludo@gnu.org)
87blzhzv1z.fsf@ambrevar.xyz
Hi!
Toggle quote (24 lines)> 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 ;)
Toggle quote (7 lines)> 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 thoseparts, so there is little for me to comment about I'm afraid.
Other than that, excited to see .lz substitutes becoming a reality!
-- Pierre Neidhardthttps://ambrevar.xyz/
-----BEGIN PGP SIGNATURE-----
iQEzBAEBCAAdFiEEUPM+LlsMPZAEJKvom9z0l6S7zH8FAlzyGQgACgkQm9z0l6S7zH8dAgf/SXx7YGiv68tfczqnM/3f/WCArkRehta5oFIyyLGzUOhPLilBvV+L2AUF8sHDRUeiujoAI3ZzyoEF8ZPvGmMZe9paWsVzORN78KM/jR3dDknwMGbqwiucry0I8cG7YeJPz0687cu2vlXgVqQF1RbfIHRtPmO85K4RiTdWnbO077zZEnONU/whwdE9CONstwiTN/I5B4XcRe+VoeWANA+pYGcVa4o8eKdyVX4OtMCP6XyZtTk4BfTerrXlThTGzoqBXRKOeKMnKlA1QUxxtliLtlTEm2BbJdLuw7bib55zpfOjiYNQw9146iYUddls9fGeDgsTmW6on5T5DU7b/Bo52w===lPN9-----END PGP SIGNATURE-----
L
L
Ludovic Courtès wrote on 2 Jun 2019 22:44
Re: [bug#36029] [PATCH 0/2] 'publish' and 'substitute' support several compression methods
(name . Pierre Neidhardt)(address . mail@ambrevar.xyz)(address . 36029@debbugs.gnu.org)
87woi367l7.fsf@gnu.org
Hello!
Pierre Neidhardt <mail@ambrevar.xyz> skribis:
Toggle quote (15 lines)>> --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!
Toggle quote (9 lines)>> 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 “forreal.” To be continued…
Ludo’.
L
L
Ludovic Courtès wrote on 2 Jun 2019 22:44
control message for bug #36029
(address . control@debbugs.gnu.org)
87v9xn67kz.fsf@gnu.org
tags 36029 fixedclose 36029 quit
?
Your comment

This issue is archived.

To comment on this conversation send email to 36029@debbugs.gnu.org