From 044d1478c9a63a64547c9cc320008f8d8fbf6791 Mon Sep 17 00:00:00 2001 From: Brice Waegeneire Date: Sun, 5 Apr 2020 07:28:03 +0200 Subject: gnu: Add kernel-module-loader-service. * doc/guix.texi (Linux Services): Add a new subsection and document the new service and its configuration. * gnu/services/linux.scm (kernel-module-loader-service-type): New type. (kernel-module-loader-shepherd-service): New procedure. * gnu/tests/linux-modules.scm (module-loader-program): Procedure removed. (modules-loaded?-program): New procedure. (run-loadable-kernel-modules-test): 'module-loader-program' procedure replaced by the new one. [os]: Use 'kernel-module-loader-service'. Signed-off-by: Danny Milosavljevic --- gnu/tests/linux-modules.scm | 45 ++++++++++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 13 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm index 39e11587c6..788bdc848a 100644 --- a/gnu/tests/linux-modules.scm +++ b/gnu/tests/linux-modules.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Jakob L. Kreuze ;;; Copyright © 2020 Danny Milosavljevic +;;; Copyright © 2020 Brice Waegeneire ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +20,8 @@ (define-module (gnu tests linux-modules) #:use-module (gnu packages linux) + #:use-module (gnu services) + #:use-module (gnu services linux) #:use-module (gnu system) #:use-module (gnu system vm) #:use-module (gnu tests) @@ -37,25 +40,40 @@ ;;; ;;; Code: -(define* (module-loader-program os modules) - "Return an executable store item that, upon being evaluated, will dry-run -load MODULES." +(define* (modules-loaded?-program os modules) + "Return an executable store item that, upon being evaluated, will verify +that MODULES are actually loaded." (program-file - "load-kernel-modules.scm" - (with-imported-modules (source-module-closure '((guix build utils))) - #~(begin - (use-modules (guix build utils)) - (for-each (lambda (module) - (invoke (string-append #$kmod "/bin/modprobe") "-n" "--" - module)) - '#$modules))))) + "verify-kernel-modules-loaded.scm" + #~(begin + (use-modules (ice-9 rdelim) + (ice-9 popen) + (srfi srfi-1) + (srfi srfi-13)) + (let* ((port (open-input-pipe (string-append #$kmod "/bin/lsmod"))) + (lines (string-split (read-string port) #\newline)) + (separators (char-set #\space #\tab)) + (modules (map (lambda (line) + (string-take line + (or (string-index line separators) + 0))) + lines)) + (status (close-pipe port))) + (and (= status 0) + (and-map (lambda (module) + (member module modules string=?)) + '#$modules)))))) (define* (run-loadable-kernel-modules-test module-packages module-names) - "Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES." + "Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES +are loaded in memory." (define os (marionette-operating-system (operating-system (inherit (simple-operating-system)) + (services (cons (service kernel-module-loader-service-type module-names) + (operating-system-user-services + (simple-operating-system)))) (kernel-loadable-modules module-packages)) #:imported-modules '((guix combinators)))) (define vm (virtual-machine os)) @@ -75,7 +93,8 @@ load MODULES." marionette)) (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - (gexp->derivation "loadable-kernel-modules" (test (module-loader-program os module-names)))) + (gexp->derivation "loadable-kernel-modules" + (test (modules-loaded?-program os module-names)))) (define %test-loadable-kernel-modules-0 (system-test -- cgit 1.4.1 From d7113bb655ff80a868a9e624c913f9d23e6c63ad Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 6 Apr 2020 23:50:27 +0200 Subject: services: syslog: Create log files as non-world-readable. Partly fixes . Reported by Diego Nicola Barbato . * gnu/services/base.scm (syslog-service-type): Change 'start' method to set umask to #o137 before spawning syslogd. * gnu/tests/base.scm (run-basic-test)["/var/log/messages is not world-readable"]: New test. --- gnu/services/base.scm | 15 +++++++++++---- gnu/tests/base.scm | 8 ++++++++ 2 files changed, 19 insertions(+), 4 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index a0179c0259..f802005e3c 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1436,10 +1436,17 @@ Service Switch}, for an example." (documentation "Run the syslog daemon (syslogd).") (provision '(syslogd)) (requirement '(user-processes)) - (start #~(make-forkexec-constructor - (list #$(syslog-configuration-syslogd config) - "--rcfile" #$(syslog-configuration-config-file config)) - #:pid-file "/var/run/syslog.pid")) + (start #~(let ((spawn (make-forkexec-constructor + (list #$(syslog-configuration-syslogd config) + "--rcfile" + #$(syslog-configuration-config-file config)) + #:pid-file "/var/run/syslog.pid"))) + (lambda () + ;; Set the umask such that file permissions are #o640. + (let ((mask (umask #o137)) + (pid (spawn))) + (umask mask) + pid)))) (stop #~(make-kill-destructor)))))) ;; Snippet adapted from the GNU inetutils manual. diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 37b83dc7ec..fe63cecbd0 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -195,6 +195,14 @@ info --version") (pk 'services services) '(root #$@(operating-system-shepherd-service-names os))))) + (test-equal "/var/log/messages is not world-readable" + #o640 ; + (begin + (wait-for-file "/var/log/messages" marionette + #:read 'get-u8) + (marionette-eval '(stat:perms (lstat "/var/log/messages")) + marionette))) + (test-assert "homes" (let ((homes '#$(map user-account-home-directory -- cgit 1.4.1 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. --- doc/guix.texi | 19 ++++++++- gnu/services/base.scm | 113 +++++++++++++++++++++++++++++++++----------------- gnu/tests/base.scm | 15 +++++++ 3 files changed, 106 insertions(+), 41 deletions(-) (limited to 'gnu/tests') 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 1.4.1