diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 17 | ||||
| -rw-r--r-- | guix/inferior.scm | 57 | ||||
| -rw-r--r-- | guix/scripts/time-machine.scm | 38 | ||||
| -rw-r--r-- | tests/guix-time-machine.sh | 28 |
5 files changed, 113 insertions, 28 deletions
diff --git a/Makefile.am b/Makefile.am index 5ffcb6a12d..4228c07803 100644 --- a/Makefile.am +++ b/Makefile.am @@ -615,6 +615,7 @@ SH_TESTS = \ tests/guix-refresh.sh \ tests/guix-shell.sh \ tests/guix-shell-export-manifest.sh \ + tests/guix-time-machine.sh \ tests/guix-graph.sh \ tests/guix-describe.sh \ tests/guix-repl.sh \ diff --git a/doc/guix.texi b/doc/guix.texi index 633d62bd98..e09083c1f8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5070,6 +5070,23 @@ opens the door to security vulnerabilities. @xref{Invoking guix pull, @option{--allow-downgrades}}. @end quotation +Due to @command{guix time-machine} relying on the ``inferiors'' +mechanism (@pxref{Inferiors}), the oldest commit it can travel to is +commit @samp{6298c3ff} (``v1.0.0''), dated May 1@sup{st}, 2019, which is +the first release that included the inferiors mechanism. An error is +returned when attempting to navigate to older commits. + +@quotation Note +Although it should technically be possible to travel to such an old +commit, the ease to do so will largely depend on the availability of +binary substitutes. When traveling to a distant past, some packages may +not easily build from source anymore. One such example are old versions +of Python 2 which had time bombs in its test suite, in the form of +expiring SSL certificates. This particular problem can be worked around +by setting the hardware clock to a value in the past before attempting +the build. +@end quotation + The general syntax is: @example diff --git a/guix/inferior.scm b/guix/inferior.scm index 5dfd30a6c8..fca6fb4b22 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -871,11 +871,15 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." #:key (authenticate? #t) (cache-directory (%inferior-cache-directory)) - (ttl (* 3600 24 30))) + (ttl (* 3600 24 30)) + validate-channels) "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." +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." (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 @@ -923,27 +927,30 @@ determines whether CHANNELS are authenticated." (if (file-exists? cached) cached - (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)) - - ;; 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))))))))) + (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)) + + ;; 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 d7c71ef705..e4fe511382 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net> ;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,13 +20,15 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (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 @@ #: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 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (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 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (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 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) #: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)))))))) diff --git a/tests/guix-time-machine.sh b/tests/guix-time-machine.sh new file mode 100644 index 0000000000..8b62ef75ea --- /dev/null +++ b/tests/guix-time-machine.sh @@ -0,0 +1,28 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> +# +# 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 <http://www.gnu.org/licenses/>. + +# +# Test the 'guix time-machine' command-line utility. +# + +guix time-machine --version + +# Visiting a commit older than v1.0.0 fails. +! guix time-machine --commit=v0.15.0 + +exit 0 |