From patchwork Thu Apr 4 14:06:28 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 62718 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 39A2527BBEA; Thu, 4 Apr 2024 15:07:19 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id AEB8227BBE9 for ; Thu, 4 Apr 2024 15:07:17 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rsNk9-0000Pr-1h; Thu, 04 Apr 2024 10:07:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rsNk5-0000P7-UQ for guix-patches@gnu.org; Thu, 04 Apr 2024 10:07:02 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rsNk5-00023d-LV; Thu, 04 Apr 2024 10:07:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rsNk6-0001f9-Jk; Thu, 04 Apr 2024 10:07:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#69291] [PATCH v2 1/2] scripts: substitute: Untangle selecting fast vs small compressions. References: <87le7flz89.fsf@cbaines.net> In-Reply-To: <87le7flz89.fsf@cbaines.net> Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Thu, 04 Apr 2024 14:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69291 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69291@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69291-submit@debbugs.gnu.org id=B69291.17122395996327 (code B ref 69291); Thu, 04 Apr 2024 14:07:02 +0000 Received: (at 69291) by debbugs.gnu.org; 4 Apr 2024 14:06:39 +0000 Received: from localhost ([127.0.0.1]:34420 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rsNji-0001dt-Gi for submit@debbugs.gnu.org; Thu, 04 Apr 2024 10:06:39 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:39871) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rsNjg-0001dj-1u for 69291@debbugs.gnu.org; Thu, 04 Apr 2024 10:06:36 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id CA63027BBE2 for <69291@debbugs.gnu.org>; Thu, 4 Apr 2024 15:06:29 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 3fc15e6e for <69291@debbugs.gnu.org>; Thu, 4 Apr 2024 14:06:29 +0000 (UTC) From: Christopher Baines Date: Thu, 4 Apr 2024 15:06:28 +0100 Message-ID: <6673d6ef271b684628ddbc30c7b198b72b91ad46.1712239589.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Pulling the logic up to the script makes this code more portable and not reliant on setting a global variable. * guix/scripts/substitute.scm (%prefer-fast-decompression?): Rename to… (%default-prefer-fast-decompression?): this. (call-with-cpu-usage-monitoring): Use multiple values to return the results from the thunk as well as the cpu usage. (display-narinfo-data): Update accordingly. (download-nar): Add prefer-fast-decompression? as a keyword argument, remove code to set! it and monitor the cpu-usage. (process-substitution, process-substitution/fallback): Accept and pass through prefer-fast-decompression? to download-nar. (guix-substitute): Move the cpu usage monitoring and prefer fast decompression switching logic here. Change-Id: I4e80b457b55bcda8c0ff4ee224dd94a55e1b24fb --- guix/scripts/substitute.scm | 126 +++++++++++++++++++++--------------- 1 file changed, 73 insertions(+), 53 deletions(-) base-commit: c9cd16c630ccba655b93ff32fd9a99570b4f5373 diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index a7ad56dbcd..0d0fd0e73b 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -261,22 +261,24 @@ (define (show-help) ;;; 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) +;; Whether to initially prefer fast decompression or not +(define %default-prefer-fast-decompression? #f) + +(define (call-with-cpu-usage-monitoring thunk) (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.))))) + (call-with-values thunk + (lambda vals + (let ((after (times))) + (apply + values + (append + (or vals '()) + (list + (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." @@ -297,7 +299,7 @@ (define (display-narinfo-data port narinfo) (let ((uri compression file-size (narinfo-best-uri narinfo #:fast-decompression? - %prefer-fast-decompression?))) + %default-prefer-fast-decompression?))) (format port "~a\n~a\n" (or file-size 0) (or (narinfo-size narinfo) 0)))) @@ -453,7 +455,8 @@ (define-syntax-rule (catch-system-error exp) (define* (download-nar narinfo destination #:key status-port deduplicate? print-build-trace? - (fetch-timeout %fetch-timeout)) + (fetch-timeout %fetch-timeout) + prefer-fast-decompression?) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and if DESTINATION is in the store, deduplicate its files. Print a status line to @@ -527,7 +530,7 @@ (define* (download-nar narinfo destination (let ((choices (narinfo-preferred-uris narinfo #:fast-decompression? - %prefer-fast-decompression?))) + prefer-fast-decompression?))) ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so ;; DOWNLOAD-SIZE is #f in this case. (let* ((raw uri compression download-size (try-fetch choices)) @@ -560,29 +563,13 @@ (define* (download-nar narinfo destination ;; Compute the actual nar hash as we read it. (algorithm expected (narinfo-hash-algorithm+value narinfo)) (hashed get-hash (open-hash-input-port algorithm input))) - ;; Unpack the Nar at INPUT into DESTINATION. - (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: - ;; . - ;; 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)) + ;; Unpack the Nar at INPUT into DESTINATION. + (restore-file hashed destination + #:dump-file (if (and destination-in-store? + deduplicate?) + dump-file/deduplicate* + dump-file)) (close-port hashed) (close-port input) @@ -630,7 +617,8 @@ (define network-error? (define* (process-substitution/fallback port narinfo destination #:key cache-urls acl - deduplicate? print-build-trace?) + deduplicate? print-build-trace? + prefer-fast-decompression?) "Attempt to substitute NARINFO, which is assumed to be authorized or equivalent, by trying to download its nar from each entry in CACHE-URLS. @@ -664,14 +652,17 @@ (define* (process-substitution/fallback port narinfo destination (download-nar alternate destination #:status-port port #:deduplicate? deduplicate? - #:print-build-trace? print-build-trace?)) + #:print-build-trace? print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?)) (loop rest))) (() (loop rest))))))) (define* (process-substitution port store-item destination #:key cache-urls acl - deduplicate? print-build-trace?) + deduplicate? print-build-trace? + prefer-fast-decompression?) "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to DESTINATION as a nar file. Verify the substitute against ACL, and verify its hash against what appears in the narinfo. When DEDUPLICATE? is true, and if @@ -703,11 +694,14 @@ (define* (process-substitution port store-item destination #:acl acl #:deduplicate? deduplicate? #:print-build-trace? - print-build-trace?))) + print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?))) (download-nar narinfo destination #:status-port port #:deduplicate? deduplicate? - #:print-build-trace? print-build-trace?))) + #:print-build-trace? print-build-trace? + #:prefer-fast-decompression? prefer-fast-decompression?))) ;;; @@ -897,18 +891,44 @@ (define-command (guix-substitute . args) ;; Specify the number of columns of the terminal so the progress ;; report displays nicely. (parameterize ((current-terminal-columns (client-terminal-columns))) - (let loop () + (let loop ((prefer-fast-decompression? + %default-prefer-fast-decompression?)) (match (read-line) ((? eof-object?) #t) ((= string-tokenize ("substitute" store-path destination)) - (process-substitution reply-port store-path destination - #:cache-urls (substitute-urls) - #:acl (current-acl) - #:deduplicate? deduplicate? - #:print-build-trace? - print-build-trace?) - (loop)))))) + (let ((cpu-usage + (with-cpu-usage-monitoring + (process-substitution + reply-port store-path destination + #:cache-urls (substitute-urls) + #:acl (current-acl) + #:deduplicate? deduplicate? + #:print-build-trace? + print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?)))) + + ;; 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: + ;; . + ;; 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 + (loop (cond + ;; 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). + ((> cpu-usage .8) #t) + ((< cpu-usage .2) #f) + (else prefer-fast-decompression?))))))))) (opts (leave (G_ "~a: unrecognized options~%") opts))))))