diff options
| -rw-r--r-- | guix/narinfo.scm | 27 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 57 |
2 files changed, 73 insertions, 11 deletions
diff --git a/guix/narinfo.scm b/guix/narinfo.scm index 2d06124017..72e0f75fda 100644 --- a/guix/narinfo.scm +++ b/guix/narinfo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; @@ -297,9 +297,21 @@ this is a rough approximation." (_ (or (string=? compression2 "none") (string=? compression2 "gzip"))))) -(define (narinfo-best-uri narinfo) +(define (decompresses-faster? compression1 compression2) + "Return true if COMPRESSION1 generally has a higher decompression throughput +than COMPRESSION2." + (match compression1 + ("none" #t) + ("zstd" #t) + ("gzip" (string=? compression2 "lzip")) + (_ #f))) + +(define* (narinfo-best-uri narinfo #:key fast-decompression?) "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." +the URI, its compression method (a string), and the compressed file size. +When FAST-DECOMPRESSION? is true, prefer substitutes with faster +decompression (typically zstd) rather than substitutes with a higher +compression ratio (typically lzip)." (define choices (filter (match-lambda ((uri compression file-size) @@ -321,6 +333,13 @@ the URI, its compression method (a string), and the compressed file size." (compresses-better? compression1 compression2)))) (_ #f))) ;we can't tell - (match (sort choices file-size<?) + (define (speed<? c1 c2) + (match c1 + ((uri1 compression1 . _) + (match c2 + ((uri2 compression2 . _) + (decompresses-faster? compression2 compression1)))))) + + (match (sort choices (if fast-decompression? (negate speed<?) file-size<?)) (((uri compression file-size) _ ...) (values uri compression file-size)))) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 2bbbafe204..46323c7216 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -258,6 +258,27 @@ Internal tool to substitute a pre-built binary to a local build.\n")) ;;; Daemon/substituter protocol. ;;; +(define %prefer-fast-decompression? + ;; Whether to prefer fast decompression over good compression ratios. This + ;; serves in particular to choose between lzip (high compression ratio but + ;; low decompression throughput) and zstd (lower compression ratio but high + ;; decompression throughput). + #f) + +(define (call-with-cpu-usage-monitoring proc) + (let ((before (times))) + (proc) + (let ((after (times))) + (if (= (tms:clock after) (tms:clock before)) + 0 + (/ (- (tms:utime after) (tms:utime before)) + (- (tms:clock after) (tms:clock before)) + 1.))))) + +(define-syntax-rule (with-cpu-usage-monitoring exp ...) + "Evaluate EXP... Return its CPU usage as a fraction between 0 and 1." + (call-with-cpu-usage-monitoring (lambda () exp ...))) + (define (display-narinfo-data narinfo) "Write to the current output port the contents of NARINFO in the format expected by the daemon." @@ -270,7 +291,10 @@ expected by the daemon." (for-each (cute format #t "~a/~a~%" (%store-prefix) <>) (narinfo-references narinfo)) - (let-values (((uri compression file-size) (narinfo-best-uri narinfo))) + (let-values (((uri compression file-size) + (narinfo-best-uri narinfo + #:fast-decompression? + %prefer-fast-decompression?))) (format #t "~a\n~a\n" (or file-size 0) (or (narinfo-size narinfo) 0)))) @@ -462,7 +486,9 @@ the current output port." store-item)) (let-values (((uri compression file-size) - (narinfo-best-uri narinfo))) + (narinfo-best-uri narinfo + #:fast-decompression? + %prefer-fast-decompression?))) (unless print-build-trace? (format (current-error-port) (G_ "Downloading ~a...~%") (uri->string uri))) @@ -500,11 +526,28 @@ the current output port." ((hashed get-hash) (open-hash-input-port algorithm input))) ;; Unpack the Nar at INPUT into DESTINATION. - (restore-file hashed destination - #:dump-file (if (and destination-in-store? - deduplicate?) - dump-file/deduplicate* - dump-file)) + (define cpu-usage + (with-cpu-usage-monitoring + (restore-file hashed destination + #:dump-file (if (and destination-in-store? + deduplicate?) + dump-file/deduplicate* + dump-file)))) + + ;; Create a hysteresis: depending on CPU usage, favor compression + ;; methods with faster decompression (like ztsd) or methods with better + ;; compression ratios (like lzip). This stems from the observation that + ;; substitution can be CPU-bound when high-speed networks are used: + ;; <https://lists.gnu.org/archive/html/guix-devel/2020-12/msg00177.html>. + ;; To simulate "slow" networking or changing conditions, run: + ;; sudo tc qdisc add dev eno1 root tbf rate 512kbit latency 50ms burst 1540 + ;; and then cancel with: + ;; sudo tc qdisc del dev eno1 root + (when (> cpu-usage .8) + (set! %prefer-fast-decompression? #t)) + (when (< cpu-usage .2) + (set! %prefer-fast-decompression? #f)) + (close-port hashed) (close-port input) |