summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-12-11 22:18:05 +0100
committerMarius Bakke <mbakke@fastmail.com>2018-12-11 22:18:05 +0100
commitb03e4fd5269897448124a7b61a737802b2c638ee (patch)
treee4eaab1d3076e335c57eea462ff7fda7919f0831 /gnu/services
parentda3c6a7f19ef1243af725f63c16c8fd92fde33b4 (diff)
parent99aad42138e0895df51e64e1261984f277952516 (diff)
downloadguix-b03e4fd5269897448124a7b61a737802b2c638ee.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm119
-rw-r--r--gnu/services/cuirass.scm6
-rw-r--r--gnu/services/desktop.scm8
-rw-r--r--gnu/services/dns.scm7
-rw-r--r--gnu/services/games.scm3
-rw-r--r--gnu/services/mail.scm51
-rw-r--r--gnu/services/mcron.scm2
-rw-r--r--gnu/services/ssh.scm10
-rw-r--r--gnu/services/web.scm5
9 files changed, 156 insertions, 55 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 47c7d8bb27..b10f5cbaf1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1251,18 +1252,57 @@ the tty to run, among other things."
                                 (string-concatenate
                                  (map cache->config caches)))))))
 
+(define (nscd-action-procedure nscd config option)
+  ;; XXX: This is duplicated from mcron; factorize.
+  #~(lambda (_ . args)
+      ;; Run 'nscd' in a pipe so we can explicitly redirect its output to
+      ;; 'current-output-port', which at this stage is bound to the client
+      ;; connection.
+      (let ((pipe (apply open-pipe* OPEN_READ #$nscd
+                         "-f" #$config #$option args)))
+        (let loop ()
+          (match (read-line pipe 'concat)
+            ((? eof-object?)
+             (catch 'system-error
+               (lambda ()
+                 (zero? (close-pipe pipe)))
+               (lambda args
+                 ;; There's a race with the SIGCHLD handler, which could
+                 ;; call 'waitpid' before 'close-pipe' above does.  If we
+                 ;; get ECHILD, that means we lost the race, but that's
+                 ;; fine.
+                 (or (= ECHILD (system-error-errno args))
+                     (apply throw args)))))
+            (line
+             (display line)
+             (loop)))))))
+
+(define (nscd-actions nscd config)
+  "Return Shepherd actions for NSCD."
+  ;; Make this functionality available as actions because that's a simple way
+  ;; to run the right 'nscd' binary with the right config file.
+  (list (shepherd-action
+         (name 'statistics)
+         (documentation "Display statistics about nscd usage.")
+         (procedure (nscd-action-procedure nscd config "--statistics")))
+        (shepherd-action
+         (name 'invalidate)
+         (documentation
+          "Invalidate the given cache--e.g., 'hosts' for host name lookups.")
+         (procedure (nscd-action-procedure nscd config "--invalidate")))))
+
 (define (nscd-shepherd-service config)
   "Return a shepherd service for CONFIG, an <nscd-configuration> object."
-  (let ((nscd.conf     (nscd.conf-file config))
+  (let ((nscd          (file-append (nscd-configuration-glibc config)
+                                    "/sbin/nscd"))
+        (nscd.conf     (nscd.conf-file config))
         (name-services (nscd-configuration-name-services config)))
     (list (shepherd-service
            (documentation "Run libc's name service cache daemon (nscd).")
            (provision '(nscd))
            (requirement '(user-processes))
            (start #~(make-forkexec-constructor
-                     (list #$(file-append (nscd-configuration-glibc config)
-                                          "/sbin/nscd")
-                           "-f" #$nscd.conf "--foreground")
+                     (list #$nscd "-f" #$nscd.conf "--foreground")
 
                      ;; Wait for the PID file.  However, the PID file is
                      ;; written before nscd is actually listening on its
@@ -1276,7 +1316,12 @@ the tty to run, among other things."
                                                   (string-append dir "/lib"))
                                                 (list #$@name-services))
                                            ":")))))
-           (stop #~(make-kill-destructor))))))
+           (stop #~(make-kill-destructor))
+           (modules `((ice-9 popen)               ;for the actions
+                      (ice-9 rdelim)
+                      (ice-9 match)
+                      ,@%default-modules))
+           (actions (nscd-actions nscd nscd.conf))))))
 
 (define nscd-activation
   ;; Actions to take before starting nscd.
@@ -1454,26 +1499,27 @@ starting at FIRST-UID, and under GID."
           1+
           1))
 
-(define (hydra-key-authorization key guix)
-  "Return a gexp with code to register KEY, a file containing a 'guix archive'
-public key, with GUIX."
+(define (hydra-key-authorization keys guix)
+  "Return a gexp with code to register KEYS, a list of files containing 'guix
+archive' public keys, with GUIX."
   #~(unless (file-exists? "/etc/guix/acl")
-      (let ((pid (primitive-fork)))
-        (case pid
-          ((0)
-           (let* ((key  #$key)
-                  (port (open-file key "r0b")))
-             (format #t "registering public key '~a'...~%" key)
-             (close-port (current-input-port))
-             (dup port 0)
-             (execl #$(file-append guix "/bin/guix")
-                    "guix" "archive" "--authorize")
-             (exit 1)))
-          (else
-           (let ((status (cdr (waitpid pid))))
-             (unless (zero? status)
-               (format (current-error-port) "warning: \
-failed to register hydra.gnu.org public key: ~a~%" status))))))))
+      (for-each (lambda (key)
+                  (let ((pid (primitive-fork)))
+                    (case pid
+                      ((0)
+                       (let* ((port (open-file key "r0b")))
+                         (format #t "registering public key '~a'...~%" key)
+                         (close-port (current-input-port))
+                         (dup port 0)
+                         (execl #$(file-append guix "/bin/guix")
+                                "guix" "archive" "--authorize")
+                         (primitive-exit 1)))
+                      (else
+                       (let ((status (cdr (waitpid pid))))
+                         (unless (zero? status)
+                           (format (current-error-port) "warning: \
+failed to register public key '~a': ~a~%" key status)))))))
+                '(#$@keys))))
 
 (define %default-authorized-guix-keys
   ;; List of authorized substitute keys.
@@ -1558,7 +1604,15 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                             '())
                      #$@(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))
            (stop #~(make-kill-destructor))))))
@@ -1585,10 +1639,9 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
      ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs,
      ;; chown leads to an entire copy of the tree, which is a bad idea.
 
-     ;; Optionally authorize hydra.gnu.org's key.
+     ;; Optionally authorize substitute server keys.
      (if authorize-key?
-         #~(begin
-             #$@(map (cut hydra-key-authorization <> guix) keys))
+         (hydra-key-authorization keys guix)
          #~#f))))
 
 (define* (references-file item #:optional (name "references"))
@@ -2040,6 +2093,8 @@ This service is not part of @var{%base-services}."
                            (default (file-append shadow "/bin/login")))
   (login-arguments         kmscon-configuration-login-arguments
                            (default '("-p")))
+  (auto-login              kmscon-configuration-auto-login
+                           (default #f))
   (hardware-acceleration?  kmscon-configuration-hardware-acceleration?
                            (default #f))) ; #t causes failure
 
@@ -2051,14 +2106,20 @@ This service is not part of @var{%base-services}."
            (virtual-terminal (kmscon-configuration-virtual-terminal config))
            (login-program (kmscon-configuration-login-program config))
            (login-arguments (kmscon-configuration-login-arguments config))
+           (auto-login (kmscon-configuration-auto-login config))
            (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config)))
 
        (define kmscon-command
          #~(list
             #$(file-append kmscon "/bin/kmscon") "--login"
             "--vt" #$virtual-terminal
+            "--no-switchvt" ;Prevent a switch to the virtual terminal.
             #$@(if hardware-acceleration? '("--hwaccel") '())
-            "--" #$login-program #$@login-arguments))
+            "--login" "--"
+            #$login-program #$@login-arguments
+            #$@(if auto-login
+                   #~(#$auto-login)
+                   #~())))
 
        (shepherd-service
         (documentation "kmscon virtual terminal")
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 496b2d06c8..36e90fc825 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
@@ -54,6 +54,8 @@
                     (default "/var/log/cuirass.log"))
   (cache-directory  cuirass-configuration-cache-directory ;string (dir-name)
                     (default "/var/cache/cuirass"))
+  (ttl              cuirass-configuration-ttl     ;integer
+                    (default (* 30 24 3600)))
   (user             cuirass-configuration-user ;string
                     (default "cuirass"))
   (group            cuirass-configuration-group ;string
@@ -86,6 +88,7 @@
          (group            (cuirass-configuration-group config))
          (interval         (cuirass-configuration-interval config))
          (database         (cuirass-configuration-database config))
+         (ttl              (cuirass-configuration-ttl config))
          (port             (cuirass-configuration-port config))
          (host             (cuirass-configuration-host config))
          (specs            (cuirass-configuration-specifications config))
@@ -102,6 +105,7 @@
                             "--specifications"
                             #$(scheme-file "cuirass-specs.scm" specs)
                             "--database" #$database
+                            "--ttl" #$(string-append (number->string ttl) "s")
                             "--port" #$(number->string port)
                             "--listen" #$host
                             "--interval" #$(number->string interval)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index e038f97683..47d1096c6d 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -672,7 +672,7 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
    ("KillUserProcesses" (yesno elogind-kill-user-processes?))
    ("KillOnlyUsers" (user-name-list elogind-kill-only-users))
    ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
-   ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds))
+   ("InhibitDelayMaxSec" (non-negative-integer elogind-inhibit-delay-max-seconds))
    ("HandlePowerKey" (handle-action elogind-handle-power-key))
    ("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
    ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
@@ -682,16 +682,16 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
    ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
    ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
    ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
-   ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds))
+   ("HoldoffTimeoutSec" (non-negative-integer elogind-holdoff-timeout-seconds))
    ("IdleAction" (handle-action elogind-idle-action))
-   ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds))
+   ("IdleActionSec" (non-negative-integer elogind-idle-action-seconds))
    ("RuntimeDirectorySize"
     (identity
      (lambda (config)
        (match (elogind-runtime-directory-size-percent config)
          (#f (non-negative-integer (elogind-runtime-directory-size config)))
          (percent (string-append (non-negative-integer percent) "%"))))))
-   ("RemoveIpc" (yesno elogind-remove-ipc?))
+   ("RemoveIPC" (yesno elogind-remove-ipc?))
    "[Sleep]"
    ("SuspendState" (sleep-list elogind-suspend-state))
    ("SuspendMode" (sleep-list elogind-suspend-mode))
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 16bd039f59..1ef754b360 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -684,7 +684,8 @@
   (string-delete #\? (symbol->string field-name)))
 
 (define (serialize-field field-name val)
-  (format #t "~a=~a\n" (uglify-field-name field-name) val))
+  (when (not (member field-name '(group secret-file user)))
+    (format #t "~a=~a\n" (uglify-field-name field-name) val)))
 
 (define (serialize-boolean field-name val)
   (serialize-field field-name (if val "yes" "no")))
@@ -763,9 +764,9 @@ manually.")
         (use-modules (guix build utils)
                      (ice-9 rdelim))
         (let ((ddclient-user
-               #$(passwd:uid (getpw (ddclient-configuration-user config))))
+               (passwd:uid (getpw #$(ddclient-configuration-user config))))
               (ddclient-group
-               #$(passwd:gid (getpw (ddclient-configuration-group config))))
+               (passwd:gid (getpw #$(ddclient-configuration-group config))))
               (ddclient-secret-file
                #$(ddclient-configuration-secret-file config)))
           ;; 'ddclient' complains about ddclient.conf file permissions, which
diff --git a/gnu/services/games.scm b/gnu/services/games.scm
index b9d78e078d..b743f6a4b6 100644
--- a/gnu/services/games.scm
+++ b/gnu/services/games.scm
@@ -65,7 +65,8 @@
         (modules '((gnu build shepherd)))
         (start #~(make-forkexec-constructor/container
                   (list #$(file-append package "/bin/wesnothd")
-                        "-p" #$(number->string port))))
+                        "-p" #$(number->string port))
+                  #:user "wesnothd" #:group "wesnothd"))
         (stop #~(make-kill-destructor)))))))
 
 (define wesnothd-service-type
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 573efa0433..fcaedd038b 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
-;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -290,11 +290,21 @@ the section name.")
    "Listeners for the service.  A listener is either an
 @code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or
 an @code{inet-listener-configuration}.")
+  (client-limit
+   (non-negative-integer 0)
+   "Maximum number of simultaneous client connections per process.  Once this
+number of connections is received, the next incoming connection will prompt
+Dovecot to spawn another process.  If set to 0, @code{default-client-limit} is
+used instead.")
   (service-count
    (non-negative-integer 1)
    "Number of connections to handle before starting a new process.
 Typically the only useful values are 0 (unlimited) or 1.  1 is more
 secure, but 0 is faster.  <doc/wiki/LoginProcess.txt>.")
+  (process-limit
+   (non-negative-integer 0)
+   "Maximum number of processes that can exist for this service.  If set to 0,
+@code{default-process-limit} is used instead.")
   (process-min-avail
    (non-negative-integer 0)
    "Number of processes to always keep waiting for more connections.")
@@ -475,6 +485,8 @@ complex, customize the address and port fields of the
     (list
      (service-configuration
       (kind "imap-login")
+      (client-limit 0)
+      (process-limit 0)
       (listeners
        (list
         (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f))
@@ -487,24 +499,33 @@ complex, customize the address and port fields of the
         (inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t)))))
      (service-configuration
       (kind "lmtp")
+      (client-limit 1)
+      (process-limit 0)
       (listeners
        (list (unix-listener-configuration (path "lmtp") (mode "0666")))))
-     (service-configuration (kind "imap"))
-     (service-configuration (kind "pop3"))
-     (service-configuration (kind "auth")
-      ;; In what could be taken to be a bug, the default value of 1 for
-      ;; service-count makes it so that a PAM auth worker can't fork off
-      ;; subprocesses for making blocking queries.  The result is that nobody
-      ;; can log in -- very secure, but not very useful!  If we simply omit
-      ;; the service-count, it will default to the value of
-      ;; auth-worker-max-count, which is 30, instead of defaulting to 1, which
-      ;; is the default for all other services.  As a hack, bump this value to
-      ;; 30.
-      (service-count 30)
+     (service-configuration
+      (kind "imap")
+      (client-limit 1)
+      (process-limit 1024))
+     (service-configuration
+      (kind "pop3")
+      (client-limit 1)
+      (process-limit 1024))
+     (service-configuration
+      (kind "auth")
+      (service-count 0)
+      (client-limit 0)
+      (process-limit 1)
       (listeners
        (list (unix-listener-configuration (path "auth-userdb")))))
-     (service-configuration (kind "auth-worker"))
-     (service-configuration (kind "dict")
+     (service-configuration
+      (kind "auth-worker")
+      (client-limit 1)
+      (process-limit 0))
+     (service-configuration
+      (kind "dict")
+      (client-limit 1)
+      (process-limit 0)
       (listeners (list (unix-listener-configuration (path "dict")))))))
    "List of services to enable.  Available services include @samp{imap},
 @samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 5757bf8cf6..120b663e3e 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -86,7 +86,7 @@ files."
                  (lambda ()
                    (zero? (close-pipe pipe)))
                  (lambda args
-                   ;; There's with race between the SIGCHLD handler, which
+                   ;; There's a race with the SIGCHLD handler, which
                    ;; could call 'waitpid' before 'close-pipe' above does.  If
                    ;; we get ECHILD, that means we lost the race, but that's
                    ;; fine.
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 056602248f..bb94c5f41a 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -518,7 +518,15 @@ of user-name/file-like tuples."
                        (service-extension activation-service-type
                                           openssh-activation)
                        (service-extension account-service-type
-                                          (const %openssh-accounts))))
+                                          (const %openssh-accounts))
+
+                       ;; Install OpenSSH in the system profile.  That way,
+                       ;; 'scp' is found when someone tries to copy to or from
+                       ;; this machine.
+                       (service-extension profile-service-type
+                                          (lambda (config)
+                                            (list (openssh-configuration-openssh
+                                                   config))))))
                 (compose concatenate)
                 (extend extend-openssh-authorized-keys)
                 (default-value (openssh-configuration))))
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 1edb1f4d34..fcf453c248 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -70,6 +70,11 @@
             httpd-config-file-user
             httpd-config-file-group
 
+            <httpd-module>
+            httpd-module
+            httpd-module?
+            %default-httpd-modules
+
             httpd-service-type
 
             <nginx-configuration>