diff options
author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-07-19 11:31:50 -0400 |
---|---|---|
committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-08-16 21:34:13 -0400 |
commit | 79ec651a286c71a3d4c72be33a1f80e76a560031 (patch) | |
tree | 9b45d72bc1bd2ef8434675c72db8840c04d79552 /guix/inferior.scm | |
parent | ecab937897385fce3e3ce0c5f128afba4304187c (diff) | |
download | guix-79ec651a286c71a3d4c72be33a1f80e76a560031.tar guix-79ec651a286c71a3d4c72be33a1f80e76a560031.tar.gz |
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>
Diffstat (limited to 'guix/inferior.scm')
-rw-r--r-- | guix/inferior.scm | 57 |
1 files changed, 32 insertions, 25 deletions
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 |