diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/base.scm | 113 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 15 |
2 files changed, 89 insertions, 39 deletions
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 <shepherd-service> for the Guix daemon service with CONFIG." (match-record config <guix-configuration> @@ -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 - ;; <https://bugs.gnu.org/32942>. - (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 + ;; <https://bugs.gnu.org/32942>. + (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 |