From 838ac881ec98cb71d4a4e4b20773573f99ecbf25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 16 Jun 2020 15:33:57 +0200 Subject: [PATCH] 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 c9a5ee5129..d347754bbc 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 1e800e160f..f9bcec651a 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 -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; ;;; 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))))))))