mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
2 changed files with 19 additions and 5 deletions
|
@ -687,13 +687,16 @@ (define %inferior-cache-directory
|
||||||
(define* (cached-channel-instance store
|
(define* (cached-channel-instance store
|
||||||
channels
|
channels
|
||||||
#:key
|
#:key
|
||||||
|
(authenticate? #t)
|
||||||
(cache-directory (%inferior-cache-directory))
|
(cache-directory (%inferior-cache-directory))
|
||||||
(ttl (* 3600 24 30)))
|
(ttl (* 3600 24 30)))
|
||||||
"Return a directory containing a guix filetree defined by CHANNELS, a list of 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.
|
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
|
(define instances
|
||||||
(latest-channel-instances store channels))
|
(latest-channel-instances store channels
|
||||||
|
#:authenticate? authenticate?))
|
||||||
|
|
||||||
(define key
|
(define key
|
||||||
(bytevector->base32-string
|
(bytevector->base32-string
|
||||||
|
@ -732,6 +735,8 @@ (define add-indirect-root*
|
||||||
(mbegin %store-monad
|
(mbegin %store-monad
|
||||||
(show-what-to-build* (list profile))
|
(show-what-to-build* (list profile))
|
||||||
(built-derivations (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)
|
(symlink* (derivation->output-path profile) cached)
|
||||||
(add-indirect-root* cached)
|
(add-indirect-root* cached)
|
||||||
(return cached))))))
|
(return cached))))))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -55,6 +55,9 @@ (define (show-help)
|
||||||
--commit=COMMIT use the specified COMMIT"))
|
--commit=COMMIT use the specified COMMIT"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--branch=BRANCH use the tip of the specified BRANCH"))
|
--branch=BRANCH use the tip of the specified BRANCH"))
|
||||||
|
(display (G_ "
|
||||||
|
--disable-authentication
|
||||||
|
disable channel authentication"))
|
||||||
(newline)
|
(newline)
|
||||||
(show-build-options-help)
|
(show-build-options-help)
|
||||||
(newline)
|
(newline)
|
||||||
|
@ -80,6 +83,9 @@ (define %options
|
||||||
(option '("branch") #t #f
|
(option '("branch") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'ref `(branch . ,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
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-help)
|
(show-help)
|
||||||
|
@ -98,6 +104,7 @@ (define %default-options
|
||||||
(print-build-trace? . #t)
|
(print-build-trace? . #t)
|
||||||
(print-extended-build-trace? . #t)
|
(print-extended-build-trace? . #t)
|
||||||
(multiplexed-build-output? . #t)
|
(multiplexed-build-output? . #t)
|
||||||
|
(authenticate-channels? . #t)
|
||||||
(graft? . #t)
|
(graft? . #t)
|
||||||
(debug . 0)
|
(debug . 0)
|
||||||
(verbosity . 1)))
|
(verbosity . 1)))
|
||||||
|
@ -124,12 +131,14 @@ (define (guix-time-machine . args)
|
||||||
(with-git-error-handling
|
(with-git-error-handling
|
||||||
(let* ((opts (parse-args args))
|
(let* ((opts (parse-args args))
|
||||||
(channels (channel-list opts))
|
(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
|
(when command-line
|
||||||
(let* ((directory
|
(let* ((directory
|
||||||
(with-store store
|
(with-store store
|
||||||
(with-status-verbosity (assoc-ref opts 'verbosity)
|
(with-status-verbosity (assoc-ref opts 'verbosity)
|
||||||
(set-build-options-from-command-line store opts)
|
(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")))
|
(executable (string-append directory "/bin/guix")))
|
||||||
(apply execl (cons* executable executable command-line))))))))
|
(apply execl (cons* executable executable command-line))))))))
|
||||||
|
|
Loading…
Reference in a new issue