From 3302e03ba0edca49347c6a2b215e56bd53a6b113 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 7 Apr 2020 12:13:04 +0200 Subject: services: guix: Add 'set-http-proxy' action. Fixes . Reported by Divan Santana . * gnu/services/base.scm (shepherd-set-http-proxy-action): New procedure. (guix-shepherd-service): Add 'actions' field. Change 'start' to a lambda; check the value of the "http_proxy" environment variable and add "http_proxy" and "https_proxy" to #:environment-variables as a function of that. * gnu/tests/base.scm (run-basic-test)["guix-daemon set-http-proxy action", "guix-daemon set-http-proxy action, clear"]: New tests. * doc/guix.texi (Base Services): Document it. --- doc/guix.texi | 19 ++++++++- gnu/services/base.scm | 113 +++++++++++++++++++++++++++++++++----------------- gnu/tests/base.scm | 15 +++++++ 3 files changed, 106 insertions(+), 41 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 450ca3c5d8..7169e03516 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12779,9 +12779,24 @@ List of extra command-line options for @command{guix-daemon}. File where @command{guix-daemon}'s standard output and standard error are written. +@cindex HTTP proxy, for @code{guix-daemon} +@cindex proxy, for @code{guix-daemon} HTTP access @item @code{http-proxy} (default: @code{#f}) -The HTTP proxy used for downloading fixed-output derivations and -substitutes. +The URL of the HTTP and HTTPS proxy used for downloading fixed-output +derivations and substitutes. + +It is also possible to change the daemon's proxy at run time through the +@code{set-http-proxy} action, which restarts it: + +@example +herd set-http-proxy guix-daemon http://localhost:8118 +@end example + +To clear the proxy settings, run: + +@example +herd set-http-proxy guix-daemon +@end example @item @code{tmpdir} (default: @code{#f}) A directory path where the @command{guix-daemon} will perform builds. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index f802005e3c..cb556e87bc 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1640,6 +1640,30 @@ archive' public keys, with GUIX." (define %default-guix-configuration (guix-configuration)) +(define shepherd-set-http-proxy-action + ;; Shepherd action to change the HTTP(S) proxy. + (shepherd-action + (name 'set-http-proxy) + (documentation + "Change the HTTP(S) proxy used by 'guix-daemon' and restart it.") + (procedure #~(lambda* (_ #:optional proxy) + (let ((environment (environ))) + ;; A bit of a hack: communicate PROXY to the 'start' + ;; method via environment variables. + (if proxy + (begin + (format #t "changing HTTP/HTTPS \ +proxy of 'guix-daemon' to ~s...~%" + proxy) + (setenv "http_proxy" proxy)) + (begin + (format #t "clearing HTTP/HTTPS \ +proxy of 'guix-daemon'...~%") + (unsetenv "http_proxy"))) + (action 'guix-daemon 'restart) + (environ environment) + #t))))) + (define (guix-shepherd-service config) "Return a for the Guix daemon service with CONFIG." (match-record config @@ -1651,47 +1675,58 @@ archive' public keys, with GUIX." (documentation "Run the Guix daemon.") (provision '(guix-daemon)) (requirement '(user-processes)) + (actions (list shepherd-set-http-proxy-action)) (modules '((srfi srfi-1))) (start - #~(make-forkexec-constructor - (cons* #$(file-append guix "/bin/guix-daemon") - "--build-users-group" #$build-group - "--max-silent-time" #$(number->string max-silent-time) - "--timeout" #$(number->string timeout) - "--log-compression" #$(symbol->string log-compression) - #$@(if use-substitutes? - '() - '("--no-substitutes")) - "--substitute-urls" #$(string-join substitute-urls) - #$@extra-options - - ;; Add CHROOT-DIRECTORIES and all their dependencies (if - ;; these are store items) to the chroot. - (append-map (lambda (file) - (append-map (lambda (directory) - (list "--chroot-directory" - directory)) - (call-with-input-file file - read))) - '#$(map references-file chroot-directories))) - - #:environment-variables - (list #$@(if http-proxy - (list (string-append "http_proxy=" http-proxy)) - '()) - #$@(if tmpdir - (list (string-append "TMPDIR=" tmpdir)) - '()) - - ;; Make sure we run in a UTF-8 locale so that 'guix - ;; offload' correctly restores nars that contain UTF-8 - ;; file names such as 'nss-certs'. See - ;; . - (string-append "GUIX_LOCPATH=" - #$glibc-utf8-locales "/lib/locale") - "LC_ALL=en_US.utf8") - - #:log-file #$log-file)) + #~(lambda _ + (define proxy + ;; HTTP/HTTPS proxy. The 'http_proxy' variable is set by + ;; the 'set-http-proxy' action. + (or (getenv "http_proxy") #$http-proxy)) + + (fork+exec-command + (cons* #$(file-append guix "/bin/guix-daemon") + "--build-users-group" #$build-group + "--max-silent-time" #$(number->string max-silent-time) + "--timeout" #$(number->string timeout) + "--log-compression" #$(symbol->string log-compression) + #$@(if use-substitutes? + '() + '("--no-substitutes")) + "--substitute-urls" #$(string-join substitute-urls) + #$@extra-options + + ;; Add CHROOT-DIRECTORIES and all their dependencies + ;; (if these are store items) to the chroot. + (append-map (lambda (file) + (append-map (lambda (directory) + (list "--chroot-directory" + directory)) + (call-with-input-file file + read))) + '#$(map references-file + chroot-directories))) + + #:environment-variables + (append (list #$@(if tmpdir + (list (string-append "TMPDIR=" tmpdir)) + '()) + + ;; Make sure we run in a UTF-8 locale so that + ;; 'guix offload' correctly restores nars that + ;; contain UTF-8 file names such as + ;; 'nss-certs'. See + ;; . + (string-append "GUIX_LOCPATH=" + #$glibc-utf8-locales + "/lib/locale") + "LC_ALL=en_US.utf8") + (if proxy + (list (string-append "http_proxy=" proxy) + (string-append "https_proxy=" proxy)) + '())) + + #:log-file #$log-file))) (stop #~(make-kill-destructor)))))) (define (guix-accounts config) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index fe63cecbd0..086d2a133f 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -459,6 +459,21 @@ info --version") (marionette-eval '(readlink "/var/guix/gcroots/profiles") marionette)) + (test-equal "guix-daemon set-http-proxy action" + '(#t) ;one value, #t + (marionette-eval '(with-shepherd-action 'guix-daemon + ('set-http-proxy "http://localhost:8118") + result + result) + marionette)) + + (test-equal "guix-daemon set-http-proxy action, clear" + '(#t) ;one value, #t + (marionette-eval '(with-shepherd-action 'guix-daemon + ('set-http-proxy) + result + result) + marionette)) (test-assert "screendump" (begin -- cgit v1.2.3