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.
This commit is contained in:
parent
a9eeeaa6ae
commit
838ac881ec
@ -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))))))
|
||||
|
@ -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))))))))
|
||||
|
Loading…
Reference in New Issue
Block a user