summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-03-14 15:05:30 +0100
committerLudovic Courtès <ludo@gnu.org>2021-03-21 23:41:01 +0100
commit9da5ec7099b992a8969a17627548cd341c01bd90 (patch)
tree82fa6307254029d42c3af67878c5f89dbdbc7164 /guix/scripts
parent5f9b28b231e17749d14a1b95ae9cad68d7315a1e (diff)
substitute: Choose compression method based on past CPU usage.
This stems from the observation that substitute download can be CPU-bound when high-speed networks are in use: https://lists.gnu.org/archive/html/guix-devel/2020-12/msg00177.html * guix/narinfo.scm (decompresses-faster?): New procedure. (narinfo-best-uri): Add #:fast-decompression?. * guix/scripts/substitute.scm (%prefer-fast-decompression?): New variable. (call-with-cpu-usage-monitoring): New procedure. (with-cpu-usage-monitoring): New macro. (display-narinfo-data, process-substitution): Pass #:fast-decompression? to 'narinfo-best-uri'. (process-substitution): Wrap 'restore-file' call in 'with-cpu-usage-monitoring'. Set '%prefer-fast-decompression?'.
Diffstat (limited to 'guix/scripts')
-rwxr-xr-xguix/scripts/substitute.scm57
1 files changed, 50 insertions, 7 deletions
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)