From 3302e03ba0edca49347c6a2b215e56bd53a6b113 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès 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. --- gnu/services/base.scm | 113 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 74 insertions(+), 39 deletions(-) (limited to 'gnu/services') 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) -- cgit v1.2.3