From patchwork Thu Mar 19 11:02:45 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20754 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 5952A27BBEA; Thu, 19 Mar 2020 11:04:17 +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 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 ESMTP id 2294527BBE4 for ; Thu, 19 Mar 2020 11:04:17 +0000 (GMT) Received: from localhost ([::1]:36142 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyG-0007mO-K2 for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:16 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34618) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsy4-0007lp-K8 for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy2-0001g7-Eh for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35866) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy2-0001fv-BZ for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy2-0000Q1-6d for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 1/8] syscalls: 'with-file-lock' re-grabs lock when reentering its dynamic extent. References: <20200319105642.4830-1-ludo@gnu.org> In-Reply-To: <20200319105642.4830-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157861459 (code B ref 40130); Thu, 19 Mar 2020 11:04:02 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:06 +0000 Received: from localhost ([127.0.0.1]:41819 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsx8-0000NR-7L for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:06 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47495) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsx6-0000Mf-Av for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:04 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45148) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx1-000073-5h; Thu, 19 Mar 2020 07:02:59 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx0-0001MW-Jh; Thu, 19 Mar 2020 07:02:58 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:45 +0100 Message-Id: <20200319110252.5081-1-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 * guix/build/syscalls.scm (call-with-file-lock) (call-with-file-lock/no-wait): Initialize PORT in the 'dynamic-wind' "in" handler. This allows us to re-enter a captured continuation and have the lock grabbed anew. --- guix/build/syscalls.scm | 64 +++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 31 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index ae79a9708f..0938ec0ff1 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1104,47 +1104,49 @@ exception if it's already taken." #t) (define (call-with-file-lock file thunk) - (let ((port (catch 'system-error - (lambda () - (lock-file file)) - (lambda args - ;; When using the statically-linked Guile in the initrd, - ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore - ;; that error since we're typically the only process running - ;; at this point. - (if (= ENOSYS (system-error-errno args)) - #f - (apply throw args)))))) + (let ((port #f)) (dynamic-wind (lambda () - #t) + (set! port + (catch 'system-error + (lambda () + (lock-file file)) + (lambda args + ;; When using the statically-linked Guile in the initrd, + ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore + ;; that error since we're typically the only process running + ;; at this point. + (if (= ENOSYS (system-error-errno args)) + #f + (apply throw args)))))) thunk (lambda () (when port (unlock-file port)))))) (define (call-with-file-lock/no-wait file thunk handler) - (let ((port (catch #t - (lambda () - (lock-file file #:wait? #f)) - (lambda (key . args) - (match key - ('flock-error - (apply handler args) - ;; No open port to the lock, so return #f. - #f) - ('system-error - ;; When using the statically-linked Guile in the initrd, - ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore - ;; that error since we're typically the only process running - ;; at this point. - (if (= ENOSYS (system-error-errno (cons key args))) - #f - (apply throw key args))) - (_ (apply throw key args))))))) + (let ((port #f)) (dynamic-wind (lambda () - #t) + (set! port + (catch #t + (lambda () + (lock-file file #:wait? #f)) + (lambda (key . args) + (match key + ('flock-error + (apply handler args) + ;; No open port to the lock, so return #f. + #f) + ('system-error + ;; When using the statically-linked Guile in the initrd, + ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore + ;; that error since we're typically the only process running + ;; at this point. + (if (= ENOSYS (system-error-errno (cons key args))) + #f + (apply throw key args))) + (_ (apply throw key args))))))) thunk (lambda () (when port From patchwork Thu Mar 19 11:02:46 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20759 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 8F13827BBE4; Thu, 19 Mar 2020 11:04:44 +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, URIBL_BLOCKED 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 ESMTP id C443027BBEA for ; Thu, 19 Mar 2020 11:04:43 +0000 (GMT) Received: from localhost ([::1]:36160 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyh-00084w-B2 for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:43 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34651) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsy6-0007lt-D8 for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy4-0001ma-Jc for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35867) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy2-0001gc-PT for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy2-0000Q8-Lr for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 2/8] store: Add 'with-build-handler'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157901497 (code B ref 40130); Thu, 19 Mar 2020 11:04:02 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:10 +0000 Received: from localhost ([127.0.0.1]:41825 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxB-0000Ny-P5 for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:10 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47497) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsx7-0000Mj-C4 for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:05 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45149) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx2-00009I-6t; Thu, 19 Mar 2020 07:03:00 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx1-0001MW-Hv; Thu, 19 Mar 2020 07:02:59 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:46 +0100 Message-Id: <20200319110252.5081-2-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 * guix/store.scm (current-build-prompt): New variable. (call-with-build-handler, invoke-build-handler): New procedures. (with-build-handler): New macro. * tests/store.scm ("with-build-handler"): New test. --- .dir-locals.el | 1 + guix/store.scm | 75 +++++++++++++++++++++++++++++++++++++++---------- tests/store.scm | 34 +++++++++++++++++++++- 3 files changed, 94 insertions(+), 16 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index 1976f7e60d..ce305602f2 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -68,6 +68,7 @@ (eval . (put 'with-derivation-substitute 'scheme-indent-function 2)) (eval . (put 'with-status-report 'scheme-indent-function 1)) (eval . (put 'with-status-verbosity 'scheme-indent-function 1)) + (eval . (put 'with-build-handler 'scheme-indent-function 1)) (eval . (put 'mlambda 'scheme-indent-function 1)) (eval . (put 'mlambdaq 'scheme-indent-function 1)) diff --git a/guix/store.scm b/guix/store.scm index 2c3675dca6..59c1548efc 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; Copyright © 2020 Florian Pelz @@ -104,6 +104,7 @@ add-to-store add-file-tree-to-store binary-file + with-build-handler build-things build query-failed-paths @@ -1222,6 +1223,46 @@ an arbitrary directory layout in the store without creating a derivation." (hash-set! cache tree result) result))))) +(define current-build-prompt + ;; When true, this is the prompt to abort to when 'build-things' is called. + (make-parameter #f)) + +(define (call-with-build-handler handler thunk) + "Register HANDLER as a \"build handler\" and invoke THUNK." + (define tag + (make-prompt-tag "build handler")) + + (parameterize ((current-build-prompt tag)) + (call-with-prompt tag + thunk + (lambda (k . args) + ;; Since HANDLER may call K, which in turn may call 'build-things' + ;; again, reinstate a prompt (thus, it's not a tail call.) + (call-with-build-handler handler + (lambda () + (apply handler k args))))))) + +(define (invoke-build-handler store things mode) + "Abort to 'current-build-prompt' if it is set." + (or (not (current-build-prompt)) + (abort-to-prompt (current-build-prompt) store things mode))) + +(define-syntax-rule (with-build-handler handler exp ...) + "Register HANDLER as a \"build handler\" and invoke THUNK. When +'build-things' is called within the dynamic extent of the call to THUNK, +HANDLER is invoked like so: + + (HANDLER CONTINUE STORE THINGS MODE) + +where CONTINUE is the continuation, and the remaining arguments are those that +were passed to 'build-things'. + +Build handlers are useful to announce a build plan with 'show-what-to-build' +and to implement dry runs (by not invoking CONTINUE) in a way that gracefully +deals with \"dynamic dependencies\" such as grafts---derivations that depend +on the build output of a previous derivation." + (call-with-build-handler handler (lambda () exp ...))) + (define build-things (let ((build (operation (build-things (string-list things) (integer mode)) @@ -1236,20 +1277,24 @@ outputs, and return when the worker is done building them. Elements of THINGS that are not derivations can only be substituted and not built locally. Alternately, an element of THING can be a derivation/output name pair, in which case the daemon will attempt to substitute just the requested output of -the derivation. Return #t on success." - (let ((things (map (match-lambda - ((drv . output) (string-append drv "!" output)) - (thing thing)) - things))) - (parameterize ((current-store-protocol-version - (store-connection-version store))) - (if (>= (store-connection-minor-version store) 15) - (build store things mode) - (if (= mode (build-mode normal)) - (build/old store things) - (raise (condition (&store-protocol-error - (message "unsupported build mode") - (status 1))))))))))) +the derivation. Return #t on success. + +When a handler is installed with 'with-build-handler', it is called any time +'build-things' is called." + (and (invoke-build-handler store things mode) + (let ((things (map (match-lambda + ((drv . output) (string-append drv "!" output)) + (thing thing)) + things))) + (parameterize ((current-store-protocol-version + (store-connection-version store))) + (if (>= (store-connection-minor-version store) 15) + (build store things mode) + (if (= mode (build-mode normal)) + (build/old store things) + (raise (condition (&store-protocol-error + (message "unsupported build mode") + (status 1)))))))))))) (define-operation (add-temp-root (store-path path)) "Make PATH a temporary root for the duration of the current session. diff --git a/tests/store.scm b/tests/store.scm index 2b14a4af0a..b61a981b28 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -380,6 +380,38 @@ (equal? (valid-derivers %store o) (list (derivation-file-name d)))))) +(test-equal "with-build-handler" + 'success + (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) + (s (add-to-store %store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d1 (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:sources (list b s))) + (d2 (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text)) + ("bar" . "baz")) + #:sources (list b s))) + (o1 (derivation->output-path d1)) + (o2 (derivation->output-path d2))) + (with-build-handler + (let ((counter 0)) + (lambda (continue store things mode) + (match things + ((drv) + (set! counter (+ 1 counter)) + (if (string=? drv (derivation-file-name d1)) + (continue #t) + (and (string=? drv (derivation-file-name d2)) + (= counter 2) + 'success)))))) + (build-derivations %store (list d1)) + (build-derivations %store (list d2)) + 'fail))) + (test-assert "topologically-sorted, one item" (let* ((a (add-text-to-store %store "a" "a")) (b (add-text-to-store %store "b" "b" (list a))) From patchwork Thu Mar 19 11:02:47 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20755 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 0CE0727BBEB; Thu, 19 Mar 2020 11:04:18 +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 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 ESMTP id AD0C327BBE4 for ; Thu, 19 Mar 2020 11:04:17 +0000 (GMT) Received: from localhost ([::1]:36144 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyH-0007my-6E for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:17 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34661) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsy6-0007lu-MR for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy4-0001mT-JO for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35868) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy3-0001iL-9z for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy3-0000QF-5C for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 3/8] ui: Add a notification build handler. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157901504 (code B ref 40130); Thu, 19 Mar 2020 11:04:03 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:10 +0000 Received: from localhost ([127.0.0.1]:41827 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxC-0000O6-GZ for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:10 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47502) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsx8-0000Ml-8t for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:06 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45150) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx3-0000AC-4P; Thu, 19 Mar 2020 07:03:01 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx2-0001MW-J5; Thu, 19 Mar 2020 07:03:00 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:47 +0100 Message-Id: <20200319110252.5081-3-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 * guix/ui.scm (build-notifier): New variable. --- guix/ui.scm | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/guix/ui.scm b/guix/ui.scm index 6f1ca9c0b2..47ada9dde2 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -93,6 +93,7 @@ string->number* size->number show-derivation-outputs + build-notifier show-what-to-build show-what-to-build* show-manifest-transaction @@ -1045,6 +1046,43 @@ check and report what is prerequisites are available for download." (define show-what-to-build* (store-lift show-what-to-build)) +(define* (build-notifier #:key (dry-run? #f) (use-substitutes? #t)) + "Return a procedure suitable for 'with-build-handler' that, when +'build-things' is called, invokes 'show-what-to-build' to display the build +plan. When DRY-RUN? is true, the 'with-build-handler' form returns without +any build happening." + (define not-comma + (char-set-complement (char-set #\,))) + + (define (read-derivation-from-file* item) + (catch 'system-error + (lambda () + (read-derivation-from-file item)) + (const #f))) + + (lambda (continuation store things mode) + (define inputs + ;; List of derivation inputs to build. Filter out non-existent '.drv' + ;; files because the daemon transparently tries to substitute them. + (filter-map (match-lambda + (((? derivation-path? drv) . output) + (let ((drv (read-derivation-from-file* drv)) + (outputs (string-tokenize output not-comma))) + (and drv (derivation-input drv outputs)))) + ((? derivation-path? drv) + (and=> (read-derivation-from-file* drv) + derivation-input)) + (_ + #f)) + things)) + + (show-what-to-build store inputs + #:dry-run? dry-run? + #:use-substitutes? use-substitutes? + #:mode mode) + (unless dry-run? + (continuation #t)))) + (define (right-arrow port) "Return either a string containing the 'RIGHT ARROW' character, or an ASCII replacement if PORT is not Unicode-capable." From patchwork Thu Mar 19 11:02:48 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20757 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 EC80F27BBEA; Thu, 19 Mar 2020 11:04:41 +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, URIBL_BLOCKED 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 ESMTP id 712AC27BBE4 for ; Thu, 19 Mar 2020 11:04:41 +0000 (GMT) Received: from localhost ([::1]:36152 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsye-00082l-Uv for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:41 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34636) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsy6-0007ls-1u for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy4-0001mO-JJ for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35869) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy3-0001jo-Ob for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy3-0000QN-Kq for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 4/8] guix build: Use 'with-build-handler'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157911512 (code B ref 40130); Thu, 19 Mar 2020 11:04:03 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:11 +0000 Received: from localhost ([127.0.0.1]:41829 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxC-0000OD-QZ for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:11 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47507) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsx9-0000N6-Ay for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:07 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45151) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx4-0000B7-5z; Thu, 19 Mar 2020 07:03:02 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx3-0001MW-Gj; Thu, 19 Mar 2020 07:03:01 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:48 +0100 Message-Id: <20200319110252.5081-4-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 Fixes . Reported by Andreas Enge . * guix/scripts/build.scm (guix-build): Wrap 'parameterize' in 'with-build-handler'. Remove explicit call to 'show-what-to-build'. Call 'build-derivations' regardless of whether OPTS contains 'dry-run?'. --- guix/scripts/build.scm | 114 ++++++++++++++++++++--------------------- 1 file changed, 55 insertions(+), 59 deletions(-) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index da2a675ce2..af18d8b6f9 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -952,64 +952,60 @@ needed." ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) - (parameterize ((current-terminal-columns (terminal-columns)) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? + (assoc-ref opts 'dry-run?)) + (parameterize ((current-terminal-columns (terminal-columns)) - ;; Set grafting upfront in case the user's input - ;; depends on it (e.g., a manifest or code snippet that - ;; calls 'gexp->derivation'). - (%graft? graft?)) - (let* ((mode (assoc-ref opts 'build-mode)) - (drv (options->derivations store opts)) - (urls (map (cut string-append <> "/log") - (if (assoc-ref opts 'substitutes?) - (or (assoc-ref opts 'substitute-urls) - ;; XXX: This does not necessarily match the - ;; daemon's substitute URLs. - %default-substitute-urls) - '()))) - (items (filter-map (match-lambda - (('argument . (? store-path? file)) - ;; If FILE is a .drv that's not in - ;; store, keep it so that it can be - ;; substituted. - (and (or (not (derivation-path? file)) - (not (file-exists? file))) - file)) - (_ #f)) - opts)) - (roots (filter-map (match-lambda - (('gc-root . root) root) - (_ #f)) - opts))) + ;; Set grafting upfront in case the user's input + ;; depends on it (e.g., a manifest or code snippet that + ;; calls 'gexp->derivation'). + (%graft? graft?)) + (let* ((mode (assoc-ref opts 'build-mode)) + (drv (options->derivations store opts)) + (urls (map (cut string-append <> "/log") + (if (assoc-ref opts 'substitutes?) + (or (assoc-ref opts 'substitute-urls) + ;; XXX: This does not necessarily match the + ;; daemon's substitute URLs. + %default-substitute-urls) + '()))) + (items (filter-map (match-lambda + (('argument . (? store-path? file)) + ;; If FILE is a .drv that's not in + ;; store, keep it so that it can be + ;; substituted. + (and (or (not (derivation-path? file)) + (not (file-exists? file))) + file)) + (_ #f)) + opts)) + (roots (filter-map (match-lambda + (('gc-root . root) root) + (_ #f)) + opts))) - (unless (or (assoc-ref opts 'log-file?) - (assoc-ref opts 'derivations-only?)) - (show-what-to-build store drv - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? (assoc-ref opts 'dry-run?) - #:mode mode)) - - (cond ((assoc-ref opts 'log-file?) - ;; Pass 'show-build-log' the output file names, not the - ;; derivation file names, because there can be several - ;; derivations leading to the same output. - (for-each (cut show-build-log store <> urls) - (delete-duplicates - (append (map derivation->output-path drv) - items)))) - ((assoc-ref opts 'derivations-only?) - (format #t "~{~a~%~}" (map derivation-file-name drv)) - (for-each (cut register-root store <> <>) - (map (compose list derivation-file-name) drv) - roots)) - ((not (assoc-ref opts 'dry-run?)) - (and (build-derivations store (append drv items) - mode) - (for-each show-derivation-outputs drv) - (for-each (cut register-root store <> <>) - (map (lambda (drv) - (map cdr - (derivation->output-paths drv))) - drv) - roots)))))))))) + (cond ((assoc-ref opts 'log-file?) + ;; Pass 'show-build-log' the output file names, not the + ;; derivation file names, because there can be several + ;; derivations leading to the same output. + (for-each (cut show-build-log store <> urls) + (delete-duplicates + (append (map derivation->output-path drv) + items)))) + ((assoc-ref opts 'derivations-only?) + (format #t "~{~a~%~}" (map derivation-file-name drv)) + (for-each (cut register-root store <> <>) + (map (compose list derivation-file-name) drv) + roots)) + (else + (and (build-derivations store (append drv items) + mode) + (for-each show-derivation-outputs drv) + (for-each (cut register-root store <> <>) + (map (lambda (drv) + (map cdr + (derivation->output-paths drv))) + drv) + roots))))))))))) From patchwork Thu Mar 19 11:02:49 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20756 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 4D59F27BBE4; Thu, 19 Mar 2020 11:04:18 +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 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 ESMTP id C761527BBEA for ; Thu, 19 Mar 2020 11:04:17 +0000 (GMT) Received: from localhost ([::1]:36146 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyH-0007nE-9x for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:17 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34676) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsy9-0007mB-K1 for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy4-0001mn-KT for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35870) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy4-0001l3-6Q for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy4-0000QU-2i for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 5/8] deploy: Use 'with-build-handler'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157911518 (code B ref 40130); Thu, 19 Mar 2020 11:04:04 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:11 +0000 Received: from localhost ([127.0.0.1]:41831 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxD-0000OL-8f for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:11 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47515) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxA-0000N8-Ap for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:08 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45152) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx5-0000Bd-6B; Thu, 19 Mar 2020 07:03:03 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx4-0001MW-ID; Thu, 19 Mar 2020 07:03:02 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:49 +0100 Message-Id: <20200319110252.5081-5-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 Until now, 'guix deploy' would never display what is going to be built. * guix/scripts/deploy.scm (guix-deploy): Wrap 'for-each' in 'with-build-handler'. --- guix/scripts/deploy.scm | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index ad05c333dc..a82dde00a4 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -108,19 +108,21 @@ Perform the deployment specified by FILE.\n")) (with-status-verbosity (assoc-ref opts 'verbosity) (with-store store (set-build-options-from-command-line store opts) - (for-each (lambda (machine) - (info (G_ "deploying to ~a...~%") - (machine-display-name machine)) - (parameterize ((%graft? (assq-ref opts 'graft?))) - (guard (c ((message-condition? c) - (report-error (G_ "failed to deploy ~a: ~a~%") - (machine-display-name machine) - (condition-message c))) - ((deploy-error? c) - (when (deploy-error-should-roll-back c) - (info (G_ "rolling back ~a...~%") - (machine-display-name machine)) - (run-with-store store (roll-back-machine machine))) - (apply throw (deploy-error-captured-args c)))) - (run-with-store store (deploy-machine machine))))) - machines))))) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?)) + (for-each (lambda (machine) + (info (G_ "deploying to ~a...~%") + (machine-display-name machine)) + (parameterize ((%graft? (assq-ref opts 'graft?))) + (guard (c ((message-condition? c) + (report-error (G_ "failed to deploy ~a: ~a~%") + (machine-display-name machine) + (condition-message c))) + ((deploy-error? c) + (when (deploy-error-should-roll-back c) + (info (G_ "rolling back ~a...~%") + (machine-display-name machine)) + (run-with-store store (roll-back-machine machine))) + (apply throw (deploy-error-captured-args c)))) + (run-with-store store (deploy-machine machine))))) + machines)))))) From patchwork Thu Mar 19 11:02:50 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20760 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 6E8C727BBE4; Thu, 19 Mar 2020 11:04:50 +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, URIBL_BLOCKED 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 ESMTP id DA25827BBEA for ; Thu, 19 Mar 2020 11:04:49 +0000 (GMT) Received: from localhost ([::1]:36166 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyn-0008Hl-FK for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:49 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34688) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyA-0007mJ-U9 for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy5-0001nB-7w for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35871) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy4-0001mi-L8 for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy4-0000Qc-HK for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 6/8] pack: Use 'with-build-handler'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157981545 (code B ref 40130); Thu, 19 Mar 2020 11:04:04 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:18 +0000 Received: from localhost ([127.0.0.1]:41835 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxJ-0000Op-NW for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:18 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47519) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxB-0000ND-C0 for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:10 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45153) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx6-0000CH-7K; Thu, 19 Mar 2020 07:03:04 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx5-0001MW-IR; Thu, 19 Mar 2020 07:03:03 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:50 +0100 Message-Id: <20200319110252.5081-6-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 * guix/scripts/pack.scm (guix-pack): Wrap 'parameterize' in 'with-build-handler'. Remove explicit call to 'show-what-to-build'. Call 'build-derivations' regardless of whether OPTS contains 'dry-run?'. --- guix/scripts/pack.scm | 196 +++++++++++++++++++++--------------------- 1 file changed, 97 insertions(+), 99 deletions(-) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 652b4c63c4..6829d7265f 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1022,108 +1022,106 @@ Create a bundle of PACKAGE.\n")) ;; 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?)) - (derivation? (assoc-ref opts 'derivation-only?)) - (relocatable? (assoc-ref opts 'relocatable?)) - (proot? (eq? relocatable? 'proot)) - (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 - (cut wrapped-manifest-entry <> #:proot? proot?) - 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 - (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?)) - (entry-point (assoc-ref opts 'entry-point)) - (profile-name (assoc-ref opts 'profile-name)) - (gc-root (assoc-ref opts 'gc-root))) - (define (lookup-package package) - (manifest-lookup manifest (manifest-pattern (name package)))) + (with-build-handler (build-notifier #:dry-run? + (assoc-ref opts 'dry-run?) + #:use-substitutes? + (assoc-ref opts 'substitutes?)) + (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* ((derivation? (assoc-ref opts 'derivation-only?)) + (relocatable? (assoc-ref opts 'relocatable?)) + (proot? (eq? relocatable? 'proot)) + (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 + (cut wrapped-manifest-entry <> #:proot? proot?) + 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 + (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?)) + (entry-point (assoc-ref opts 'entry-point)) + (profile-name (assoc-ref opts 'profile-name)) + (gc-root (assoc-ref opts 'gc-root))) + (define (lookup-package package) + (manifest-lookup manifest (manifest-pattern (name package)))) - (when (null? (manifest-entries manifest)) - (warning (G_ "no packages specified; building an empty pack~%"))) + (when (null? (manifest-entries manifest)) + (warning (G_ "no packages specified; building an empty pack~%"))) - (when (and (eq? pack-format 'squashfs) - (not (any lookup-package '("bash" "bash-minimal")))) - (warning (G_ "Singularity requires you to provide a shell~%")) - (display-hint (G_ "Add @code{bash} or @code{bash-minimal} \ + (when (and (eq? pack-format 'squashfs) + (not (any lookup-package '("bash" "bash-minimal")))) + (warning (G_ "Singularity requires you to provide a shell~%")) + (display-hint (G_ "Add @code{bash} or @code{bash-minimal} \ to your package list."))) - (run-with-store store - (mlet* %store-monad ((profile (profile-derivation - manifest + (run-with-store store + (mlet* %store-monad ((profile (profile-derivation + manifest - ;; Always produce relative - ;; symlinks for Singularity (see - ;; ). - #:relative-symlinks? - (or relocatable? - (eq? 'squashfs pack-format)) + ;; Always produce relative + ;; symlinks for Singularity (see + ;; ). + #:relative-symlinks? + (or relocatable? + (eq? 'squashfs pack-format)) - #:hooks (if bootstrap? - '() - %default-profile-hooks) - #:locales? (not bootstrap?) - #:target target)) - (drv (build-image name profile - #:target - target - #:compressor - compressor - #:symlinks - symlinks - #:localstatedir? - localstatedir? - #:entry-point - entry-point - #:profile-name - profile-name - #:archiver - archiver))) - (mbegin %store-monad - (munless derivation? - (show-what-to-build* (list drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?)) - (mwhen derivation? - (return (format #t "~a~%" - (derivation-file-name drv)))) - (munless (or derivation? dry-run?) - (built-derivations (list drv)) - (mwhen gc-root - (register-root* (match (derivation->output-paths drv) - (((names . items) ...) - items)) - gc-root)) - (return (format #t "~a~%" - (derivation->output-path drv)))))) - #:system (assoc-ref opts 'system)))))))) + #:hooks (if bootstrap? + '() + %default-profile-hooks) + #:locales? (not bootstrap?) + #:target target)) + (drv (build-image name profile + #:target + target + #:compressor + compressor + #:symlinks + symlinks + #:localstatedir? + localstatedir? + #:entry-point + entry-point + #:profile-name + profile-name + #:archiver + archiver))) + (mbegin %store-monad + (mwhen derivation? + (return (format #t "~a~%" + (derivation-file-name drv)))) + (munless derivation? + (built-derivations (list drv)) + (mwhen gc-root + (register-root* (match (derivation->output-paths drv) + (((names . items) ...) + items)) + gc-root)) + (return (format #t "~a~%" + (derivation->output-path drv)))))) + #:system (assoc-ref opts 'system))))))))) From patchwork Thu Mar 19 11:02:51 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20761 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 0A84327BBE4; Thu, 19 Mar 2020 11:04:51 +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 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 ESMTP id 7434527BBEA for ; Thu, 19 Mar 2020 11:04:50 +0000 (GMT) Received: from localhost ([::1]:36168 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyo-0008Ki-08 for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:50 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34691) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyA-0007mM-Un for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy6-0001pO-Ce for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:09 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35873) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy6-0001oQ-2o for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:06 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy4-0000Qj-VR for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 7/8] guix package, pull: Use 'with-build-handler'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846157991553 (code B ref 40130); Thu, 19 Mar 2020 11:04:04 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:19 +0000 Received: from localhost ([127.0.0.1]:41837 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxL-0000Os-6U for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:19 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47531) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxD-0000NS-93 for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:11 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45154) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx8-0000D1-3H; Thu, 19 Mar 2020 07:03:06 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx6-0001MW-Jh; Thu, 19 Mar 2020 07:03:05 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:51 +0100 Message-Id: <20200319110252.5081-7-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 * guix/scripts/package.scm (build-and-use-profile): Remove #:dry-run? and #:use-substitutes?. Remove call to 'show-what-to-build' and 'dry-run?' special case. (process-actions): Adjust accordingly. (guix-package*): Wrap 'parameterize' in 'with-build-handler'. * guix/scripts/pull.scm (build-and-install): Remove #:use-substitutes? and #:dry-run? and adjust 'update-profile' call accordingly. Remove 'dry-run?' conditional. (guix-pull): Wrap body in 'with-build-handler'. --- guix/scripts/package.scm | 29 +++++----- guix/scripts/pull.scm | 118 +++++++++++++++++++-------------------- 2 files changed, 71 insertions(+), 76 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index d2f4f1ccd3..dd7e6bb7e1 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -134,8 +134,7 @@ denote ranges as interpreted by 'matching-generations'." #:key (hooks %default-profile-hooks) allow-collisions? - bootstrap? use-substitutes? - dry-run?) + bootstrap?) "Build a new generation of PROFILE, a file name, using the packages specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true, do not treat collisions in MANIFEST as an error. HOOKS is a list of \"profile @@ -146,12 +145,8 @@ hooks\" run when building the profile." #:hooks (if bootstrap? '() hooks) #:locales? (not bootstrap?)))) (prof (derivation->output-path prof-drv))) - (show-what-to-build store (list prof-drv) - #:use-substitutes? use-substitutes? - #:dry-run? dry-run?) (cond - (dry-run? #t) ((and (file-exists? profile) (and=> (readlink* profile) (cut string=? prof <>))) (format (current-error-port) (G_ "nothing to be done~%"))) @@ -922,9 +917,7 @@ processed, #f otherwise." #:dry-run? dry-run?) (build-and-use-profile store profile new #:allow-collisions? allow-collisions? - #:bootstrap? bootstrap? - #:use-substitutes? substitutes? - #:dry-run? dry-run?))))) + #:bootstrap? bootstrap?))))) ;;; @@ -953,10 +946,14 @@ option processing with 'parse-command-line'." (%graft? (assoc-ref opts 'graft?))) (with-status-verbosity (assoc-ref opts 'verbosity) (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))))))) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? + (assoc-ref opts 'dry-run?)) + (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/pull.scm b/guix/scripts/pull.scm index 51d4da209a..7fc23e1b47 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -389,8 +389,7 @@ previous generation. Return true if there are news to display." (display-channel-news profile)) -(define* (build-and-install instances profile - #:key use-substitutes? dry-run?) +(define* (build-and-install instances profile) "Build the tool from SOURCE, and install it in PROFILE. When DRY-RUN? is true, display what would be built without actually building it." (define update-profile @@ -403,29 +402,27 @@ true, display what would be built without actually building it." (mlet %store-monad ((manifest (channel-instances->manifest instances))) (mbegin %store-monad (update-profile profile manifest - #:use-substitutes? use-substitutes? - #:hooks %channel-profile-hooks - #:dry-run? dry-run?) - (munless dry-run? - (return (newline)) - (return - (let ((more? (list (display-profile-news profile #:concise? #t) - (display-channel-news-headlines profile)))) - (when (any ->bool more?) - (display-hint - (G_ "Run @command{guix pull --news} to read all the news."))))) - (if guix-command - (let ((new (map (cut string-append <> "/bin/guix") - (list (user-friendly-profile profile) - profile)))) - ;; Is the 'guix' command previously in $PATH the same as the new - ;; one? If the answer is "no", then suggest 'hash guix'. - (unless (member guix-command new) - (display-hint (format #f (G_ "After setting @code{PATH}, run + #:hooks %channel-profile-hooks) + + (return + (let ((more? (list (display-profile-news profile #:concise? #t) + (display-channel-news-headlines profile)))) + (newline) + (when (any ->bool more?) + (display-hint + (G_ "Run @command{guix pull --news} to read all the news."))))) + (if guix-command + (let ((new (map (cut string-append <> "/bin/guix") + (list (user-friendly-profile profile) + profile)))) + ;; Is the 'guix' command previously in $PATH the same as the new + ;; one? If the answer is "no", then suggest 'hash guix'. + (unless (member guix-command new) + (display-hint (format #f (G_ "After setting @code{PATH}, run @command{hash guix} to make sure your shell refers to @file{~a}.") - (first new)))) - (return #f)) - (return #f)))))) + (first new)))) + (return #f)) + (return #f))))) (define (honor-lets-encrypt-certificates! store) "Tell Guile-Git to use the Let's Encrypt certificates." @@ -760,10 +757,12 @@ Use '~/.config/guix/channels.scm' instead.")) (define (guix-pull . args) (with-error-handling (with-git-error-handling - (let* ((opts (parse-command-line args %options - (list %default-options))) - (channels (channel-list opts)) - (profile (or (assoc-ref opts 'profile) %current-profile))) + (let* ((opts (parse-command-line args %options + (list %default-options))) + (substitutes? (assoc-ref opts 'substitutes?)) + (dry-run? (assoc-ref opts 'dry-run?)) + (channels (channel-list opts)) + (profile (or (assoc-ref opts 'profile) %current-profile))) (cond ((assoc-ref opts 'query) (process-query opts profile)) ((assoc-ref opts 'generation) @@ -773,38 +772,37 @@ Use '~/.config/guix/channels.scm' instead.")) (with-status-verbosity (assoc-ref opts 'verbosity) (parameterize ((%current-system (assoc-ref opts 'system)) (%graft? (assoc-ref opts 'graft?))) - (set-build-options-from-command-line store opts) - (ensure-default-profile) - (honor-x509-certificates store) + (with-build-handler (build-notifier #:use-substitutes? + substitutes? + #:dry-run? dry-run?) + (set-build-options-from-command-line store opts) + (ensure-default-profile) + (honor-x509-certificates store) - (let ((instances (latest-channel-instances store channels))) - (format (current-error-port) - (N_ "Building from this channel:~%" - "Building from these channels:~%" - (length instances))) - (for-each (lambda (instance) - (let ((channel - (channel-instance-channel instance))) - (format (current-error-port) - " ~10a~a\t~a~%" - (channel-name channel) - (channel-url channel) - (string-take - (channel-instance-commit instance) - 7)))) - instances) - (parameterize ((%guile-for-build - (package-derivation - store - (if (assoc-ref opts 'bootstrap?) - %bootstrap-guile - (canonical-package guile-2.2))))) - (with-profile-lock profile - (run-with-store store - (build-and-install instances profile - #:dry-run? - (assoc-ref opts 'dry-run?) - #:use-substitutes? - (assoc-ref opts 'substitutes?))))))))))))))) + (let ((instances (latest-channel-instances store channels))) + (format (current-error-port) + (N_ "Building from this channel:~%" + "Building from these channels:~%" + (length instances))) + (for-each (lambda (instance) + (let ((channel + (channel-instance-channel instance))) + (format (current-error-port) + " ~10a~a\t~a~%" + (channel-name channel) + (channel-url channel) + (string-take + (channel-instance-commit instance) + 7)))) + instances) + (parameterize ((%guile-for-build + (package-derivation + store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2))))) + (with-profile-lock profile + (run-with-store store + (build-and-install instances profile))))))))))))))) ;;; pull.scm ends here From patchwork Thu Mar 19 11:02:52 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 20758 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 38E0527BBEB; Thu, 19 Mar 2020 11:04:44 +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, URIBL_BLOCKED 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 ESMTP id 860D527BBE4 for ; Thu, 19 Mar 2020 11:04:43 +0000 (GMT) Received: from localhost ([::1]:36158 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyh-000844-2f for patchwork@mira.cbaines.net; Thu, 19 Mar 2020 07:04:43 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34689) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jEsyA-0007mK-Uq for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jEsy5-0001nM-Jm for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:09 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35872) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jEsy5-0001nG-GH for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jEsy5-0000Qp-CZ for guix-patches@gnu.org; Thu, 19 Mar 2020 07:04:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40130] [PATCH 8/8] guix system: Use 'with-build-handler'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 19 Mar 2020 11:04:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40130 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 40130@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 40130-submit@debbugs.gnu.org id=B40130.15846158001560 (code B ref 40130); Thu, 19 Mar 2020 11:04:05 +0000 Received: (at 40130) by debbugs.gnu.org; 19 Mar 2020 11:03:20 +0000 Received: from localhost ([127.0.0.1]:41839 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxL-0000P0-MC for submit@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:20 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47539) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jEsxE-0000Nf-4U for 40130@debbugs.gnu.org; Thu, 19 Mar 2020 07:03:12 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45156) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1jEsx8-0000DW-WF; Thu, 19 Mar 2020 07:03:07 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50612 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jEsx8-0001MW-Cr; Thu, 19 Mar 2020 07:03:06 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 19 Mar 2020 12:02:52 +0100 Message-Id: <20200319110252.5081-8-ludo@gnu.org> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20200319110252.5081-1-ludo@gnu.org> References: <20200319110252.5081-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 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 * guix/scripts/system.scm (reinstall-bootloader): Remove call to 'show-what-to-build*'. (perform-action): Call 'build-derivations' instead of 'maybe-build'. (process-action): Wrap 'run-with-store' in 'with-build-handler'. --- guix/scripts/system.scm | 80 +++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 39 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ac2475c551..8d1938281a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2016, 2017, 2018 Chris Marusich ;;; Copyright © 2017, 2019 Mathieu Othacehe @@ -403,7 +403,6 @@ STORE is an open connection to the store." #:old-entries old-entries))) (drvs -> (list bootcfg))) (mbegin %store-monad - (show-what-to-build* drvs) (built-derivations drvs) ;; Only install bootloader configuration file. (install-bootloader local-eval bootloader-config bootcfg @@ -837,8 +836,7 @@ static checks." (% (if derivations-only? (return (for-each (compose println derivation-file-name) drvs)) - (maybe-build drvs #:dry-run? dry-run? - #:use-substitutes? use-substitutes?)))) + (built-derivations drvs)))) (if (or dry-run? derivations-only?) (return #f) @@ -1139,42 +1137,46 @@ resulting from command-line parsing." (with-store store (set-build-options-from-command-line store opts) - (run-with-store store - (mbegin %store-monad - (set-guile-for-build (default-guile)) - (case action - ((extension-graph) - (export-extension-graph os (current-output-port))) - ((shepherd-graph) - (export-shepherd-graph os (current-output-port))) - (else - (unless (memq action '(build init)) - (warn-about-old-distro #:suggested-command - "guix system reconfigure")) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? + (assoc-ref opts 'dry-run?)) + (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (case action + ((extension-graph) + (export-extension-graph os (current-output-port))) + ((shepherd-graph) + (export-shepherd-graph os (current-output-port))) + (else + (unless (memq action '(build init)) + (warn-about-old-distro #:suggested-command + "guix system reconfigure")) - (perform-action action os - #:dry-run? dry? - #:derivations-only? (assoc-ref opts - 'derivations-only?) - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:skip-safety-checks? - (assoc-ref opts 'skip-safety-checks?) - #:file-system-type (assoc-ref opts 'file-system-type) - #:image-size (assoc-ref opts 'image-size) - #:full-boot? (assoc-ref opts 'full-boot?) - #:container-shared-network? - (assoc-ref opts 'container-shared-network?) - #:mappings (filter-map (match-lambda - (('file-system-mapping . m) - m) - (_ #f)) - opts) - #:install-bootloader? bootloader? - #:target target-file - #:bootloader-target bootloader-target - #:gc-root (assoc-ref opts 'gc-root))))) - #:target target - #:system system)) + (perform-action action os + #:dry-run? dry? + #:derivations-only? (assoc-ref opts + 'derivations-only?) + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:skip-safety-checks? + (assoc-ref opts 'skip-safety-checks?) + #:file-system-type (assoc-ref opts 'file-system-type) + #:image-size (assoc-ref opts 'image-size) + #:full-boot? (assoc-ref opts 'full-boot?) + #:container-shared-network? + (assoc-ref opts 'container-shared-network?) + #:mappings (filter-map (match-lambda + (('file-system-mapping . m) + m) + (_ #f)) + opts) + #:install-bootloader? bootloader? + #:target target-file + #:bootloader-target bootloader-target + #:gc-root (assoc-ref opts 'gc-root))))) + #:target target + #:system system))) (warn-about-disk-space))) (define (resolve-subcommand name)