[bug#66793] [PATCH 0/3] Make time-machine commit check cheaper; make test effective

[bug#66793] [PATCH 0/3] Make time-machine commit check cheaper; make test effective

[Ludovic Courtès]

Hello Guix!

These changes were prompted by <https://issues.guix.gnu.org/65788>.

Feedback welcome!

Ludo'.

Ludovic Courtès (3):
  tests: Make ‘guix time-machine’ test effective.
  time-machine: Make target commit check cheaper.
  time-machine: Warn when no command is given.

 guix/inferior.scm             | 58 +++++++++++-----------
 guix/scripts/time-machine.scm | 91 +++++++++++++++++------------------
 tests/guix-time-machine.sh    | 24 +++++++--
 3 files changed, 95 insertions(+), 78 deletions(-)


base-commit: ff1146fb4f7254a8f644f89d7af6b4b566528603
-- 
2.41.0

[bug#66793] [PATCH 1/3] tests: Make ‘guix time-machine’ test effective.

[Ludovic Courtès]

The test as added in 79ec651a286c71a3d4c72be33a1f80e76a560031 had no
effect: first because ‘guix time-machine --commit=X’, not followed by a
command, does nothing, and second because the “! COMMAND” shell stanza
does not have the desired effect (see <https://issues.guix.gnu.org/62406>).

This change rewrites the test to make it effective.

* tests/guix-time-machine.sh: Rewrite.

Change-Id: Ib44a11331c8625e346139a236cffa699cdbd02f2
---
 tests/guix-time-machine.sh | 24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

diff --git a/tests/guix-time-machine.sh b/tests/guix-time-machine.sh
index 8b62ef75ea..a78c1533fb 100644
--- a/tests/guix-time-machine.sh
+++ b/tests/guix-time-machine.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -20,9 +21,24 @@
 # Test the 'guix time-machine' command-line utility.
 #
 
-guix time-machine --version
+if [ -d "$abs_top_srcdir/.git" ] \
+   || guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+then
+    guix time-machine --version
+else
+    echo "This test requires networking or a local Git checkout; skipping." >&2
+    exit 77
+fi
 
-# Visiting a commit older than v1.0.0 fails.
-! guix time-machine --commit=v0.15.0
+if [ -d "$abs_top_srcdir/.git" ]
+then
+    EXTRA_OPTIONS="--url=$abs_top_srcdir"
+else
+    EXTRA_OPTIONS=""
+fi
 
-exit 0
+# Visiting a commit older than v1.0.0 must fail (this test is expensive
+# because it clones the whole repository).
+guix time-machine -q --commit=v0.15.0 $EXTRA_OPTIONS -- describe && false
+
+true
-- 
2.41.0

[bug#66793] [PATCH 1/3] tests: Make ‘guix time-machine’ test effective.

[Maxim Cournoyer]

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> The test as added in 79ec651a286c71a3d4c72be33a1f80e76a560031 had no
> effect: first because ‘guix time-machine --commit=X’, not followed by a
> command, does nothing, and second because the “! COMMAND” shell stanza
> does not have the desired effect (see <https://issues.guix.gnu.org/62406>).

Interesting.  I had tested it, but I guess not with that script :-).

[...]

> -guix time-machine --version
> +if [ -d "$abs_top_srcdir/.git" ] \
> +   || guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
> +then
> +    guix time-machine --version
> +else
> +    echo "This test requires networking or a local Git checkout; skipping." >&2
> +    exit 77
> +fi
>  
> -# Visiting a commit older than v1.0.0 fails.
> -! guix time-machine --commit=v0.15.0
> +if [ -d "$abs_top_srcdir/.git" ]
> +then
> +    EXTRA_OPTIONS="--url=$abs_top_srcdir"

Should the --url valE here be prefixed with "file://", just to make it
extra clear we are cloning from a local file?

> +else
> +    EXTRA_OPTIONS=""
> +fi
>  
> -exit 0
> +# Visiting a commit older than v1.0.0 must fail (this test is expensive
> +# because it clones the whole repository).
> +guix time-machine -q --commit=v0.15.0 $EXTRA_OPTIONS -- describe && false
> +
> +true

Otherwise LGTM.

-- 
Thanks,
Maxim

[bug#66793] [PATCH 1/3] tests: Make ‘guix time-machine’ test effective.

[Ludovic Courtès]

Hi,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

>> +if [ -d "$abs_top_srcdir/.git" ] \
>> +   || guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
>> +then
>> +    guix time-machine --version
>> +else
>> +    echo "This test requires networking or a local Git checkout; skipping." >&2
>> +    exit 77
>> +fi
>>  
>> -# Visiting a commit older than v1.0.0 fails.
>> -! guix time-machine --commit=v0.15.0
>> +if [ -d "$abs_top_srcdir/.git" ]
>> +then
>> +    EXTRA_OPTIONS="--url=$abs_top_srcdir"
>
> Should the --url valE here be prefixed with "file://", just to make it
> extra clear we are cloning from a local file?

To my surprise, the test (which does little more than cloning the repo)
runs in 5s without file:// and in 30mn otherwise!  So I left the file://
prefix out and added a comment.

Ludo’.

[bug#66793] [PATCH 2/3] time-machine: Make target commit check cheaper.

[Ludovic Courtès]

Commit 79ec651a286c71a3d4c72be33a1f80e76a560031 introduced a check to
error out when attempting to use ‘time-machine’ to travel to a commit
before ‘v1.0.0’.

This commit fixes a performance issue with the strategy used in
79ec651a286c71a3d4c72be33a1f80e76a560031 (the repository was opened,
updated, and traversed a second time by ‘validate-guix-channel’) as well
as a user interface issue (“Updating channel” messages would be printed
too late).

This patch reimplements the check in terms of the existing #:validate-pull
mechanism, which is designed to avoid extra repository operations.

Fixes <https://issues.guix.gnu.org/65788>.

* guix/inferior.scm (cached-channel-instance): Change default value
of #:validate-channels.  Remove call to VALIDATE-CHANNELS; pass it
as #:validate-pull to ‘latest-channel-instances’.
* guix/scripts/time-machine.scm (%reference-channels): New variable.
(validate-guix-channel): New procedure.
(guix-time-machine)[validate-guix-channel]: Remove.
Pass #:reference-channels to ‘cached-channel-instance’.

Reported-by: Simon Tournier <zimon.toutoune@gmail.com>
Change-Id: I9b0ec61fba7354fe08b04a91f4bd32b72a35460c
---
 guix/inferior.scm             | 58 +++++++++++++++++++----------------
 guix/scripts/time-machine.scm | 58 ++++++++++++++++-------------------
 2 files changed, 58 insertions(+), 58 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index fca6fb4b22..190ba01b3c 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -872,14 +872,17 @@ (define* (cached-channel-instance store
                                   (authenticate? #t)
                                   (cache-directory (%inferior-cache-directory))
                                   (ttl (* 3600 24 30))
-                                  validate-channels)
+                                  (reference-channels '())
+                                  (validate-channels (const #t)))
   "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.
-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."
+
+VALIDATE-CHANNELS must be a four-argument procedure used to validate channel
+instances against REFERENCE-CHANNELS; it is passed as #:validate-pull to
+'latest-channel-instances' and should raise an exception in case a target
+channel commit is deemed \"invalid\"."
   (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
@@ -927,30 +930,31 @@ (define* (cached-channel-instance store
 
   (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
-                                                             #: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))
+      (run-with-store store
+        (mlet* %store-monad ((instances
+                              -> (latest-channel-instances store channels
+                                                           #:authenticate?
+                                                           authenticate?
+                                                           #:current-channels
+                                                           reference-channels
+                                                           #:validate-pull
+                                                           validate-channels))
+                             (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
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index f31fae7435..bd64364fa2 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -46,12 +46,6 @@ (define-module (guix scripts time-machine)
   #: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
-
 \f
 ;;;
 ;;; Command-line options.
@@ -144,6 +138,31 @@ (define (parse-args args)
         (("--") opts)
         (("--" command ...) (alist-cons 'exec command opts))))))
 
+\f
+;;;
+;;; Avoiding traveling too far back.
+;;;
+
+;;; 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
+
+(define %reference-channels
+  (list (channel (inherit %default-guix-channel)
+                 (commit %oldest-possible-commit))))
+
+(define (validate-guix-channel channel start commit relation)
+  "Raise an error if CHANNEL is the 'guix' channel and the RELATION of COMMIT
+to %OLDEST-POSSIBLE-COMMIT is not that of an ancestor."
+  (unless (or (not (guix-channel? channel))
+              (memq relation '(ancestor self)))
+    (raise (formatted-message
+            (G_ "cannot travel past commit `~a' from May 1st, 2019")
+            (string-take %oldest-possible-commit 12)))))
+
+
 \f
 ;;;
 ;;; Entry point.
@@ -160,31 +179,6 @@ (define-command (guix-time-machine . args)
             (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 the channel, is valid and new enough to satisfy the 'guix
-time-machine' requirements.  If the captured REF variable is #f, the reference
-validate is the one of the Guix channel found in CHANNELS.  A
-`formatted-message' condition is raised otherwise."
-         (let* ((guix-channel (find guix-channel? channels))
-                (guix-channel-commit (channel-commit guix-channel))
-                (guix-channel-branch (channel-branch guix-channel))
-                (guix-channel-ref (if guix-channel-commit
-                                      `(tag-or-commit . ,guix-channel-commit)
-                                      `(branch . ,guix-channel-branch)))
-                (reference (or ref guix-channel-ref))
-                (checkout commit relation (update-cached-checkout
-                                           (channel-url guix-channel)
-                                           #:ref reference
-                                           #: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
@@ -197,6 +191,8 @@ (define-command (guix-time-machine . args)
                        (set-build-options-from-command-line store opts)
                        (cached-channel-instance store channels
                                                 #:authenticate? authenticate?
+                                                #:reference-channels
+                                                %reference-channels
                                                 #:validate-channels
                                                 validate-guix-channel)))))
                 (executable (string-append directory "/bin/guix")))
-- 
2.41.0

[bug#66793] [PATCH 2/3] time-machine: Make target commit check cheaper.

[Maxim Cournoyer]

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> Commit 79ec651a286c71a3d4c72be33a1f80e76a560031 introduced a check to
> error out when attempting to use ‘time-machine’ to travel to a commit
> before ‘v1.0.0’.
>
> This commit fixes a performance issue with the strategy used in
> 79ec651a286c71a3d4c72be33a1f80e76a560031 (the repository was opened,
> updated, and traversed a second time by ‘validate-guix-channel’) as well
> as a user interface issue (“Updating channel” messages would be printed
> too late).
>
> This patch reimplements the check in terms of the existing #:validate-pull
> mechanism, which is designed to avoid extra repository operations.
>
> Fixes <https://issues.guix.gnu.org/65788>.
>
> * guix/inferior.scm (cached-channel-instance): Change default value
> of #:validate-channels.  Remove call to VALIDATE-CHANNELS; pass it
> as #:validate-pull to ‘latest-channel-instances’.
> * guix/scripts/time-machine.scm (%reference-channels): New variable.
> (validate-guix-channel): New procedure.
> (guix-time-machine)[validate-guix-channel]: Remove.

Nitpick: I'd say the proc was moved and simplified to ease traceability
for the reader; same for %oldest-possible-commit (not mentioned in
changelog).

Otherwise LGTM!

-- 
Thanks,
Maxim

bug#66793: [PATCH 2/3] time-machine: Make target commit check cheaper.

[Ludovic Courtès]

Hi,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Commit 79ec651a286c71a3d4c72be33a1f80e76a560031 introduced a check to
>> error out when attempting to use ‘time-machine’ to travel to a commit
>> before ‘v1.0.0’.
>>
>> This commit fixes a performance issue with the strategy used in
>> 79ec651a286c71a3d4c72be33a1f80e76a560031 (the repository was opened,
>> updated, and traversed a second time by ‘validate-guix-channel’) as well
>> as a user interface issue (“Updating channel” messages would be printed
>> too late).
>>
>> This patch reimplements the check in terms of the existing #:validate-pull
>> mechanism, which is designed to avoid extra repository operations.
>>
>> Fixes <https://issues.guix.gnu.org/65788>.
>>
>> * guix/inferior.scm (cached-channel-instance): Change default value
>> of #:validate-channels.  Remove call to VALIDATE-CHANNELS; pass it
>> as #:validate-pull to ‘latest-channel-instances’.
>> * guix/scripts/time-machine.scm (%reference-channels): New variable.
>> (validate-guix-channel): New procedure.
>> (guix-time-machine)[validate-guix-channel]: Remove.
>
> Nitpick: I'd say the proc was moved and simplified to ease traceability
> for the reader; same for %oldest-possible-commit (not mentioned in
> changelog).

Indeed; I clarified that ‘validate-guix-channel’ was moved but didn’t
write anything about ‘%oldest-possible-commit’ because it’s actually
unchanged (just moved a few lines below).

I pushed the result:

  331d858e21 time-machine: Warn when no command is given.
  ab13e2be69 time-machine: Make target commit check cheaper.
  9f05fbb67d tests: Make ‘guix time-machine’ test effective.

Thanks for reviewing!

Ludo’.

[bug#66793] [PATCH 3/3] time-machine: Warn when no command is given.

[Ludovic Courtès]

* guix/scripts/time-machine.scm (guix-time-machine): Emit a warning when
COMMAND-LINE is false.

Change-Id: I26e6b608915ecaf6d9372f9b03dc5ebd1b4c68f9
---
 guix/scripts/time-machine.scm | 37 ++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index bd64364fa2..2c30fe7cfd 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -179,21 +179,22 @@ (define-command (guix-time-machine . args)
             (ref          (assoc-ref opts 'ref))
             (substitutes?  (assoc-ref opts 'substitutes?))
             (authenticate? (assoc-ref opts 'authenticate-channels?)))
-       (when command-line
-         (let* ((directory
-                 (with-store store
-                   (with-status-verbosity (assoc-ref opts 'verbosity)
-                     (with-build-handler (build-notifier #:use-substitutes?
-                                                         substitutes?
-                                                         #:verbosity
-                                                         (assoc-ref opts 'verbosity)
-                                                         #:dry-run? #f)
-                       (set-build-options-from-command-line store opts)
-                       (cached-channel-instance store channels
-                                                #:authenticate? authenticate?
-                                                #:reference-channels
-                                                %reference-channels
-                                                #:validate-channels
-                                                validate-guix-channel)))))
-                (executable (string-append directory "/bin/guix")))
-           (apply execl (cons* executable executable command-line))))))))
+       (if command-line
+           (let* ((directory
+                   (with-store store
+                     (with-status-verbosity (assoc-ref opts 'verbosity)
+                       (with-build-handler (build-notifier #:use-substitutes?
+                                                           substitutes?
+                                                           #:verbosity
+                                                           (assoc-ref opts 'verbosity)
+                                                           #:dry-run? #f)
+                         (set-build-options-from-command-line store opts)
+                         (cached-channel-instance store channels
+                                                  #:authenticate? authenticate?
+                                                  #:reference-channels
+                                                  %reference-channels
+                                                  #:validate-channels
+                                                  validate-guix-channel)))))
+                  (executable (string-append directory "/bin/guix")))
+             (apply execl (cons* executable executable command-line)))
+           (warning (G_ "no command specified; nothing to do~%")))))))
-- 
2.41.0

[bug#66793] [PATCH 3/3] time-machine: Warn when no command is given.

[Maxim Cournoyer]

Hi Ludo,

Ludovic Courtès <ludo@gnu.org> writes:

> * guix/scripts/time-machine.scm (guix-time-machine): Emit a warning when
> COMMAND-LINE is false.

[...]

> +       (if command-line
> +           (let* ((directory
> +                   (with-store store
> +                     (with-status-verbosity (assoc-ref opts 'verbosity)
> +                       (with-build-handler (build-notifier #:use-substitutes?
> +                                                           substitutes?
> +                                                           #:verbosity
> +                                                           (assoc-ref opts 'verbosity)
> +                                                           #:dry-run? #f)
> +                         (set-build-options-from-command-line store opts)
> +                         (cached-channel-instance store channels
> +                                                  #:authenticate? authenticate?
> +                                                  #:reference-channels
> +                                                  %reference-channels
> +                                                  #:validate-channels
> +                                                  validate-guix-channel)))))
> +                  (executable (string-append directory "/bin/guix")))
> +             (apply execl (cons* executable executable command-line)))
> +           (warning (G_ "no command specified; nothing to do~%")))))))

LGTM.

-- 
Thanks,
Maxim