~ruther/guix-local

838ac881ec98cb71d4a4e4b20773573f99ecbf25 — Ludovic Courtès 6 years ago a9eeeaa
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.
2 files changed, 19 insertions(+), 5 deletions(-)

M guix/inferior.scm
M guix/scripts/time-machine.scm
M guix/inferior.scm => guix/inferior.scm +7 -2
@@ 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))))))

M guix/scripts/time-machine.scm => guix/scripts/time-machine.scm +12 -3
@@ 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))))))))