summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-04-08 13:00:50 +0200
committerMarius Bakke <mbakke@fastmail.com>2020-04-08 13:00:50 +0200
commit27783023993f9272ce422868d14529159c4a5218 (patch)
tree9013b08aa39e497b1fd8e01a05254278d83f0ff7 /gnu/services
parentbe1e842ad78ac6c52fc7790f4a3ffd716673c111 (diff)
parentba6f2bda18ed19fa486a9c3e2c3baea6c66c6867 (diff)
downloadguix-27783023993f9272ce422868d14529159c4a5218.tar.gz
Merge branch 'master' into core-updates
 Conflicts:
	etc/news.scm
	gnu/local.mk
	gnu/packages/check.scm
	gnu/packages/cross-base.scm
	gnu/packages/gimp.scm
	gnu/packages/java.scm
	gnu/packages/mail.scm
	gnu/packages/sdl.scm
	gnu/packages/texinfo.scm
	gnu/packages/tls.scm
	gnu/packages/version-control.scm
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm130
-rw-r--r--gnu/services/desktop.scm16
-rw-r--r--gnu/services/linux.scm57
-rw-r--r--gnu/services/telephony.scm4
-rw-r--r--gnu/services/web.scm75
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))))