me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2020-06-16 15:33:57 +02:00
parent a9eeeaa6ae
commit 838ac881ec
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
guix/inferior.scm
View File

@ -687,13 +687,16 @@ failing when GUIX is too old and lacks the 'guix repl' command."
(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 @@ This procedure opens a new connection to the build daemon."
(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))))))

15
guix/scripts/time-machine.scm
View File

@ -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 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
--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 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(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 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(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 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(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))))))))