From 79ec651a286c71a3d4c72be33a1f80e76a560031 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 19 Jul 2023 11:31:50 -0400 Subject: scripts: time-machine: Error when attempting to visit too old commits. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Invoking guix time-machine): Document limitation. * guix/inferior.scm (cached-channel-instance): New VALIDATE-CHANNELS argument. Use it to validate channels when there are no cache hit. * guix/scripts/time-machine.scm (%options): Tag the given reference with 'tag-or-commit instead of 'commit. (%oldest-possible-commit): New variable. (guix-time-machine) : New nested procedure. Pass it to the 'cached-channel-instance' call. * tests/guix-time-machine.sh: New test. * Makefile.am (SH_TESTS): Register it. Suggested-by: Simon Tournier Reviewed-by: Ludovic Courtès Reviewed-by: Simon Tournier --- guix/scripts/time-machine.scm | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) (limited to 'guix/scripts/time-machine.scm') diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index d7c71ef705..e4fe511382 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2019 Konrad Hinsen ;;; Copyright © 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2023 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,13 +20,15 @@ ;;; along with GNU Guix. If not, see . (define-module (guix scripts time-machine) + #:use-module (guix channels) + #:use-module (guix diagnostics) #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix inferior) #:use-module (guix store) #:use-module (guix status) #:use-module ((guix git) - #:select (with-git-error-handling)) + #:select (update-cached-checkout with-git-error-handling)) #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix scripts pull) @@ -38,9 +41,17 @@ (define-module (guix scripts time-machine) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) + #: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. @@ -81,7 +92,7 @@ (define %options (alist-delete 'repository-url result)))) (option '("commit") #t #f (lambda (opt name arg result) - (alist-cons 'ref `(commit . ,arg) result))) + (alist-cons 'ref `(tag-or-commit . ,arg) result))) (option '("branch") #t #f (lambda (opt name arg result) (alist-cons 'ref `(branch . ,arg) result))) @@ -140,8 +151,27 @@ (define-command (guix-time-machine . args) (let* ((opts (parse-args args)) (channels (channel-list opts)) (command-line (assoc-ref opts 'exec)) + (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 CHANNEL, is valid and new enough to satisfy the 'guix +time-machine' requirements. A `formatted-message' condition is raised +otherwise." + (let* ((guix-channel (find guix-channel? channels)) + (checkout commit relation (update-cached-checkout + (channel-url guix-channel) + #:ref (or ref '()) + #: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 @@ -153,6 +183,8 @@ (define-command (guix-time-machine . args) #:dry-run? #f) (set-build-options-from-command-line store opts) (cached-channel-instance store channels - #:authenticate? authenticate?))))) + #:authenticate? authenticate? + #:validate-channels + validate-guix-channel))))) (executable (string-append directory "/bin/guix"))) (apply execl (cons* executable executable command-line)))))))) -- cgit v1.2.3