TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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 2023-07-19 11:31:50 -04:00
parent ecab937897
commit 79ec651a28
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
5 changed files with 112 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -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 \

17
doc/guix.texi
View File

@ -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

55
guix/inferior.scm
View File

@ -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))
(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)))))))))
;; 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

38
guix/scripts/time-machine.scm
View File

@ -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))))))))

28
tests/guix-time-machine.sh Normal file
View 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