diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 130 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 16 | ||||
| -rw-r--r-- | gnu/services/linux.scm | 57 | ||||
| -rw-r--r-- | gnu/services/telephony.scm | 4 | ||||
| -rw-r--r-- | gnu/services/web.scm | 75 |
5 files changed, 213 insertions, 69 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 194dd3b344..08ab5970dc 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. @@ -1633,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> @@ -1644,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) @@ -2444,6 +2486,8 @@ to handle." (service guix-service-type) (service nscd-service-type) + (service rottlog-service-type) + ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is ;; used, so enable them by default. The FUSE and ALSA rules are ;; less critical, but handy. diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 16ee4d3537..7300ff5f4a 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -932,15 +932,23 @@ and extends polkit with the actions from @code{gnome-settings-daemon}." mate-desktop-configuration? (mate-package mate-package (default mate))) +(define (mate-polkit-extension config) + "Return the list of packages for CONFIG's MATE package that extend polkit." + (let ((mate (mate-package config))) + (map (lambda (input) + ((package-direct-input-selector input) mate)) + '("mate-system-monitor" ;kill, renice processes + "mate-settings-daemon" ;date/time settings + "mate-power-manager" ;modify brightness + "mate-control-center" ;RandR, display properties FIXME + "mate-applets")))) ;CPU frequency scaling + (define mate-desktop-service-type (service-type (name 'mate-desktop) (extensions (list (service-extension polkit-service-type - (compose list - (package-direct-input-selector - "mate-settings-daemon") - mate-package)) + mate-polkit-extension) (service-extension profile-service-type (compose list mate-package)))) diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index caa0326c31..781a61973c 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,8 @@ #:use-module (gnu packages linux) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:export (earlyoom-configuration earlyoom-configuration? @@ -37,7 +40,9 @@ earlyoom-configuration-ignore-positive-oom-score-adj? earlyoom-configuration-show-debug-messages? earlyoom-configuration-send-notification-command - earlyoom-service-type)) + earlyoom-service-type + + kernel-module-loader-service-type)) ;;; @@ -123,3 +128,53 @@ representation." (list (service-extension shepherd-root-service-type (compose list earlyoom-shepherd-service)))) (description "Run @command{earlyoom}, the Early OOM daemon."))) + + +;;; +;;; Kernel module loader. +;;; + +(define kernel-module-loader-shepherd-service + (match-lambda + ((and (? list? kernel-modules) ((? string?) ...)) + (list + (shepherd-service + (documentation "Load kernel modules.") + (provision '(kernel-module-loader)) + (requirement '(file-systems)) + (respawn? #f) + (one-shot? #t) + (modules `((srfi srfi-1) + (srfi srfi-34) + (srfi srfi-35) + (rnrs io ports) + ,@%default-modules)) + (start + #~(lambda _ + (cond + ((null? '#$kernel-modules) #t) + ((file-exists? "/proc/sys/kernel/modprobe") + (let ((modprobe (call-with-input-file + "/proc/sys/kernel/modprobe" get-line))) + (guard (c ((message-condition? c) + (format (current-error-port) "~a~%" + (condition-message c)) + #f)) + (every (lambda (module) + (invoke/quiet modprobe "--" module)) + '#$kernel-modules)))) + (else + (format (current-error-port) "error: ~a~%" + "Kernel is missing loadable module support.") + #f))))))))) + +(define kernel-module-loader-service-type + (service-type + (name 'kernel-module-loader) + (description "Load kernel modules.") + (extensions + (list (service-extension shepherd-root-service-type + kernel-module-loader-shepherd-service))) + (compose concatenate) + (extend append) + (default-value '()))) diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm index 0a735315b4..e1259cc2df 100644 --- a/gnu/services/telephony.scm +++ b/gnu/services/telephony.scm @@ -182,7 +182,9 @@ "welcometext=" welcome-text "\n" "port=" (number->string port) "\n" (if server-password (list "serverpassword=" server-password "\n") '()) - (if max-user-bandwidth (list "bandwidth=" (number->string max-user-bandwidth)) '()) + (if max-user-bandwidth (list "bandwidth=" + (number->string max-user-bandwidth) "\n") + '()) "users=" (number->string max-users) "\n" "uname=" user "\n" "database=" database-file "\n" diff --git a/gnu/services/web.scm b/gnu/services/web.scm index fa5c34d5af..9ae84ddbc4 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -262,6 +262,14 @@ patchwork-virtualhost patchwork-service-type + <mumi-configuration> + mumi-configuration + mumi-configuration? + mumi-configuration-mumi + mumi-configuration-mailer? + mumi-configuration-sender + mumi-configuration-smtp + mumi-service-type)) ;;; Commentary: @@ -1678,6 +1686,14 @@ WSGIPassAuthorization On ;;; Mumi. ;;; +(define-record-type* <mumi-configuration> + mumi-configuration make-mumi-configuration + mumi-configuration? + (mumi mumi-configuration-mumi (default mumi)) + (mailer? mumi-configuration-mailer? (default #t)) + (sender mumi-configuration-sender (default #f)) + (smtp mumi-configuration-smtp (default #f))) + (define %mumi-activation (with-imported-modules '((guix build utils)) #~(begin @@ -1702,25 +1718,43 @@ WSGIPassAuthorization On (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) -(define (mumi-shepherd-services mumi) - (list (shepherd-service - (provision '(mumi)) - (documentation "Mumi bug-tracking web interface.") - (requirement '(networking)) - (start #~(make-forkexec-constructor - '(#$(file-append mumi "/bin/mumi")) - #:user "mumi" #:group "mumi" - #:log-file "/var/log/mumi.log")) - (stop #~(make-kill-destructor))) - (shepherd-service - (provision '(mumi-worker)) - (documentation "Mumi bug-tracking web interface.") - (requirement '(networking)) - (start #~(make-forkexec-constructor - '(#$(file-append mumi "/bin/mumi") "--worker") - #:user "mumi" #:group "mumi" - #:log-file "/var/log/mumi.worker.log")) - (stop #~(make-kill-destructor))))) +(define (mumi-shepherd-services config) + (match config + (($ <mumi-configuration> mumi mailer? sender smtp) + (list (shepherd-service + (provision '(mumi)) + (documentation "Mumi bug-tracking web interface.") + (requirement '(networking)) + (start #~(make-forkexec-constructor + `(#$(file-append mumi "/bin/mumi") "web" + ,@(if #$mailer? '() '("--disable-mailer"))) + #:user "mumi" #:group "mumi" + #:log-file "/var/log/mumi.log")) + (stop #~(make-kill-destructor))) + (shepherd-service + (provision '(mumi-worker)) + (documentation "Mumi bug-tracking web interface database worker.") + (requirement '(networking)) + (start #~(make-forkexec-constructor + '(#$(file-append mumi "/bin/mumi") "worker") + #:user "mumi" #:group "mumi" + #:log-file "/var/log/mumi.worker.log")) + (stop #~(make-kill-destructor))) + (shepherd-service + (provision '(mumi-mailer)) + (documentation "Mumi bug-tracking web interface mailer.") + (requirement '(networking)) + (start #~(make-forkexec-constructor + `(#$(file-append mumi "/bin/mumi") "mailer" + ,@(if #$sender + (list (string-append "--sender=" #$sender)) + '()) + ,@(if #$smtp + (list (string-append "--smtp=" #$smtp)) + '())) + #:user "mumi" #:group "mumi" + #:log-file "/var/log/mumi.mailer.log")) + (stop #~(make-kill-destructor))))))) (define mumi-service-type (service-type @@ -1734,4 +1768,5 @@ WSGIPassAuthorization On mumi-shepherd-services))) (description "Run Mumi, a Web interface to the Debbugs bug-tracking server.") - (default-value mumi))) + (default-value + (mumi-configuration)))) |