mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
scripts: time-machine: Error when attempting to visit too old commits.
* 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) <validate-guix-channel>: 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 <zimon.toutoune@gmail.com> Reviewed-by: Ludovic Courtès <ludo@gnu.org> Reviewed-by: Simon Tournier <zimon.toutoune@gmail.com>
This commit is contained in:
Maxim Cournoyer
parent
ecab937897
commit
79ec651a28
5 changed files with 112 additions and 27 deletions
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -871,11 +871,15 @@ (define* (cached-channel-instance store
|
|||
#: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,6 +927,9 @@ (define add-temp-root*
|
|||
|
||||
(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
|
||||
|
|
@ -943,7 +950,7 @@ (define add-temp-root*
|
|||
(return cached))
|
||||
(mbegin %store-monad
|
||||
(add-temp-root* (derivation->output-path profile))
|
||||
(return (derivation->output-path profile)))))))))
|
||||
(return (derivation->output-path profile))))))))))
|
||||
|
||||
(define* (inferior-for-channels channels
|
||||
#:key
|
||||
|
|
|
|||
|
|
@ -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 @@ (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))))))))
|
||||
|
|
|
|||
28
tests/guix-time-machine.sh
Normal file
28
tests/guix-time-machine.sh
Normal file
|
|
@ -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
|
||||
Loading…
Reference in a new issue