From patchwork Sat Oct 28 14:08:34 2023 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: 55461 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 D8A6E27BBEA; Sat, 28 Oct 2023 15:09:38 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 720DD27BBE2 for ; Sat, 28 Oct 2023 15:09:37 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qwk0K-0000kQ-Sa; Sat, 28 Oct 2023 10:09:32 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qwk0I-0000jv-9F for guix-patches@gnu.org; Sat, 28 Oct 2023 10:09:31 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qwk0I-0000LA-0g; Sat, 28 Oct 2023 10:09:30 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qwk0n-0001gD-V8; Sat, 28 Oct 2023 10:10:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#66793] [PATCH 2/3] time-machine: Make target commit check cheaper. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sat, 28 Oct 2023 14:10:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66793 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 66793@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Simon Tournier , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 66793-submit@debbugs.gnu.org id=B66793.16985021796406 (code B ref 66793); Sat, 28 Oct 2023 14:10:01 +0000 Received: (at 66793) by debbugs.gnu.org; 28 Oct 2023 14:09:39 +0000 Received: from localhost ([127.0.0.1]:39301 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qwk0Q-0001fB-HO for submit@debbugs.gnu.org; Sat, 28 Oct 2023 10:09:39 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:48098) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qwk0P-0001el-7d for 66793@debbugs.gnu.org; Sat, 28 Oct 2023 10:09:37 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qwjzn-0000Jm-UL; Sat, 28 Oct 2023 10:08:59 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=6Ql20mviB9vqAveWLKILA3qy0/UOnKBo/2Bzi5xaI7Q=; b=GZFK3AS/yN3/fs61fjAl EnzKoNQN/qUa/IzhMqb3B9y8NLtDiQDIyJoERGqqv6zJoQ+2QRAPrqkJm0rEVcwmpl773T/sxwmQ+ ftvpkbd1hJuYItnTaXTDfjEQUDrKJQAmN/rtn3IBkakAuUfF556p2BNYKcz94R4DAy7KaC3zoCpCE BiMQ7Vhd+PnJeKtzoTLbdKYrpUhSdRnh9ruFDMY1zrIaMOKFaRHiHmkFaZwqjqHlxng2MDiJaonPZ aURTuRVqPDh0qqg0yXkoUJM1OIvDQHopG5+PpDNnxWuFCkUDdKevZA4tqVNZ7cm7mN1BMh/hGGWr2 J5d4fn0gN2r22Q==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sat, 28 Oct 2023 16:08:34 +0200 Message-ID: <648020c38a11915d2d147c4b05da682b011b593e.1698501649.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Commit 79ec651a286c71a3d4c72be33a1f80e76a560031 introduced a check to error out when attempting to use ‘time-machine’ to travel to a commit before ‘v1.0.0’. This commit fixes a performance issue with the strategy used in 79ec651a286c71a3d4c72be33a1f80e76a560031 (the repository was opened, updated, and traversed a second time by ‘validate-guix-channel’) as well as a user interface issue (“Updating channel” messages would be printed too late). This patch reimplements the check in terms of the existing #:validate-pull mechanism, which is designed to avoid extra repository operations. Fixes . * guix/inferior.scm (cached-channel-instance): Change default value of #:validate-channels. Remove call to VALIDATE-CHANNELS; pass it as #:validate-pull to ‘latest-channel-instances’. * guix/scripts/time-machine.scm (%reference-channels): New variable. (validate-guix-channel): New procedure. (guix-time-machine)[validate-guix-channel]: Remove. Pass #:reference-channels to ‘cached-channel-instance’. Reported-by: Simon Tournier Change-Id: I9b0ec61fba7354fe08b04a91f4bd32b72a35460c --- guix/inferior.scm | 58 +++++++++++++++++++---------------- guix/scripts/time-machine.scm | 58 ++++++++++++++++------------------- 2 files changed, 58 insertions(+), 58 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index fca6fb4b22..190ba01b3c 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -872,14 +872,17 @@ (define* (cached-channel-instance store (authenticate? #t) (cache-directory (%inferior-cache-directory)) (ttl (* 3600 24 30)) - validate-channels) + (reference-channels '()) + (validate-channels (const #t))) "Return a directory containing a guix filetree defined by CHANNELS, a list of channels. The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This procedure opens a new connection to the build daemon. AUTHENTICATE? determines whether CHANNELS are authenticated. -VALIDATE-CHANNELS, if specified, must be a one argument procedure accepting a -list of channels that can be used to validate the channels; it should raise an -exception in case of problems." + +VALIDATE-CHANNELS must be a four-argument procedure used to validate channel +instances against REFERENCE-CHANNELS; it is passed as #:validate-pull to +'latest-channel-instances' and should raise an exception in case a target +channel commit is deemed \"invalid\"." (define commits ;; Since computing the instances of CHANNELS is I/O-intensive, use a ;; cheaper way to get the commit list of CHANNELS. This limits overhead @@ -927,30 +930,31 @@ (define* (cached-channel-instance store (if (file-exists? cached) cached - (begin - (when (procedure? validate-channels) - (validate-channels channels)) - (run-with-store store - (mlet* %store-monad ((instances - -> (latest-channel-instances store channels - #:authenticate? - authenticate?)) - (profile - (channel-instances->derivation instances))) - (mbegin %store-monad - ;; It's up to the caller to install a build handler to report - ;; what's going to be built. - (built-derivations (list profile)) + (run-with-store store + (mlet* %store-monad ((instances + -> (latest-channel-instances store channels + #:authenticate? + authenticate? + #:current-channels + reference-channels + #:validate-pull + validate-channels)) + (profile + (channel-instances->derivation instances))) + (mbegin %store-monad + ;; It's up to the caller to install a build handler to report + ;; what's going to be built. + (built-derivations (list profile)) - ;; Cache if and only if AUTHENTICATE? is true. - (if authenticate? - (mbegin %store-monad - (symlink* (derivation->output-path profile) cached) - (add-indirect-root* cached) - (return cached)) - (mbegin %store-monad - (add-temp-root* (derivation->output-path profile)) - (return (derivation->output-path profile)))))))))) + ;; Cache if and only if AUTHENTICATE? is true. + (if authenticate? + (mbegin %store-monad + (symlink* (derivation->output-path profile) cached) + (add-indirect-root* cached) + (return cached)) + (mbegin %store-monad + (add-temp-root* (derivation->output-path profile)) + (return (derivation->output-path profile))))))))) (define* (inferior-for-channels channels #:key diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index f31fae7435..bd64364fa2 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -46,12 +46,6 @@ (define-module (guix scripts time-machine) #:use-module (srfi srfi-71) #:export (guix-time-machine)) -;;; The required inferiors mechanism relied on by 'guix time-machine' was -;;; firmed up in v1.0.0; it is the oldest, safest commit that can be travelled -;;; to. -(define %oldest-possible-commit - "6298c3ffd9654d3231a6f25390b056483e8f407c") ;v1.0.0 - ;;; ;;; Command-line options. @@ -144,6 +138,31 @@ (define (parse-args args) (("--") opts) (("--" command ...) (alist-cons 'exec command opts)))))) + +;;; +;;; Avoiding traveling too far back. +;;; + +;;; The required inferiors mechanism relied on by 'guix time-machine' was +;;; firmed up in v1.0.0; it is the oldest, safest commit that can be travelled +;;; to. +(define %oldest-possible-commit + "6298c3ffd9654d3231a6f25390b056483e8f407c") ;v1.0.0 + +(define %reference-channels + (list (channel (inherit %default-guix-channel) + (commit %oldest-possible-commit)))) + +(define (validate-guix-channel channel start commit relation) + "Raise an error if CHANNEL is the 'guix' channel and the RELATION of COMMIT +to %OLDEST-POSSIBLE-COMMIT is not that of an ancestor." + (unless (or (not (guix-channel? channel)) + (memq relation '(ancestor self))) + (raise (formatted-message + (G_ "cannot travel past commit `~a' from May 1st, 2019") + (string-take %oldest-possible-commit 12))))) + + ;;; ;;; Entry point. @@ -160,31 +179,6 @@ (define-command (guix-time-machine . args) (ref (assoc-ref opts 'ref)) (substitutes? (assoc-ref opts 'substitutes?)) (authenticate? (assoc-ref opts 'authenticate-channels?))) - - (define (validate-guix-channel channels) - "Finds the Guix channel among CHANNELS, and validates that REF as -captured from the closure, a git reference specification such as a commit hash -or tag associated to the channel, is valid and new enough to satisfy the 'guix -time-machine' requirements. If the captured REF variable is #f, the reference -validate is the one of the Guix channel found in CHANNELS. A -`formatted-message' condition is raised otherwise." - (let* ((guix-channel (find guix-channel? channels)) - (guix-channel-commit (channel-commit guix-channel)) - (guix-channel-branch (channel-branch guix-channel)) - (guix-channel-ref (if guix-channel-commit - `(tag-or-commit . ,guix-channel-commit) - `(branch . ,guix-channel-branch))) - (reference (or ref guix-channel-ref)) - (checkout commit relation (update-cached-checkout - (channel-url guix-channel) - #:ref reference - #:starting-commit - %oldest-possible-commit))) - (unless (memq relation '(ancestor self)) - (raise (formatted-message - (G_ "cannot travel past commit `~a' from May 1st, 2019") - (string-take %oldest-possible-commit 12)))))) - (when command-line (let* ((directory (with-store store @@ -197,6 +191,8 @@ (define-command (guix-time-machine . args) (set-build-options-from-command-line store opts) (cached-channel-instance store channels #:authenticate? authenticate? + #:reference-channels + %reference-channels #:validate-channels validate-guix-channel))))) (executable (string-append directory "/bin/guix")))