GNU bug report logs - #69291
[PATCH 0/5] Start making substitute code less coupled

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Christopher Baines <mail@HIDDEN>; Keywords: patch; Done: Christopher Baines <mail@HIDDEN>; Maintainer for guix-patches is guix-patches@HIDDEN.

Message received at 69291-done <at> debbugs.gnu.org:

Received: (at 69291-done) by debbugs.gnu.org; 21 Apr 2024 11:25:21 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Apr 21 07:25:21 2024
Received: from localhost ([127.0.0.1]:42438 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1ryVJx-0001f8-Do
	for submit <at> debbugs.gnu.org; Sun, 21 Apr 2024 07:25:21 -0400
Received: from mira.cbaines.net ([212.71.252.8]:43378)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <mail@HIDDEN>) id 1ryVJr-0001f0-Mp
 for 69291-done <at> debbugs.gnu.org; Sun, 21 Apr 2024 07:25:19 -0400
Received: from localhost (unknown [212.132.255.10])
 by mira.cbaines.net (Postfix) with ESMTPSA id 7924E27BBE2
 for <69291-done <at> debbugs.gnu.org>; Sun, 21 Apr 2024 12:24:59 +0100 (BST)
Received: from felis (localhost.lan [127.0.0.1])
 by localhost (OpenSMTPD) with ESMTP id ddb7b160
 for <69291-done <at> debbugs.gnu.org>;
 Sun, 21 Apr 2024 11:24:58 +0000 (UTC)
From: Christopher Baines <mail@HIDDEN>
To: 69291-done <at> debbugs.gnu.org
Subject: Re: [bug#69291] [PATCH 5/5] scripts: substitute: Extract script
 specific output from download-nar.
In-Reply-To: <87frw2jqv6.fsf@HIDDEN> (Christopher Baines's message of
 "Wed, 03 Apr 2024 18:30:37 +0100")
References: <c689a478b1b123eb607a89b2ec295b491d79f39f.1708458147.git.mail@HIDDEN>
 <f4af19b037826cad90bbcfe400ad864f028cc7d8.1708458147.git.mail@HIDDEN>
 <87o7c7f8nb.fsf@HIDDEN> <87frw2jqv6.fsf@HIDDEN>
User-Agent: mu4e 1.12.2; emacs 29.3
Date: Sun, 21 Apr 2024 12:24:56 +0100
Message-ID: <875xwb2c1j.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha512; protocol="application/pgp-signature"
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 69291-done
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable

Christopher Baines <mail@HIDDEN> writes:

> Ludovic Court=C3=A8s <ludo@HIDDEN> writes:
>
>> Christopher Baines <mail@HIDDEN> skribis:
>>
>>> As this moves download-nar in a direction where it could be used outsid=
e the
>>> substitute script.
>>>
>>> * guix/scripts/substitute.scm (download-nar): Return more information a=
nd move
>>> status-port output to=E2=80=A6
>>> (guix-substitute): here.
>>>
>>> Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0
>>
>> LGTM.
>
> Looking at this patch some more, I missed the failure case in
> process-substitution/fallback, so I'll send an updated patch (for this
> and the previous patch).

I've sent a couple of updated patches as part of the series to
https://issues.guix.gnu.org/70494

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQKlBAEBCgCPFiEEPonu50WOcg2XVOCyXiijOwuE9XcFAmYk94hfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcRHG1haWxAY2Jh
aW5lcy5uZXQACgkQXiijOwuE9Xfv8BAAgHSzx9+C9FKLugUD3CoDIUo85Fh/N8D3
xlQpbm9yj5U4mTy0auwUBS0KRS+fpZ6FrsmSLXiKIfRYnWKDPh7/AEnhtgn4wHen
4Ja1c/2E3SCfca5ei6Z2jj8u1nuFpxQbce5fpN1XWE5OTbtcF1Yr9z5FZQSIWJ35
x8gL8eEUjMZ/9iwSWzL44AKEh6xuvhxObd4m2a1AEj6qVxtoLRw2IKa3vR9Y19Yy
/lLSHKm8F4EQoUjRcvpqIiRcrJ+SLlykDoU7Vv6EOSr2rG0MxI/7oFEvJXWWpQkS
Cysk1u76ltcT/KfEg5Gwc2uR/lvfiA13RHUb/A2lY705zNGpLbSvJfHYb4FsY7md
N23kjg/lDsxuEQrYtTYvbtVcgNz7yfDueq0s6fiEjeTq47lK7q8+AjUr63Y2UcnV
AdZi9PSd8BQD4pxTr9lmLHEzpax1EmudzkeiMeZLdq3g4h4HBL6gyp58Jh5G9MNp
DfmI58H0/9aP829pKES+KDbs10Xyy3gpyyTgFE1dbXNw5SwRHcOhMCB9XZ7mao5D
/fstv5DNT3CrDPsEpaxcNtivo1N+gMYVQVyDTDpztA0+cvPbj1E/mPH1tNLmwAkG
zanZ2glgjy1oLEXoSzDp1etDEppogZlg9KgCk0SsZAcCHSkIASp7zkvXsSDGp+ki
0rrTeyUMTDY=
=Yb0I
-----END PGP SIGNATURE-----
--=-=-=--

Notification sent to Christopher Baines <mail@HIDDEN>:
bug acknowledged by developer. Full text available.

Reply sent to Christopher Baines <mail@HIDDEN>:
You have taken responsibility. Full text available.

Message received at 69291 <at> debbugs.gnu.org:

Received: (at 69291) by debbugs.gnu.org; 4 Apr 2024 14:06:42 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Apr 04 10:06:42 2024
Received: from localhost ([127.0.0.1]:34422 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1rsNjl-0001e8-DF
	for submit <at> debbugs.gnu.org; Thu, 04 Apr 2024 10:06:42 -0400
Received: from mira.cbaines.net ([212.71.252.8]:43304)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <mail@HIDDEN>) id 1rsNjg-0001dk-Bx
 for 69291 <at> debbugs.gnu.org; Thu, 04 Apr 2024 10:06:38 -0400
Received: from localhost (unknown [212.132.255.10])
 by mira.cbaines.net (Postfix) with ESMTPSA id D551927BBE9
 for <69291 <at> debbugs.gnu.org>; Thu,  4 Apr 2024 15:06:29 +0100 (BST)
Received: from localhost (localhost [local])
 by localhost (OpenSMTPD) with ESMTPA id 42cc5147
 for <69291 <at> debbugs.gnu.org>; Thu, 4 Apr 2024 14:06:29 +0000 (UTC)
From: Christopher Baines <mail@HIDDEN>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH v2 2/2] scripts: substitute: Extract script specific output
 from download-nar.
Date: Thu,  4 Apr 2024 15:06:29 +0100
Message-ID: <eb3a8bba107ddf9bca1cf12af3ed39eefe13c872.1712239589.git.mail@HIDDEN>
X-Mailer: git-send-email 2.41.0
In-Reply-To: <6673d6ef271b684628ddbc30c7b198b72b91ad46.1712239589.git.mail@HIDDEN>
References: <6673d6ef271b684628ddbc30c7b198b72b91ad46.1712239589.git.mail@HIDDEN>
MIME-Version: 1.0
X-Debbugs-Cc: Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Ludovic Courtès <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ricardo Wurmus <rekado@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 69291
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

As this moves download-nar in a direction where it could be used outside the
substitute script.

* guix/scripts/substitute.scm (download-nar): Return expected and actual
hashes and move status-port output to guix-substitute.
(process-substitution/fallback): Remove port argument, and move output to port
to guix-substitute.
(process-substitution): Return hashes from download-nar or
process-substitution/fallback, plus the narinfo.
(guix-substitute): Don't pass the reply-port in to process-substitution and
implement the messages to the reply-port here.

Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0
---
 guix/scripts/substitute.scm | 162 ++++++++++++++++++++----------------
 1 file changed, 90 insertions(+), 72 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0d0fd0e73b..c2bc16085d 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -453,14 +453,12 @@ (define-syntax-rule (catch-system-error exp)
     (const #f)))
 
 (define* (download-nar narinfo destination
-                       #:key status-port
-                       deduplicate? print-build-trace?
+                       #:key deduplicate? print-build-trace?
                        (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
-STATUS-PORT."
+if DESTINATION is in the store, deduplicate its files."
   (define destination-in-store?
     (string-prefix? (string-append (%store-prefix) "/")
                     destination))
@@ -576,24 +574,8 @@ (define* (download-nar narinfo destination
       ;; Wait for the reporter to finish.
       (every (compose zero? cdr waitpid) pids)
 
-      ;; Skip a line after what 'progress-reporter/file' printed, and another
-      ;; one to visually separate substitutions.  When PRINT-BUILD-TRACE? is
-      ;; true, leave it up to (guix status) to prettify things.
-      (newline (current-error-port))
-      (unless print-build-trace?
-        (newline (current-error-port)))
-
-      ;; Check whether we got the data announced in NARINFO.
-      (let ((actual (get-hash)))
-        (if (bytevector=? actual expected)
-            ;; Tell the daemon that we're done.
-            (format status-port "success ~a ~a~%"
-                    (narinfo-hash narinfo) (narinfo-size narinfo))
-            ;; The actual data has a different hash than that in NARINFO.
-            (format status-port "hash-mismatch ~a ~a ~a~%"
-                    (hash-algorithm-name algorithm)
-                    (bytevector->nix-base32-string expected)
-                    (bytevector->nix-base32-string actual)))))))
+      (values expected
+              (get-hash)))))
 
 (define (system-error? exception)
   "Return true if EXCEPTION is a Guile 'system-error exception."
@@ -615,7 +597,7 @@ (define network-error?
                      '(gnutls-error getaddrinfo-error)))
           (http-get-error? exception)))))
 
-(define* (process-substitution/fallback port narinfo destination
+(define* (process-substitution/fallback narinfo destination
                                         #:key cache-urls acl
                                         deduplicate? print-build-trace?
                                         prefer-fast-decompression?)
@@ -630,9 +612,8 @@ (define* (process-substitution/fallback port narinfo destination
   (let loop ((cache-urls cache-urls))
     (match cache-urls
       (()
-       (report-error (G_ "failed to find alternative substitute for '~a'~%")
-                     (narinfo-path narinfo))
-       (display "not-found\n" port))
+       ;; Failure, so return two values like download-nar
+       (values #f #f))
       ((cache-url rest ...)
        (match (lookup-narinfos cache-url
                                (list (narinfo-path narinfo))
@@ -650,7 +631,6 @@ (define* (process-substitution/fallback port narinfo destination
                                     (http-get-error-reason c)))
                          (loop rest)))
                 (download-nar alternate destination
-                              #:status-port port
                               #:deduplicate? deduplicate?
                               #:print-build-trace? print-build-trace?
                               #:prefer-fast-decompression?
@@ -659,7 +639,7 @@ (define* (process-substitution/fallback port narinfo destination
          (()
           (loop rest)))))))
 
-(define* (process-substitution port store-item destination
+(define* (process-substitution store-item destination
                                #:key cache-urls acl
                                deduplicate? print-build-trace?
                                prefer-fast-decompression?)
@@ -680,28 +660,34 @@ (define* (process-substitution port store-item destination
       (G_ "no valid substitute for '~a'~%")
       store-item)))
 
-  (guard (c ((network-error? c)
-             (when (http-get-error? c)
-               (warning (G_ "download from '~a' failed: ~a, ~s~%")
-                        (uri->string (http-get-error-uri c))
-                        (http-get-error-code c)
-                        (http-get-error-reason c)))
-             (format (current-error-port)
-                     (G_ "retrying download of '~a' with other substitute URLs...~%")
-                     store-item)
-             (process-substitution/fallback port narinfo destination
-                                            #:cache-urls cache-urls
-                                            #:acl acl
-                                            #:deduplicate? deduplicate?
-                                            #: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?
-                  #:prefer-fast-decompression? prefer-fast-decompression?)))
+  (let ((expected-hash
+         actual-hash
+         (guard
+             (c ((network-error? c)
+                 (when (http-get-error? c)
+                   (warning (G_ "download from '~a' failed: ~a, ~s~%")
+                            (uri->string (http-get-error-uri c))
+                            (http-get-error-code c)
+                            (http-get-error-reason c)))
+                 (format
+                  (current-error-port)
+                  (G_ "retrying download of '~a' with other substitute URLs...~%")
+                  store-item)
+                 (process-substitution/fallback narinfo destination
+                                                #:cache-urls cache-urls
+                                                #:acl acl
+                                                #:deduplicate? deduplicate?
+                                                #:print-build-trace?
+                                                print-build-trace?
+                                                #:prefer-fast-decompression?
+                                                prefer-fast-decompression?)))
+           (download-nar narinfo destination
+                         #:deduplicate? deduplicate?
+                         #:print-build-trace? print-build-trace?
+                         #:prefer-fast-decompression? prefer-fast-decompression?))))
+    (values narinfo
+            expected-hash
+            actual-hash)))
 
 
 ;;;
@@ -897,10 +883,13 @@ (define-command (guix-substitute . args)
               ((? eof-object?)
                #t)
               ((= string-tokenize ("substitute" store-path destination))
-               (let ((cpu-usage
+               (let ((narinfo
+                      expected-hash
+                      actual-hash
+                      cpu-usage
                       (with-cpu-usage-monitoring
                        (process-substitution
-                        reply-port store-path destination
+                        store-path destination
                         #:cache-urls (substitute-urls)
                         #:acl (current-acl)
                         #:deduplicate? deduplicate?
@@ -909,26 +898,55 @@ (define-command (guix-substitute . args)
                         #: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:
-                 ;; <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
-                 (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?)))))))))
+                 (if expected-hash
+                     (begin
+                       ;; Skip a line after what 'progress-reporter/file'
+                       ;; printed, and another one to visually separate
+                       ;; substitutions.  When PRINT-BUILD-TRACE? is true,
+                       ;; leave it up to (guix status) to prettify things.
+                       (newline (current-error-port))
+                       (unless print-build-trace?
+                         (newline (current-error-port)))
+
+                       ;; Check whether we got the data announced in NARINFO.
+                       (if (bytevector=? actual-hash expected-hash)
+                           ;; Tell the daemon that we're done.
+                           (format reply-port "success ~a ~a~%"
+                                   (narinfo-hash narinfo) (narinfo-size narinfo))
+                           ;; The actual data has a different hash than that in NARINFO.
+                           (format reply-port "hash-mismatch ~a ~a ~a~%"
+                                   (hash-algorithm-name
+                                    (narinfo-hash-algorithm+value narinfo))
+                                   (bytevector->nix-base32-string expected-hash)
+                                   (bytevector->nix-base32-string actual-hash)))
+
+                       ;; 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
+                       (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?))))
+                     (begin
+                       (report-error (G_ "failed to find alternative substitute for '~a'~%")
+                                     (narinfo-path narinfo))
+                       (display "not-found\n" reply-port)
+
+                       (loop prefer-fast-decompression?)))))))))
        (opts
         (leave (G_ "~a: unrecognized options~%") opts))))))
 
-- 
2.41.0

Information forwarded to

guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, rekado@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN

:
bug#69291; Package guix-patches. Full text available.

Message received at 69291 <at> debbugs.gnu.org:

Received: (at 69291) by debbugs.gnu.org; 4 Apr 2024 14:06:39 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Apr 04 10:06:39 2024
Received: from localhost ([127.0.0.1]:34420 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1rsNji-0001dt-Gi
	for submit <at> 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 <mail@HIDDEN>) id 1rsNjg-0001dj-1u
 for 69291 <at> 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 <at> 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 <at> debbugs.gnu.org>; Thu, 4 Apr 2024 14:06:29 +0000 (UTC)
From: Christopher Baines <mail@HIDDEN>
To: 69291 <at> debbugs.gnu.org
Subject: [PATCH v2 1/2] scripts: substitute: Untangle selecting fast vs small
 compressions.
Date: Thu,  4 Apr 2024 15:06:28 +0100
Message-ID: <6673d6ef271b684628ddbc30c7b198b72b91ad46.1712239589.git.mail@HIDDEN>
X-Mailer: git-send-email 2.41.0
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
X-Debbugs-Cc: Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Ludovic Courtès <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ricardo Wurmus <rekado@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 69291
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

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(-)

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:
-      ;; <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))
 
+      ;; 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:
+                 ;; <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
+                 (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))))))
 

base-commit: c9cd16c630ccba655b93ff32fd9a99570b4f5373
-- 
2.41.0

Information forwarded to

guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, rekado@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN

:
bug#69291; Package guix-patches. Full text available.