From patchwork Wed Feb 24 20:34:11 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 27296 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 D750227BC4B; Wed, 24 Feb 2021 20:35:20 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,UNPARSEABLE_RELAY autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5E29327BC4A for ; Wed, 24 Feb 2021 20:35:20 +0000 (GMT) Received: from localhost ([::1]:57300 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lF0sR-0008Bv-KC for patchwork@mira.cbaines.net; Wed, 24 Feb 2021 15:35:19 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:40852) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lF0sA-0008Bi-Gi for guix-patches@gnu.org; Wed, 24 Feb 2021 15:35:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:52734) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lF0sA-0004NZ-8w for guix-patches@gnu.org; Wed, 24 Feb 2021 15:35:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lF0sA-0006Q0-5B for guix-patches@gnu.org; Wed, 24 Feb 2021 15:35:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45146] [PATCH 1/2] guix: substitutes: Make progress reporting configurable. References: <20201209185759.30937-1-mail@cbaines.net> In-Reply-To: <20201209185759.30937-1-mail@cbaines.net> Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 24 Feb 2021 20:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45146 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45146@debbugs.gnu.org Received: via spool by 45146-submit@debbugs.gnu.org id=B45146.161419885524605 (code B ref 45146); Wed, 24 Feb 2021 20:35:02 +0000 Received: (at 45146) by debbugs.gnu.org; 24 Feb 2021 20:34:15 +0000 Received: from localhost ([127.0.0.1]:36045 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lF0rO-0006Oi-Nt for submit@debbugs.gnu.org; Wed, 24 Feb 2021 15:34:15 -0500 Received: from mira.cbaines.net ([212.71.252.8]:42300) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lF0rN-0006OY-Dc for 45146@debbugs.gnu.org; Wed, 24 Feb 2021 15:34:14 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:8ac0:b4c7:f5c8:7caa]) by mira.cbaines.net (Postfix) with ESMTPSA id 49AB327BC4A for <45146@debbugs.gnu.org>; Wed, 24 Feb 2021 20:34:12 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 123b8f85 for <45146@debbugs.gnu.org>; Wed, 24 Feb 2021 20:34:12 +0000 (UTC) From: Christopher Baines Date: Wed, 24 Feb 2021 20:34:11 +0000 Message-Id: <20210224203412.15135-1-mail@cbaines.net> X-Mailer: git-send-email 2.30.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" X-getmail-retrieved-from-mailbox: Patches Rather than always outputting to (current-error-port) in lookup-narinfos (which is called from within lookup-narinfos/diverse), take a procedure which should return a progress reporter, and defer any output to that. As this is now general purpose code, make the default behaviour to output nothing. Maintain the current behaviour of the substitute script by moving the progress reporter implementation there, and passing it in when calling lookup-narinfos/diverse. These changes should be generally useful, but I'm particularly looking at getting guix weather to do progress reporting differently, with this new flexibility. * guix/substitutes.scm (fetch-narinfos): Take a procedure to make a progress-reporter, and use that rather than the hardcoded behaviour. (lookup-narinfos): Add #:make-progress-reporter keyword argument, and pass this through to fetch-narinfos. (lookup-narinfos/diverse): Add a #:make-progress-reporter keyword argument, and pass this through to lookup-narinfos. * guix/scripts/substitute.scm (process-query): Pass a progress-reporter to lookup-narinfos/diverse. --- guix/scripts/substitute.scm | 23 +++++++++++++++++++-- guix/substitutes.scm | 40 ++++++++++++++++++++----------------- 2 files changed, 43 insertions(+), 20 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index ed19e67531..47a723edb2 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -298,12 +298,30 @@ authorized substitutes." (lambda (obj) (valid-narinfo? obj acl)))) + (define* (make-progress-reporter total #:key url) + (define done 0) + + (define (report-progress) + (erase-current-line (current-error-port)) ;erase current line + (force-output (current-error-port)) + (format (current-error-port) + (G_ "updating substitutes from '~a'... ~5,1f%") + url (* 100. (/ done total))) + (set! done (+ 1 done))) + + (progress-reporter + (start report-progress) + (report report-progress) + (stop (lambda () + (newline (current-error-port)))))) + (match (string-tokenize command) (("have" paths ..1) ;; Return the subset of PATHS available in CACHE-URLS. (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid? - #:open-connection open-connection-for-uri/cached))) + #:open-connection open-connection-for-uri/cached + #:make-progress-reporter make-progress-reporter))) (for-each (lambda (narinfo) (format #t "~a~%" (narinfo-path narinfo))) substitutable) @@ -312,7 +330,8 @@ authorized substitutes." ;; Reply info about PATHS if it's in CACHE-URLS. (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid? - #:open-connection open-connection-for-uri/cached))) + #:open-connection open-connection-for-uri/cached + #:make-progress-reporter make-progress-reporter))) (for-each display-narinfo-data substitutable) (newline))) (wtf diff --git a/guix/substitutes.scm b/guix/substitutes.scm index dc94ccc8e4..ef78013659 100644 --- a/guix/substitutes.scm +++ b/guix/substitutes.scm @@ -173,18 +173,14 @@ if file doesn't exist, and the narinfo otherwise." (apply throw args))))) (define* (fetch-narinfos url paths - #:key (open-connection guix:open-connection-for-uri)) + #:key + (open-connection guix:open-connection-for-uri) + (make-progress-reporter + (const progress-reporter/silent))) "Retrieve all the narinfos for PATHS from the cache at URL and return them." - (define update-progress! - (let ((done 0) - (total (length paths))) - (lambda () - (display "\r\x1b[K" (current-error-port)) ;erase current line - (force-output (current-error-port)) - (format (current-error-port) - (G_ "updating substitutes from '~a'... ~5,1f%") - url (* 100. (/ done total))) - (set! done (+ 1 done))))) + (define progress-reporter + (make-progress-reporter (length paths) + #:url url)) (define hash-part->path (let ((mapping (fold (lambda (path result) @@ -206,7 +202,7 @@ if file doesn't exist, and the narinfo otherwise." (len (response-content-length response)) (cache (response-cache-control response)) (ttl (and cache (assoc-ref cache 'max-age)))) - (update-progress!) + (progress-reporter-report! progress-reporter) ;; Make sure to read no more than LEN bytes since subsequent bytes may ;; belong to the next response. @@ -238,7 +234,7 @@ if file doesn't exist, and the narinfo otherwise." ;; narinfos, which provides a much stronger guarantee. (let* ((requests (map (cut narinfo-request url <>) paths)) (result (begin - (update-progress!) + (start-progress-reporter! progress-reporter) (call-with-connection-error-handling uri (lambda () @@ -247,7 +243,7 @@ if file doesn't exist, and the narinfo otherwise." requests #:open-connection open-connection #:verify-certificate? #f)))))) - (newline (current-error-port)) + (stop-progress-reporter! progress-reporter) result)) ((file #f) (let* ((base (string-append (uri-path uri) "/")) @@ -297,7 +293,9 @@ for PATH." (values #f #f)))) (define* (lookup-narinfos cache paths - #:key (open-connection guix:open-connection-for-uri)) + #:key (open-connection guix:open-connection-for-uri) + (make-progress-reporter + (const progress-reporter/silent))) "Return the narinfos for PATHS, invoking the server at CACHE when no information is available locally." (let-values (((cached missing) @@ -315,12 +313,16 @@ information is available locally." (if (null? missing) cached (let ((missing (fetch-narinfos cache missing - #:open-connection open-connection))) + #:open-connection open-connection + #:make-progress-reporter + make-progress-reporter))) (append cached (or missing '())))))) (define* (lookup-narinfos/diverse caches paths authorized? #:key (open-connection - guix:open-connection-for-uri)) + guix:open-connection-for-uri) + (make-progress-reporter + (const progress-reporter/silent))) "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order. That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next cache, and so on. @@ -353,7 +355,9 @@ AUTHORIZED? narinfo." (match caches ((cache rest ...) (let* ((narinfos (lookup-narinfos cache paths - #:open-connection open-connection)) + #:open-connection open-connection + #:make-progress-reporter + make-progress-reporter)) (definite (map narinfo-path (filter authorized? narinfos))) (missing (lset-difference string=? paths definite))) ;XXX: perf (loop rest missing From patchwork Wed Feb 24 20:34:12 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 27297 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 2264527BC4B; Wed, 24 Feb 2021 20:35:22 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,UNPARSEABLE_RELAY autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id EEF7327BC4A for ; Wed, 24 Feb 2021 20:35:21 +0000 (GMT) Received: from localhost ([::1]:57312 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lF0sT-0008DB-7Q for patchwork@mira.cbaines.net; Wed, 24 Feb 2021 15:35:21 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:40854) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lF0sA-0008Bo-Sn for guix-patches@gnu.org; Wed, 24 Feb 2021 15:35:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:52735) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lF0sA-0004Nx-Lk for guix-patches@gnu.org; Wed, 24 Feb 2021 15:35:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lF0sA-0006Q7-Ir for guix-patches@gnu.org; Wed, 24 Feb 2021 15:35:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45146] [PATCH 2/2] weather: Call lookup-narinfos with a custom progress reporter. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 24 Feb 2021 20:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45146 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45146@debbugs.gnu.org Received: via spool by 45146-submit@debbugs.gnu.org id=B45146.161419885824615 (code B ref 45146); Wed, 24 Feb 2021 20:35:02 +0000 Received: (at 45146) by debbugs.gnu.org; 24 Feb 2021 20:34:18 +0000 Received: from localhost ([127.0.0.1]:36047 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lF0rS-0006Ow-4x for submit@debbugs.gnu.org; Wed, 24 Feb 2021 15:34:18 -0500 Received: from mira.cbaines.net ([212.71.252.8]:42302) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lF0rN-0006OZ-Dc for 45146@debbugs.gnu.org; Wed, 24 Feb 2021 15:34:14 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:8ac0:b4c7:f5c8:7caa]) by mira.cbaines.net (Postfix) with ESMTPSA id 558B627BC4B for <45146@debbugs.gnu.org>; Wed, 24 Feb 2021 20:34:12 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 0ece7999 for <45146@debbugs.gnu.org>; Wed, 24 Feb 2021 20:34:12 +0000 (UTC) From: Christopher Baines Date: Wed, 24 Feb 2021 20:34:12 +0000 Message-Id: <20210224203412.15135-2-mail@cbaines.net> X-Mailer: git-send-email 2.30.0 In-Reply-To: <20210224203412.15135-1-mail@cbaines.net> References: <20210224203412.15135-1-mail@cbaines.net> 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" X-getmail-retrieved-from-mailbox: Patches This means there's a useful progress bar when running guix weather. * guix/scripts/weather.scm (report-server-coverage): Pass #:make-progress-reporter to lookup-narinfos. --- guix/scripts/weather.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index 9e94bff5a3..26ec543211 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -181,7 +181,11 @@ Return the coverage ratio, an exact number between 0 and 1." (format #t (G_ "looking for ~h store items on ~a...~%") (length items) server) - (let/time ((time narinfos (lookup-narinfos server items))) + (let/time ((time narinfos (lookup-narinfos + server items + #:make-progress-reporter + (lambda* (total #:key url #:allow-other-keys) + (progress-reporter/bar total))))) (format #t "~a~%" server) (let ((obtained (length narinfos)) (requested (length items))