10/11: time-machine: Add '--disable-authentication'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 838ac881ec98cb71d4a4e4b20773573f99ecbf25
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Jun 16 15:33:57 2020 +0200

    time-machine: Add '--disable-authentication'.
    
    * guix/inferior.scm (cached-channel-instance): Add #:authenticate? and
    pass it to 'latest-channel-instances'.
    * guix/scripts/time-machine.scm (show-help, %options): Add
    '--disable-authentication'.
    (%default-options): Add 'authenticate-channels?'.
    (guix-time-machine): Honor it.
---
 guix/inferior.scm             |  9 +++++++--
 guix/scripts/time-machine.scm | 15 ++++++++++++---
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index c9a5ee5..d347754 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -687,13 +687,16 @@ failing when GUIX is too old and lacks the 'guix repl' 
command."
 (define* (cached-channel-instance store
                                   channels
                                   #:key
+                                  (authenticate? #t)
                                   (cache-directory (%inferior-cache-directory))
                                   (ttl (* 3600 24 30)))
   "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."
+This procedure opens a new connection to the build daemon.  AUTHENTICATE?
+determines whether CHANNELS are authenticated."
   (define instances
-    (latest-channel-instances store channels))
+    (latest-channel-instances store channels
+                              #:authenticate? authenticate?))
 
   (define key
     (bytevector->base32-string
@@ -732,6 +735,8 @@ This procedure opens a new connection to the build daemon."
           (mbegin %store-monad
             (show-what-to-build* (list profile))
             (built-derivations (list profile))
+            ;; Note: Caching is fine even when AUTHENTICATE? is false because
+            ;; we always call 'latest-channel-instances?'.
             (symlink* (derivation->output-path profile) cached)
             (add-indirect-root* cached)
             (return cached))))))
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 1e800e1..f9bcec6 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,6 +55,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
       --commit=COMMIT    use the specified COMMIT"))
   (display (G_ "
       --branch=BRANCH    use the tip of the specified BRANCH"))
+  (display (G_ "
+      --disable-authentication
+                         disable channel authentication"))
   (newline)
   (show-build-options-help)
   (newline)
@@ -80,6 +83,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
          (option '("branch") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'ref `(branch . ,arg) result)))
+         (option '("disable-authentication") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'authenticate-channels? #f result)))
          (option '(#\h "help") #f #f
                  (lambda args
                    (show-help)
@@ -98,6 +104,7 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)
+    (authenticate-channels? . #t)
     (graft? . #t)
     (debug . 0)
     (verbosity . 1)))
@@ -124,12 +131,14 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
     (with-git-error-handling
      (let* ((opts         (parse-args args))
             (channels     (channel-list opts))
-            (command-line (assoc-ref opts 'exec)))
+            (command-line (assoc-ref opts 'exec))
+            (authenticate? (assoc-ref opts 'authenticate-channels?)))
        (when command-line
          (let* ((directory
                  (with-store store
                    (with-status-verbosity (assoc-ref opts 'verbosity)
                      (set-build-options-from-command-line store opts)
-                     (cached-channel-instance store channels))))
+                     (cached-channel-instance store channels
+                                              #:authenticate? authenticate?))))
                 (executable (string-append directory "/bin/guix")))
            (apply execl (cons* executable executable command-line))))))))