From unknown Sat Jun 14 03:47:58 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#32837 <32837@debbugs.gnu.org> To: bug#32837 <32837@debbugs.gnu.org> Subject: Status: [PATCH 0/5] Improvements to the UI with colors Reply-To: bug#32837 <32837@debbugs.gnu.org> Date: Sat, 14 Jun 2025 10:47:58 +0000 retitle 32837 [PATCH 0/5] Improvements to the UI with colors reassign 32837 guix-patches submitter 32837 Ludovic Court=C3=A8s severity 32837 normal tag 32837 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 25 11:12:42 2018 Received: (at submit) by debbugs.gnu.org; 25 Sep 2018 15:12:42 +0000 Received: from localhost ([127.0.0.1]:53906 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4p0w-0002eS-EZ for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:12:42 -0400 Received: from eggs.gnu.org ([208.118.235.92]:60941) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4p0v-0002eF-DQ for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:12:37 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4p0o-0001Od-1M for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:12:31 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:53070) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1g4p0l-0001Nx-RY for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:12:28 -0400 Received: from eggs.gnu.org ([2001:4830:134:3::10]:42269) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4p0k-0007Ra-8P for guix-patches@gnu.org; Tue, 25 Sep 2018 11:12:27 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4p0g-0001LZ-Ks for guix-patches@gnu.org; Tue, 25 Sep 2018 11:12:26 -0400 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:58734) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4p0W-0000oN-EE; Tue, 25 Sep 2018 11:12:12 -0400 Received: from [193.50.110.247] (port=39510 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1g4p0U-00011B-Gl; Tue, 25 Sep 2018 11:12:12 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: guix-patches@gnu.org Subject: [PATCH 0/5] Improvements to the UI with colors Date: Tue, 25 Sep 2018 17:11:40 +0200 Message-Id: <20180925151140.30687-1-ludo@gnu.org> X-Mailer: git-send-email 2.19.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: submit Cc: Ricardo Wurmus , =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) Hello Guix! This is a followup to the UI work by Sahithi and Ricardo: https://issues.guix.info/issue/32634 The output of ‘guix build’ is almost the same as on ‘master’. The main difference is for ‘guix package’: downloads URLs are now displayed, “updating substitutes from URL” messages and download progress bars are back, both for substitutes and for ‘url-fetch’ kind of downloads, and max-jobs > 1 is reasonably well handled. Upon failure the file name of the build log is printed. ‘guix pack’ and ‘guix environment’ produce output similar to that of ‘guix build’ (that is, build logs are shown.) ‘guix system {init,reconfigure}’ produce concise output similar to ‘guix package’. Other ‘guix system’ sub-commands produce verbose output like ‘guix build’. Internally everything is handled by the (guix status) module. This module keeps track of the on-going and completed builds and downloads (substitutes and fixed-output derivations.) To do that the build side is modified to print additional machine-readable “build traces” (with the new #:print-extended-build-traces? option of ‘set-build-options’.) Old clients talking to the new daemon won’t see the difference because build-side code will produce the same output as before. New clients talking to an old daemon won’t be able to display progress bars and URLs for downloads because the build side won’t produce those “extended build traces”; IOW, it should be as on current ‘master’. It would be great if people could give it a try and report back! You’ll have to run: guix pull --branch=wip-ui and then you can try building things with and without substitutes, with ‘guix package’, with ‘guix build’, etc. If we agree on the mechanism, then we can always fine-tune the output later. Thanks, Ludo’. Ludovic Courtès (5): progress: 'progress-reporter-report!' takes any number of arguments. substitute: Progress port really closes underlying port. progress: Add 'display-download-progress'. Add (guix status) and use it for pretty colored output. perform-download: Optionally report a "download-progress" trace. .dir-locals.el | 1 + Makefile.am | 2 + guix/build/download.scm | 31 +- guix/progress.scm | 106 ++++--- guix/scripts/build.scm | 15 +- guix/scripts/environment.scm | 110 +++---- guix/scripts/pack.scm | 140 ++++----- guix/scripts/package.scm | 24 +- guix/scripts/perform-download.scm | 17 +- guix/scripts/substitute.scm | 44 ++- guix/scripts/system.scm | 11 +- guix/status.scm | 463 ++++++++++++++++++++++++++++++ guix/store.scm | 14 +- guix/ui.scm | 108 +------ nix/libstore/builtins.cc | 5 +- po/guix/POTFILES.in | 1 + tests/status.scm | 115 ++++++++ 17 files changed, 901 insertions(+), 306 deletions(-) create mode 100644 guix/status.scm create mode 100644 tests/status.scm -- 2.19.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 25 11:32:45 2018 Received: (at 32837) by debbugs.gnu.org; 25 Sep 2018 15:32:45 +0000 Received: from localhost ([127.0.0.1]:53936 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKP-0003Cb-CR for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:45 -0400 Received: from eggs.gnu.org ([208.118.235.92]:41994) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKO-0003CB-Bf for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:44 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4pKI-0007QI-J1 for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:39 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-0.5 required=5.0 tests=BAYES_05 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:59340) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4pKE-0007Mj-4U; Tue, 25 Sep 2018 11:32:34 -0400 Received: from [193.50.110.247] (port=39578 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1g4pKD-0000rK-Rq; Tue, 25 Sep 2018 11:32:34 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 32837@debbugs.gnu.org Subject: [PATCH 2/5] substitute: Progress port really closes underlying port. Date: Tue, 25 Sep 2018 17:32:21 +0200 Message-Id: <20180925153224.31342-2-ludo@gnu.org> X-Mailer: git-send-email 2.19.0 In-Reply-To: <20180925153224.31342-1-ludo@gnu.org> References: <20180925153224.31342-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 32837 Cc: Ricardo Wurmus , =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * guix/scripts/substitute.scm (progress-report-port): Use 'close-port' instead of 'close-connection'. Move 'stop' call first. --- guix/scripts/substitute.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 6d31dfdaa..50c6a2206 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -837,8 +837,8 @@ REPORTER, which should be a object." (make-custom-binary-input-port "progress-port-proc" read! #f #f (lambda () - (close-connection port) - (stop))))))) + (stop) + (close-port port))))))) (define-syntax with-networking (syntax-rules () -- 2.19.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 25 11:32:45 2018 Received: (at 32837) by debbugs.gnu.org; 25 Sep 2018 15:32:45 +0000 Received: from localhost ([127.0.0.1]:53938 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKP-0003Ce-JE for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:45 -0400 Received: from eggs.gnu.org ([208.118.235.92]:41999) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKO-0003CD-GM for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:44 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4pKI-0007QG-Is for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:39 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:59339) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4pKD-0007MA-D1; Tue, 25 Sep 2018 11:32:33 -0400 Received: from [193.50.110.247] (port=39578 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1g4pKD-0000rK-4A; Tue, 25 Sep 2018 11:32:33 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 32837@debbugs.gnu.org Subject: [PATCH 1/5] progress: 'progress-reporter-report!' takes any number of arguments. Date: Tue, 25 Sep 2018 17:32:20 +0200 Message-Id: <20180925153224.31342-1-ludo@gnu.org> X-Mailer: git-send-email 2.19.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 32837 Cc: Ricardo Wurmus , =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * guix/progress.scm (progress-reporter-report!): Accept an arbitrary number of arguments and pass them to REPORT. --- guix/progress.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/progress.scm b/guix/progress.scm index c9c3cd12a..53aea1c56 100644 --- a/guix/progress.scm +++ b/guix/progress.scm @@ -70,11 +70,11 @@ stopped." (($ start report stop) (start)))) -(define (progress-reporter-report! reporter) +(define (progress-reporter-report! reporter . args) "Low-level procedure to lead REPORTER to emit a report." (match reporter (($ start report stop) - (report)))) + (apply report args)))) (define (stop-progress-reporter! reporter) "Low-level procedure to stop REPORTER." -- 2.19.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 25 11:32:46 2018 Received: (at 32837) by debbugs.gnu.org; 25 Sep 2018 15:32:46 +0000 Received: from localhost ([127.0.0.1]:53940 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKP-0003Cl-Qa for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:46 -0400 Received: from eggs.gnu.org ([208.118.235.92]:41997) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKO-0003CC-Et for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:44 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4pKI-0007QA-EC for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:39 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:59341) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4pKE-0007Nb-SG; Tue, 25 Sep 2018 11:32:34 -0400 Received: from [193.50.110.247] (port=39578 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1g4pKE-0000rK-JM; Tue, 25 Sep 2018 11:32:34 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 32837@debbugs.gnu.org Subject: [PATCH 3/5] progress: Add 'display-download-progress'. Date: Tue, 25 Sep 2018 17:32:22 +0200 Message-Id: <20180925153224.31342-3-ludo@gnu.org> X-Mailer: git-send-email 2.19.0 In-Reply-To: <20180925153224.31342-1-ludo@gnu.org> References: <20180925153224.31342-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 32837 Cc: Ricardo Wurmus , =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * guix/progress.scm (display-download-progress): New procedure. (progress-reporter/file)[render]: Rewrite in terms of 'display-download-progress'. --- guix/progress.scm | 72 +++++++++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 31 deletions(-) diff --git a/guix/progress.scm b/guix/progress.scm index 53aea1c56..d4ebb3299 100644 --- a/guix/progress.scm +++ b/guix/progress.scm @@ -39,6 +39,7 @@ progress-reporter/file progress-reporter/bar + display-download-progress byte-count->string current-terminal-columns @@ -183,6 +184,42 @@ width of the bar is BAR-WIDTH." move the cursor to the beginning of the line." (display "\r\x1b[K" port)) +(define* (display-download-progress file size + #:key + start-time (transferred 0) + (log-port (current-error-port))) + "Write the progress report to LOG-PORT. Use START-TIME (a SRFI-19 time +object) and TRANSFERRED (a total number of bytes) to determine the +throughput." + (define elapsed + (duration->seconds + (time-difference (current-time time-monotonic) start-time))) + (if (number? size) + (let* ((% (* 100.0 (/ transferred size))) + (throughput (/ transferred elapsed)) + (left (format #f " ~a ~a" file + (byte-count->string size))) + (right (format #f "~a/s ~a ~a~6,1f%" + (byte-count->string throughput) + (seconds->string elapsed) + (progress-bar %) %))) + (erase-current-line log-port) + (display (string-pad-middle left right + (current-terminal-columns)) + log-port) + (force-output log-port)) + (let* ((throughput (/ transferred elapsed)) + (left (format #f " ~a" file)) + (right (format #f "~a/s ~a | ~a transferred" + (byte-count->string throughput) + (seconds->string elapsed) + (byte-count->string transferred)))) + (erase-current-line log-port) + (display (string-pad-middle left right + (current-terminal-columns)) + log-port) + (force-output log-port)))) + (define* (progress-reporter/file file size #:optional (log-port (current-output-port)) #:key (abbreviation basename)) @@ -192,37 +229,10 @@ ABBREVIATION used to shorten FILE for display." (let ((start-time (current-time time-monotonic)) (transferred 0)) (define (render) - "Write the progress report to LOG-PORT." - (define elapsed - (duration->seconds - (time-difference (current-time time-monotonic) start-time))) - (if (number? size) - (let* ((% (* 100.0 (/ transferred size))) - (throughput (/ transferred elapsed)) - (left (format #f " ~a ~a" - (abbreviation file) - (byte-count->string size))) - (right (format #f "~a/s ~a ~a~6,1f%" - (byte-count->string throughput) - (seconds->string elapsed) - (progress-bar %) %))) - (erase-current-line log-port) - (display (string-pad-middle left right - (current-terminal-columns)) - log-port) - (force-output log-port)) - (let* ((throughput (/ transferred elapsed)) - (left (format #f " ~a" - (abbreviation file))) - (right (format #f "~a/s ~a | ~a transferred" - (byte-count->string throughput) - (seconds->string elapsed) - (byte-count->string transferred)))) - (erase-current-line log-port) - (display (string-pad-middle left right - (current-terminal-columns)) - log-port) - (force-output log-port)))) + (display-download-progress (abbreviation file) size + #:start-time start-time + #:transferred transferred + #:log-port log-port)) (progress-reporter (start render) -- 2.19.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 25 11:32:53 2018 Received: (at 32837) by debbugs.gnu.org; 25 Sep 2018 15:32:53 +0000 Received: from localhost ([127.0.0.1]:53943 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKV-0003D9-9k for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:53 -0400 Received: from eggs.gnu.org ([208.118.235.92]:42022) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKP-0003CF-Qh for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:46 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4pKJ-0007Qq-73 for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:40 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:59345) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4pKG-0007PD-Ll; Tue, 25 Sep 2018 11:32:36 -0400 Received: from [193.50.110.247] (port=39578 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1g4pKG-0000rK-C1; Tue, 25 Sep 2018 11:32:36 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 32837@debbugs.gnu.org Subject: [PATCH 5/5] perform-download: Optionally report a "download-progress" trace. Date: Tue, 25 Sep 2018 17:32:24 +0200 Message-Id: <20180925153224.31342-5-ludo@gnu.org> X-Mailer: git-send-email 2.19.0 In-Reply-To: <20180925153224.31342-1-ludo@gnu.org> References: <20180925153224.31342-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 32837 Cc: Ricardo Wurmus , =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * guix/scripts/perform-download.scm (perform-download): Add #:print-build-trace? and pass it to 'url-fetch'. (guix-perform-download): Define 'print-build-trace?' and pass it to 'perform-download'. * guix/build/download.scm (ftp-fetch): Add #:print-build-trace? and honor it. (url-fetch): Likewise. * nix/libstore/builtins.cc (builtinDownload): Set _NIX_OPTIONS environment variable. --- guix/build/download.scm | 31 +++++++++++++++++++++---------- guix/scripts/perform-download.scm | 18 +++++++++++++----- nix/libstore/builtins.cc | 5 ++++- 3 files changed, 38 insertions(+), 16 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index 315a3554e..54163849a 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -115,7 +115,7 @@ and 'guix publish', something like (string-drop path 33) path))) -(define* (ftp-fetch uri file #:key timeout) +(define* (ftp-fetch uri file #:key timeout print-build-trace?) "Fetch data from URI and write it to FILE. Return FILE on success. Bail out if the connection could not be established in less than TIMEOUT seconds." (let* ((conn (match (and=> (uri-userinfo uri) @@ -136,12 +136,17 @@ out if the connection could not be established in less than TIMEOUT seconds." (lambda (out) (dump-port* in out #:buffer-size %http-receive-buffer-size - #:reporter (progress-reporter/file - (uri-abbreviation uri) size)))) + #:reporter + (if print-build-trace? + (progress-reporter/trace + file (uri->string uri) size) + (progress-reporter/file + (uri-abbreviation uri) size))))) - (ftp-close conn)) - (newline) - file) + (ftp-close conn) + (unless print-build-trace? + (newline)) + file)) ;; Autoload GnuTLS so that this module can be used even when GnuTLS is ;; not available. At compile time, this yields "possibly unbound @@ -723,7 +728,8 @@ Return a list of URIs." #:key (timeout 10) (verify-certificate? #t) (mirrors '()) (content-addressed-mirrors '()) - (hashes '())) + (hashes '()) + print-build-trace?) "Fetch FILE from URL; URL may be either a single string, or a list of string denoting alternate URLs for FILE. Return #f on failure, and FILE on success. @@ -759,13 +765,18 @@ otherwise simply ignore them." (lambda (output) (dump-port* port output #:buffer-size %http-receive-buffer-size - #:reporter (progress-reporter/file - (uri-abbreviation uri) size)) + #:reporter (if print-build-trace? + (progress-reporter/trace + file (uri->string uri) size) + (progress-reporter/file + (uri-abbreviation uri) size))) (newline))) file))) ((ftp) (false-if-exception* (ftp-fetch uri file - #:timeout timeout))) + #:timeout timeout + #:print-build-trace? + print-build-trace?))) (else (format #t "skipping URI with unsupported scheme: ~s~%" uri) diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index 9f6ecc00d..df787a994 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,14 +41,14 @@ (module-use! module (resolve-interface '(guix base32))) module)) -(define* (perform-download drv #:optional output) +(define* (perform-download drv #:optional output + #:key print-build-trace?) "Perform the download described by DRV, a fixed-output derivation, to OUTPUT. Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the actual output is different from that when we're doing a 'bmCheck' or 'bmRepair' build." - ;; TODO: Use 'trace-progress-proc' when possible. (derivation-let drv ((url "url") (output* "out") (executable "executable") @@ -68,6 +68,7 @@ actual output is different from that when we're doing a 'bmCheck' or ;; We're invoked by the daemon, which gives us write access to OUTPUT. (when (url-fetch url output + #:print-build-trace? print-build-trace? #:mirrors (if mirrors (call-with-input-file mirrors read) '()) @@ -99,6 +100,11 @@ allows us to sidestep bootstrapping problems, such downloading the source code of GnuTLS over HTTPS, before we have built GnuTLS. See ." + (define print-build-trace? + (match (getenv "_NIX_OPTIONS") + (#f #f) + (str (string-contains str "print-extended-build-trace=1")))) + ;; This program must be invoked by guix-daemon under an unprivileged UID to ;; prevent things downloading from 'file:///etc/shadow' or arbitrary code ;; execution via the content-addressed mirror procedures. (That means we @@ -108,10 +114,12 @@ of GnuTLS over HTTPS, before we have built GnuTLS. See (((? derivation-path? drv) (? store-path? output)) (assert-low-privileges) (perform-download (read-derivation-from-file drv) - output)) + output + #:print-build-trace? print-build-trace?)) (((? derivation-path? drv)) ;backward compatibility (assert-low-privileges) - (perform-download (read-derivation-from-file drv))) + (perform-download (read-derivation-from-file drv) + #:print-build-trace? print-build-trace?)) (("--version") (show-version-and-exit)) (x diff --git a/nix/libstore/builtins.cc b/nix/libstore/builtins.cc index a5ebb4773..1f52511c8 100644 --- a/nix/libstore/builtins.cc +++ b/nix/libstore/builtins.cc @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2016, 2017 Ludovic Courtès + Copyright (C) 2016, 2017, 2018 Ludovic Courtès This file is part of GNU Guix. @@ -47,6 +47,9 @@ static void builtinDownload(const Derivation &drv, content-addressed mirrors) works correctly. */ setenv("NIX_STORE", settings.nixStore.c_str(), 1); + /* Tell it about options such as "print-extended-build-trace". */ + setenv("_NIX_OPTIONS", settings.pack().c_str(), 1); + /* XXX: Hack our way to use the 'download' script from 'LIBEXECDIR/guix' or just 'LIBEXECDIR', depending on whether we're running uninstalled or not. */ -- 2.19.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 25 11:32:58 2018 Received: (at 32837) by debbugs.gnu.org; 25 Sep 2018 15:32:58 +0000 Received: from localhost ([127.0.0.1]:53946 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKa-0003DQ-Mb for submit@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:58 -0400 Received: from eggs.gnu.org ([208.118.235.92]:42066) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1g4pKV-0003Cx-Cx for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:54 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g4pKL-0007SV-Ey for 32837@debbugs.gnu.org; Tue, 25 Sep 2018 11:32:46 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:59343) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g4pKF-0007Oj-TM; Tue, 25 Sep 2018 11:32:36 -0400 Received: from [193.50.110.247] (port=39578 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1g4pKF-0000rK-Aw; Tue, 25 Sep 2018 11:32:35 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 32837@debbugs.gnu.org Subject: [PATCH 4/5] Add (guix status) and use it for pretty colored output. Date: Tue, 25 Sep 2018 17:32:23 +0200 Message-Id: <20180925153224.31342-4-ludo@gnu.org> X-Mailer: git-send-email 2.19.0 In-Reply-To: <20180925153224.31342-1-ludo@gnu.org> References: <20180925153224.31342-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 32837 Cc: Ricardo Wurmus , =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * guix/progress.scm (progress-reporter/trace): New procedure. * guix/scripts/build.scm (set-build-options-from-command-line): Pass #:print-extended-build-trace?. (%default-options): Add 'print-extended-build-trace?'. (guix-build): Parameterize CURRENT-TERMINAL-COLUMNS. Use 'build-status-updater'. * guix/scripts/environment.scm (%default-options): Add 'print-extended-build-trace?'. (guix-environment): Wrap body in 'with-status-report'. * guix/scripts/pack.scm (%default-options): Add 'print-build-trace?' and 'print-extended-build-trace?'. (guix-pack): Wrap body in 'with-status-report'. * guix/scripts/package.scm (%default-options, guix-package): Likewise. * guix/scripts/system.scm (%default-options, guix-system): Likewise. * guix/scripts/substitute.scm (progress-report-port): Don't call STOP when TOTAL is zero. (process-substitution): Add #:print-build-trace? and honor it. (guix-substitute)[print-build-trace?]: New variable. Pass #:print-build-trace? to 'process-substitution'. * guix/status.scm: New file. * guix/store.scm (set-build-options): Add #:print-extended-build-trace?; pass it into PAIRS. * guix/ui.scm (build-output-port): Remove. (colorize-string): Export. * po/guix/POTFILES.in: Add guix/status.scm. * tests/status.scm: New file. * Makefile.am (SCM_TESTS): Add it. --- .dir-locals.el | 1 + Makefile.am | 2 + guix/progress.scm | 30 +- guix/scripts/build.scm | 15 +- guix/scripts/environment.scm | 110 +++---- guix/scripts/pack.scm | 140 ++++----- guix/scripts/package.scm | 24 +- guix/scripts/perform-download.scm | 1 + guix/scripts/substitute.scm | 42 ++- guix/scripts/system.scm | 11 +- guix/status.scm | 463 ++++++++++++++++++++++++++++++ guix/store.scm | 14 +- guix/ui.scm | 108 +------ po/guix/POTFILES.in | 1 + tests/status.scm | 115 ++++++++ 15 files changed, 820 insertions(+), 257 deletions(-) create mode 100644 guix/status.scm create mode 100644 tests/status.scm diff --git a/.dir-locals.el b/.dir-locals.el index eb99a5bcc..793117c0a 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -59,6 +59,7 @@ (eval . (put 'emacs-substitute-variables 'scheme-indent-function 1)) (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1)) (eval . (put 'with-derivation-substitute 'scheme-indent-function 2)) + (eval . (put 'with-status-report 'scheme-indent-function 1)) (eval . (put 'mlambda 'scheme-indent-function 1)) (eval . (put 'mlambdaq 'scheme-indent-function 1)) diff --git a/Makefile.am b/Makefile.am index 5c8639d66..7fd29b90a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -131,6 +131,7 @@ MODULES = \ guix/svn-download.scm \ guix/i18n.scm \ guix/ui.scm \ + guix/status.scm \ guix/build/android-ndk-build-system.scm \ guix/build/ant-build-system.scm \ guix/build/download.scm \ @@ -340,6 +341,7 @@ SCM_TESTS = \ tests/glob.scm \ tests/grafts.scm \ tests/ui.scm \ + tests/status.scm \ tests/records.scm \ tests/upstream.scm \ tests/combinators.scm \ diff --git a/guix/progress.scm b/guix/progress.scm index d4ebb3299..27610091c 100644 --- a/guix/progress.scm +++ b/guix/progress.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Sou Bunnbu ;;; Copyright © 2015 Steve Sprang -;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,8 +38,11 @@ progress-reporter/silent progress-reporter/file progress-reporter/bar + progress-reporter/trace display-download-progress + erase-current-line + progress-bar byte-count->string current-terminal-columns @@ -279,6 +282,31 @@ tasks is performed. Write PREFIX at the beginning of the line." (newline port)) (force-output port))))) +(define* (progress-reporter/trace file url size + #:optional (log-port (current-output-port))) + "Like 'progress-reporter/file', but instead of returning human-readable +progress reports, write \"build trace\" lines to be processed elsewhere." + (define (report-progress transferred) + (define message + (format #f "@ download-progress ~a ~a ~a ~a~%" + file url (or size "-") transferred)) + + (display message log-port) ;should be atomic + (flush-output-port log-port)) + + (progress-reporter + (start (lambda () + (display (format #f "@ download-started ~a ~a ~a~%" + file url (or size "-")) + log-port))) + (report report-progress) + (stop (lambda () + (display (format #f "@ download-succeeded ~a ~a ~a~%" + file url + (or (and=> (stat file #f) stat:size) + size)) + log-port))))) + ;; TODO: replace '(@ (guix build utils) dump-port))'. (define* (dump-port* in out #:key (buffer-size 16384) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 3fa3c2c20..5a6ba62bc 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -45,6 +45,9 @@ #:use-module (srfi srfi-37) #:autoload (gnu packages) (specification->package %package-module-path) #:autoload (guix download) (download-to-store) + #:use-module (guix status) + #:use-module ((guix progress) #:select (current-terminal-columns)) + #:use-module ((guix build syscalls) #:select (terminal-columns)) #:export (%standard-build-options set-build-options-from-command-line set-build-options-from-command-line* @@ -390,6 +393,8 @@ options handled by 'set-build-options-from-command-line', and listed in #:max-silent-time (assoc-ref opts 'max-silent-time) #:timeout (assoc-ref opts 'timeout) #:print-build-trace (assoc-ref opts 'print-build-trace?) + #:print-extended-build-trace? + (assoc-ref opts 'print-extended-build-trace?) #:verbosity (assoc-ref opts 'verbosity))) (define set-build-options-from-command-line* @@ -499,6 +504,7 @@ options handled by 'set-build-options-from-command-line', and listed in (substitutes? . #t) (build-hook? . #t) (print-build-trace? . #t) + (print-extended-build-trace? . #t) (verbosity . 0))) (define (show-help) @@ -733,9 +739,12 @@ needed." ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) - (parameterize ((current-build-output-port (if quiet? - (%make-void-port "w") - (build-output-port #:verbose? #t)))) + (parameterize ((current-terminal-columns (terminal-columns)) + (current-build-output-port + (if quiet? + (%make-void-port "w") + (build-event-output-port + (build-status-updater print-build-event))))) (let* ((mode (assoc-ref opts 'build-mode)) (drv (options->derivations store opts)) (urls (map (cut string-append <> "/log") diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 1c04800e4..9fc7edcd3 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -21,6 +21,7 @@ (define-module (guix scripts environment) #:use-module (guix ui) #:use-module (guix store) + #:use-module (guix status) #:use-module (guix grafts) #:use-module (guix derivations) #:use-module (guix packages) @@ -173,6 +174,8 @@ COMMAND or an interactive shell in that environment.\n")) (substitutes? . #t) (build-hook? . #t) (graft? . #t) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) (verbosity . 0))) (define (tag-package-arg opts arg) @@ -661,59 +664,60 @@ message if any test fails." (leave (G_ "'--user' cannot be used without '--container'~%"))) (with-store store - (set-build-options-from-command-line store opts) + (with-status-report print-build-event + (set-build-options-from-command-line store opts) - ;; Use the bootstrap Guile when requested. - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (%guile-for-build - (package-derivation - store - (if bootstrap? - %bootstrap-guile - (canonical-package guile-2.2))))) - (run-with-store store - ;; Containers need a Bourne shell at /bin/sh. - (mlet* %store-monad ((bash (environment-bash container? - bootstrap? - system)) - (prof-drv (manifest->derivation - manifest system bootstrap?)) - (profile -> (derivation->output-path prof-drv)) - (gc-root -> (assoc-ref opts 'gc-root))) + ;; Use the bootstrap Guile when requested. + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build + (package-derivation + store + (if bootstrap? + %bootstrap-guile + (canonical-package guile-2.2))))) + (run-with-store store + ;; Containers need a Bourne shell at /bin/sh. + (mlet* %store-monad ((bash (environment-bash container? + bootstrap? + system)) + (prof-drv (manifest->derivation + manifest system bootstrap?)) + (profile -> (derivation->output-path prof-drv)) + (gc-root -> (assoc-ref opts 'gc-root))) - ;; First build the inputs. This is necessary even for - ;; --search-paths. Additionally, we might need to build bash for - ;; a container. - (mbegin %store-monad - (build-environment (if (derivation? bash) - (list prof-drv bash) - (list prof-drv)) - opts) - (mwhen gc-root - (register-gc-root profile gc-root)) + ;; First build the inputs. This is necessary even for + ;; --search-paths. Additionally, we might need to build bash for + ;; a container. + (mbegin %store-monad + (build-environment (if (derivation? bash) + (list prof-drv bash) + (list prof-drv)) + opts) + (mwhen gc-root + (register-gc-root profile gc-root)) - (cond - ((assoc-ref opts 'dry-run?) - (return #t)) - ((assoc-ref opts 'search-paths) - (show-search-paths profile manifest #:pure? pure?) - (return #t)) - (container? - (let ((bash-binary - (if bootstrap? - bash - (string-append (derivation->output-path bash) - "/bin/sh")))) - (launch-environment/container #:command command - #:bash bash-binary - #:user user - #:user-mappings mappings - #:profile profile - #:manifest manifest - #:link-profile? link-prof? - #:network? network?))) - (else - (return - (exit/status - (launch-environment/fork command profile manifest - #:pure? pure?))))))))))))) + (cond + ((assoc-ref opts 'dry-run?) + (return #t)) + ((assoc-ref opts 'search-paths) + (show-search-paths profile manifest #:pure? pure?) + (return #t)) + (container? + (let ((bash-binary + (if bootstrap? + bash + (string-append (derivation->output-path bash) + "/bin/sh")))) + (launch-environment/container #:command command + #:bash bash-binary + #:user user + #:user-mappings mappings + #:profile profile + #:manifest manifest + #:link-profile? link-prof? + #:network? network?))) + (else + (return + (exit/status + (launch-environment/fork command profile manifest + #:pure? pure?)))))))))))))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 1916f3b9d..163f5b1dc 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -25,6 +25,7 @@ #:use-module (guix gexp) #:use-module (guix utils) #:use-module (guix store) + #:use-module (guix status) #:use-module (guix grafts) #:use-module (guix monads) #:use-module (guix modules) @@ -538,6 +539,8 @@ please email '~a'~%") (substitutes? . #t) (build-hook? . #t) (graft? . #t) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) (verbosity . 0) (symlinks . ()) (compressor . ,(first %compressors)))) @@ -684,72 +687,73 @@ Create a bundle of PACKAGE.\n")) (with-error-handling (with-store store - ;; Set the build options before we do anything else. - (set-build-options-from-command-line store opts) + (with-status-report print-build-event + ;; Set the build options before we do anything else. + (set-build-options-from-command-line store opts) - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (%guile-for-build (package-derivation - store - (if (assoc-ref opts 'bootstrap?) - %bootstrap-guile - (canonical-package guile-2.2)) - (assoc-ref opts 'system) - #:graft? (assoc-ref opts 'graft?)))) - (let* ((dry-run? (assoc-ref opts 'dry-run?)) - (relocatable? (assoc-ref opts 'relocatable?)) - (manifest (let ((manifest (manifest-from-args store opts))) - ;; Note: We cannot honor '--bootstrap' here because - ;; 'glibc-bootstrap' lacks 'libc.a'. - (if relocatable? - (map-manifest-entries wrapped-package manifest) - manifest))) - (pack-format (assoc-ref opts 'format)) - (name (string-append (symbol->string pack-format) - "-pack")) - (target (assoc-ref opts 'target)) - (bootstrap? (assoc-ref opts 'bootstrap?)) - (compressor (if bootstrap? - bootstrap-xz - (assoc-ref opts 'compressor))) - (archiver (if (equal? pack-format 'squashfs) - squashfs-tools-next - (if bootstrap? - %bootstrap-coreutils&co - tar))) - (symlinks (assoc-ref opts 'symlinks)) - (build-image (match (assq-ref %formats pack-format) - ((? procedure? proc) proc) - (#f - (leave (G_ "~a: unknown pack format~%") - pack-format)))) - (localstatedir? (assoc-ref opts 'localstatedir?))) - (run-with-store store - (mlet* %store-monad ((profile (profile-derivation - manifest - #:relative-symlinks? relocatable? - #:hooks (if bootstrap? - '() - %default-profile-hooks) - #:locales? (not bootstrap?) - #:target target)) - (drv (build-image name profile - #:target - target - #:compressor - compressor - #:symlinks - symlinks - #:localstatedir? - localstatedir? - #:archiver - archiver))) - (mbegin %store-monad - (show-what-to-build* (list drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - (munless dry-run? - (built-derivations (list drv)) - (return (format #t "~a~%" - (derivation->output-path drv)))))) - #:system (assoc-ref opts 'system))))))) + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build (package-derivation + store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2)) + (assoc-ref opts 'system) + #:graft? (assoc-ref opts 'graft?)))) + (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (relocatable? (assoc-ref opts 'relocatable?)) + (manifest (let ((manifest (manifest-from-args store opts))) + ;; Note: We cannot honor '--bootstrap' here because + ;; 'glibc-bootstrap' lacks 'libc.a'. + (if relocatable? + (map-manifest-entries wrapped-package manifest) + manifest))) + (pack-format (assoc-ref opts 'format)) + (name (string-append (symbol->string pack-format) + "-pack")) + (target (assoc-ref opts 'target)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (compressor (if bootstrap? + bootstrap-xz + (assoc-ref opts 'compressor))) + (archiver (if (equal? pack-format 'squashfs) + squashfs-tools-next + (if bootstrap? + %bootstrap-coreutils&co + tar))) + (symlinks (assoc-ref opts 'symlinks)) + (build-image (match (assq-ref %formats pack-format) + ((? procedure? proc) proc) + (#f + (leave (G_ "~a: unknown pack format~%") + pack-format)))) + (localstatedir? (assoc-ref opts 'localstatedir?))) + (run-with-store store + (mlet* %store-monad ((profile (profile-derivation + manifest + #:relative-symlinks? relocatable? + #:hooks (if bootstrap? + '() + %default-profile-hooks) + #:locales? (not bootstrap?) + #:target target)) + (drv (build-image name profile + #:target + target + #:compressor + compressor + #:symlinks + symlinks + #:localstatedir? + localstatedir? + #:archiver + archiver))) + (mbegin %store-monad + (show-what-to-build* (list drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?) + (munless dry-run? + (built-derivations (list drv)) + (return (format #t "~a~%" + (derivation->output-path drv)))))) + #:system (assoc-ref opts 'system)))))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 73cbccba3..93a77915f 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -24,6 +24,7 @@ (define-module (guix scripts package) #:use-module (guix ui) + #:use-module (guix status) #:use-module (guix store) #:use-module (guix grafts) #:use-module (guix derivations) @@ -330,7 +331,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE." (graft? . #t) (substitutes? . #t) (build-hook? . #t) - (print-build-trace? . #t))) + (print-build-trace? . #t) + (print-extended-build-trace? . #t))) (define (show-help) (display (G_ "Usage: guix package [OPTION]... @@ -941,14 +943,12 @@ processed, #f otherwise." (or (process-query opts) (parameterize ((%store (open-connection)) (%graft? (assoc-ref opts 'graft?))) - (set-build-options-from-command-line (%store) opts) - - (parameterize ((%guile-for-build - (package-derivation - (%store) - (if (assoc-ref opts 'bootstrap?) - %bootstrap-guile - (canonical-package guile-2.2)))) - (current-build-output-port - (build-output-port #:verbose? verbose?))) - (process-actions (%store) opts)))))) + (with-status-report print-build-event/quiet + (set-build-options-from-command-line (%store) opts) + (parameterize ((%guile-for-build + (package-derivation + (%store) + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2))))) + (process-actions (%store) opts))))))) diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index 18e2fc92f..9f6ecc00d 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -48,6 +48,7 @@ OUTPUT. Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the actual output is different from that when we're doing a 'bmCheck' or 'bmRepair' build." + ;; TODO: Use 'trace-progress-proc' when possible. (derivation-let drv ((url "url") (output* "out") (executable "executable") diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 50c6a2206..eb8222401 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -837,7 +837,16 @@ REPORTER, which should be a object." (make-custom-binary-input-port "progress-port-proc" read! #f #f (lambda () - (stop) + ;; XXX: Kludge! When used through + ;; 'decompressed-port', this port ends + ;; up being closed twice: once in a + ;; child process early on, and at the + ;; end in the parent process. Ignore + ;; the early close so we don't output + ;; a spurious "download-succeeded" + ;; trace. + (unless (zero? total) + (stop)) (close-port port))))))) (define-syntax with-networking @@ -930,7 +939,7 @@ authorized substitutes." (error "unknown `--query' command" wtf)))) (define* (process-substitution store-item destination - #:key cache-urls acl) + #:key cache-urls acl print-build-trace?) "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to DESTINATION as a nar file. Verify the substitute against ACL." (let* ((narinfo (lookup-narinfo cache-urls store-item @@ -943,8 +952,10 @@ DESTINATION as a nar file. Verify the substitute against ACL." ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) - (format (current-error-port) - (G_ "Downloading ~a...~%") (uri->string uri)) + (unless print-build-trace? + (format (current-error-port) + (G_ "Downloading ~a...~%") (uri->string uri))) + (let*-values (((raw download-size) ;; Note that Hydra currently generates Nars on the fly ;; and doesn't specify a Content-Length, so @@ -955,10 +966,15 @@ DESTINATION as a nar file. Verify the substitute against ACL." (dl-size (or download-size (and (equal? comp "none") (narinfo-size narinfo)))) - (reporter (progress-reporter/file - (uri->string uri) dl-size - (current-error-port) - #:abbreviation nar-uri-abbreviation))) + (reporter (if print-build-trace? + (progress-reporter/trace + destination + (uri->string uri) dl-size + (current-error-port)) + (progress-reporter/file + (uri->string uri) dl-size + (current-error-port) + #:abbreviation nar-uri-abbreviation)))) (progress-report-port reporter raw))) ((input pids) ;; NOTE: This 'progress' port of current process will be @@ -1058,6 +1074,13 @@ default value." (define (guix-substitute . args) "Implement the build daemon's substituter protocol." + (define print-build-trace? + (match (or (find-daemon-option "untrusted-print-extended-build-trace") + (find-daemon-option "print-extended-build-trace")) + (#f #f) + ((= string->number number) (> number 0)) + (_ #f))) + (mkdir-p %narinfo-cache-directory) (maybe-remove-expired-cache-entries %narinfo-cache-directory cached-narinfo-files @@ -1111,7 +1134,8 @@ default value." (parameterize ((current-terminal-columns (client-terminal-columns))) (process-substitution store-path destination #:cache-urls (substitute-urls) - #:acl (current-acl)))) + #:acl (current-acl) + #:print-build-trace? print-build-trace?))) ((or ("-V") ("--version")) (show-version-and-exit "guix substitute")) (("--help") diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 69bd05b51..5d003c88f 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -23,6 +23,7 @@ (define-module (guix scripts system) #:use-module (guix config) #:use-module (guix ui) + #:use-module (guix status) #:use-module (guix store) #:autoload (guix store database) (register-path) #:use-module (guix grafts) @@ -1072,6 +1073,8 @@ Some ACTIONS support additional ARGS.\n")) `((system . ,(%current-system)) (substitutes? . #t) (build-hook? . #t) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) (graft? . #t) (verbosity . 0) (file-system-type . "ext4") @@ -1246,9 +1249,11 @@ argument list and OPTS is the option alist." parse-sub-command)) (args (option-arguments opts)) (command (assoc-ref opts 'action))) - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (current-terminal-columns (terminal-columns))) - (process-command command args opts))))) + (parameterize ((%graft? (assoc-ref opts 'graft?))) + (with-status-report (if (memq command '(init reconfigure)) + print-build-event/quiet + print-build-event) + (process-command command args opts)))))) ;;; Local Variables: ;;; eval: (put 'call-with-service-upgrade-info 'scheme-indent-function 1) diff --git a/guix/status.scm b/guix/status.scm new file mode 100644 index 000000000..60727892f --- /dev/null +++ b/guix/status.scm @@ -0,0 +1,463 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017, 2018 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix status) + #:use-module (guix records) + #:use-module (guix i18n) + #:use-module ((guix ui) #:select (colorize-string)) + #:use-module (guix progress) + #:autoload (guix build syscalls) (terminal-columns) + #:use-module ((guix store) + #:select (current-build-output-port log-file)) + #:use-module (guix derivations) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (ice-9 regex) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (ice-9 binary-ports) + #:use-module (rnrs bytevectors) + #:use-module ((system foreign) + #:select (bytevector->pointer pointer->bytevector)) + #:export (build-event-output-port + compute-status + + build-status + build-status? + build-status-building + build-status-downloading + build-status-builds-completed + build-status-downloads-completed + + download? + download + download-item + download-uri + download-size + download-start + download-end + download-transferred + + build-status-updater + print-build-event + print-build-event/quiet + print-build-status + + with-status-report)) + +;;; Commentary: +;;; +;;; This module provides facilities to track the status of ongoing builds and +;;; downloads in a given session, as well as tools to report about the current +;;; status to user interfaces. It does so by analyzing the output of +;;; 'current-build-output-port'. The build status is maintained in a +;;; record. +;;; +;;; Code: + + +;;; +;;; Build status tracking. +;;; + +;; Builds and substitutions performed by the daemon. +(define-record-type* build-status make-build-status + build-status? + (building build-status-building ;list of drv + (default '())) + (downloading build-status-downloading ;list of + (default '())) + (builds-completed build-status-builds-completed ;list of drv + (default '())) + (downloads-completed build-status-downloads-completed ;list of store items + (default '()))) + +;; On-going or completed downloads. Downloads can be stem from substitutes +;; and from "builtin:download" fixed-output derivations. +(define-record-type + (%download item uri size start end transferred) + download? + (item download-item) ;store item + (uri download-uri) ;string | #f + (size download-size) ;integer | #f + (start download-start) ;