diff options
author | Ludovic Courtès <ludo@gnu.org> | 2023-10-28 15:29:01 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2023-11-05 23:23:23 +0100 |
commit | ab13e2be6939340a9dd8ba815e3518be41b19747 (patch) | |
tree | e216f6f38a9dfd48a388d952813854e0d9a1c34f /guix/scripts/time-machine.scm | |
parent | 9f05fbb67d0de4d577c21a6fb6888cb6be67cd12 (diff) | |
download | guix-patches-ab13e2be6939340a9dd8ba815e3518be41b19747.tar guix-patches-ab13e2be6939340a9dd8ba815e3518be41b19747.tar.gz |
time-machine: Make target commit check cheaper.
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 <https://issues.guix.gnu.org/65788>.
* 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, written as a simplification of…
(guix-time-machine)[validate-guix-channel]: … this. Remove.
Pass #:reference-channels to ‘cached-channel-instance’.
Reported-by: Simon Tournier <zimon.toutoune@gmail.com>
Change-Id: I9b0ec61fba7354fe08b04a91f4bd32b72a35460c
Diffstat (limited to 'guix/scripts/time-machine.scm')
-rw-r--r-- | guix/scripts/time-machine.scm | 58 |
1 files changed, 27 insertions, 31 deletions
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 @@ #: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. @@ -146,6 +140,31 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) ;;; +;;; 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 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (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 @@ validate is the one of the Guix channel found in CHANNELS. A (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"))) |