summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorJosselin Poiret <dev@jpoiret.xyz>2023-05-09 18:45:07 +0200
committerLudovic Courtès <ludo@gnu.org>2023-05-11 13:21:45 +0200
commit2df5d4fd18a2fbcb8066a50e2da8ec64635f5162 (patch)
treeecfc8aae744998169e2b38c2e756abeb4210d9f9 /gnu/services
parentb2a65b4c8cfe06eb48e0db83a408dd84175e07dc (diff)
downloadguix-2df5d4fd18a2fbcb8066a50e2da8ec64635f5162.tar.gz
system: pam: Let PAM extensions add shepherd requirements.
* gnu/system/pam.scm (<pam-extension>): New record type.
(pam-shepherd-service): Add Shepherd synchronization point.

* gnu/services/mail.scm (dovecot-shepherd-service)
* gnu/services/lightdm.scm (lightdm-shepherd-service)
* gnu/services/mail.scm (opensmtpd-shepherd-service)
* gnu/services/sddm.scm (sddm-shepherd-service)
* gnu/services/ssh.scm (lsh-shepherd-service, openssh-shepherd-service)
* gnu/services/xorg.scm (slim-shepherd-service, gdm-shepherd-service)
* gnu/services/base.scm (greetd-shepherd-services): Add PAM requirement.

* gnu/system/pam.scm (/etc-entry, extend-configuration,
pam-root-service-type, pam-root-service)
* gnu/services/authentication.scm (pam-ldap-pam-service)
* gnu/services/base.scm (pam-limits-service-type)
(greetd-pam-service)
* gnu/services/desktop.scm (pam-gnome-keyring)
* gnu/services/kerberos.scm (pam-krb5-pam-service)
* gnu/services/pam-mount.scm (pam-mount-pam-service): Adapt to use
pam-extension.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/authentication.scm28
-rw-r--r--gnu/services/base.scm54
-rw-r--r--gnu/services/desktop.scm44
-rw-r--r--gnu/services/kerberos.scm44
-rw-r--r--gnu/services/lightdm.scm2
-rw-r--r--gnu/services/mail.scm4
-rw-r--r--gnu/services/pam-mount.scm23
-rw-r--r--gnu/services/sddm.scm2
-rw-r--r--gnu/services/ssh.scm10
-rw-r--r--gnu/services/xorg.scm4
10 files changed, 116 insertions, 99 deletions
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index f7becdfafb..f1ad1b1afe 100644
--- a/gnu/services/authentication.scm
+++ b/gnu/services/authentication.scm
@@ -506,19 +506,21 @@ password.")
   (define pam-ldap-module
     #~(string-append #$(nslcd-configuration-nss-pam-ldapd config)
                      "/lib/security/pam_ldap.so"))
-  (lambda (pam)
-    (if (member (pam-service-name pam)
-                (nslcd-configuration-pam-services config))
-        (let ((sufficient
-               (pam-entry
-                (control "sufficient")
-                (module pam-ldap-module))))
-          (pam-service
-           (inherit pam)
-           (auth (cons sufficient (pam-service-auth pam)))
-           (session (cons sufficient (pam-service-session pam)))
-           (account (cons sufficient (pam-service-account pam)))))
-        pam)))
+  (pam-extension
+    (transformer
+     (lambda (pam)
+       (if (member (pam-service-name pam)
+                   (nslcd-configuration-pam-services config))
+           (let ((sufficient
+                  (pam-entry
+                   (control "sufficient")
+                   (module pam-ldap-module))))
+             (pam-service
+              (inherit pam)
+              (auth (cons sufficient (pam-service-auth pam)))
+              (session (cons sufficient (pam-service-session pam)))
+              (account (cons sufficient (pam-service-account pam)))))
+           pam)))))
 
 (define (pam-ldap-pam-services config)
   (list (pam-ldap-pam-service config)))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index a4005fc4fd..fdc2c8c764 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1603,20 +1603,22 @@ information on the configuration file syntax."
 
 (define pam-limits-service-type
   (let ((pam-extension
-         (lambda (pam)
-           (let ((pam-limits (pam-entry
-                              (control "required")
-                              (module "pam_limits.so")
-                              (arguments
-                               '("conf=/etc/security/limits.conf")))))
-             (if (member (pam-service-name pam)
-                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"
-                           "sudo" "sshd"))
-                 (pam-service
-                  (inherit pam)
-                  (session (cons pam-limits
-                                 (pam-service-session pam))))
-                 pam))))
+         (pam-extension
+          (transformer
+           (lambda (pam)
+             (let ((pam-limits (pam-entry
+                                (control "required")
+                                (module "pam_limits.so")
+                                (arguments
+                                 '("conf=/etc/security/limits.conf")))))
+               (if (member (pam-service-name pam)
+                           '("login" "greetd" "su" "slim" "gdm-password"
+                             "sddm" "sudo" "sshd"))
+                   (pam-service
+                    (inherit pam)
+                    (session (cons pam-limits
+                                   (pam-service-session pam))))
+                   pam))))))
 
         ;; XXX: Using file-like objects is deprecated, use lists instead.
         ;;      This is to be reduced into the list? case when the deprecated
@@ -3264,16 +3266,18 @@ to handle."
                      (greetd-allow-empty-passwords? config)
                      #:motd
                      (greetd-motd config))
-   (lambda (pam)
-     (if (member (pam-service-name pam)
-                 '("login" "greetd" "su" "slim" "gdm-password"))
-         (pam-service
-          (inherit pam)
-          (auth (append (pam-service-auth pam)
-                        (list optional-pam-mount)))
-          (session (append (pam-service-session pam)
-                           (list optional-pam-mount))))
-         pam))))
+   (pam-extension
+    (transformer
+     (lambda (pam)
+       (if (member (pam-service-name pam)
+                   '("login" "greetd" "su" "slim" "gdm-password"))
+           (pam-service
+            (inherit pam)
+            (auth (append (pam-service-auth pam)
+                          (list optional-pam-mount)))
+            (session (append (pam-service-session pam)
+                             (list optional-pam-mount))))
+           pam))))))
 
 (define (greetd-shepherd-services config)
   (map
@@ -3285,7 +3289,7 @@ to handle."
           (greetd-vt (greetd-terminal-vt tc)))
        (shepherd-service
         (documentation "Minimal and flexible login manager daemon")
-        (requirement '(user-processes host-name udev virtual-terminal))
+        (requirement '(pam user-processes host-name udev virtual-terminal))
         (provision (list (symbol-append
                           'term-tty
                           (string->symbol (greetd-terminal-vt tc)))))
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index adea5b38dd..6b1b21cf80 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1187,10 +1187,12 @@ seats.)"
      (module (file-append (elogind-package config)
                           "/lib/security/pam_elogind.so"))))
 
-  (list (lambda (pam)
-          (pam-service
-           (inherit pam)
-           (session (cons pam-elogind (pam-service-session pam)))))))
+  (list (pam-extension
+         (transformer
+          (lambda (pam)
+            (pam-service
+             (inherit pam)
+             (session (cons pam-elogind (pam-service-session pam)))))))))
 
 (define (elogind-shepherd-service config)
   "Return a Shepherd service to start elogind according to @var{config}."
@@ -1703,22 +1705,24 @@ dispatches events from it.")))
      (arguments arguments)))
 
   (list
-   (lambda (service)
-     (case (assoc-ref (gnome-keyring-pam-services config)
-                      (pam-service-name service))
-       ((login)
-        (pam-service
-         (inherit service)
-         (auth (append (pam-service-auth service)
-                       (list (%pam-keyring-entry))))
-         (session (append (pam-service-session service)
-                          (list (%pam-keyring-entry "auto_start"))))))
-       ((passwd)
-        (pam-service
-         (inherit service)
-         (password (append (pam-service-password service)
-                           (list (%pam-keyring-entry))))))
-       (else service)))))
+   (pam-extension
+    (transformer
+     (lambda (service)
+       (case (assoc-ref (gnome-keyring-pam-services config)
+                        (pam-service-name service))
+         ((login)
+          (pam-service
+           (inherit service)
+           (auth (append (pam-service-auth service)
+                         (list (%pam-keyring-entry))))
+           (session (append (pam-service-session service)
+                            (list (%pam-keyring-entry "auto_start"))))))
+         ((passwd)
+          (pam-service
+           (inherit service)
+           (password (append (pam-service-password service)
+                             (list (%pam-keyring-entry))))))
+         (else service)))))))
 
 (define gnome-keyring-service-type
   (service-type
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index c3c7872734..1a1b37f890 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -428,27 +428,29 @@ generates such a file.  It does not cause any daemon to be started.")))
 
 (define (pam-krb5-pam-service config)
   "Return a PAM service for Kerberos authentication."
-  (lambda (pam)
-    (define pam-krb5-module
-      #~(string-append #$(pam-krb5-configuration-pam-krb5 config)
-                       "/lib/security/pam_krb5.so"))
-
-    (let ((pam-krb5-sufficient
-           (pam-entry
-            (control "sufficient")
-            (module pam-krb5-module)
-            (arguments
-             (list
-              (format #f "minimum_uid=~a"
-                      (pam-krb5-configuration-minimum-uid config)))))))
-      (pam-service
-       (inherit pam)
-       (auth (cons* pam-krb5-sufficient
-                    (pam-service-auth pam)))
-       (session (cons* pam-krb5-sufficient
-                       (pam-service-session pam)))
-       (account (cons* pam-krb5-sufficient
-                       (pam-service-account pam)))))))
+  (pam-extension
+   (transformer
+    (lambda (pam)
+      (define pam-krb5-module
+        #~(string-append #$(pam-krb5-configuration-pam-krb5 config)
+                         "/lib/security/pam_krb5.so"))
+
+      (let ((pam-krb5-sufficient
+             (pam-entry
+              (control "sufficient")
+              (module pam-krb5-module)
+              (arguments
+               (list
+                (format #f "minimum_uid=~a"
+                        (pam-krb5-configuration-minimum-uid config)))))))
+        (pam-service
+         (inherit pam)
+         (auth (cons* pam-krb5-sufficient
+                      (pam-service-auth pam)))
+         (session (cons* pam-krb5-sufficient
+                         (pam-service-session pam)))
+         (account (cons* pam-krb5-sufficient
+                         (pam-service-account pam)))))))))
 
 (define (pam-krb5-pam-services config)
   (list (pam-krb5-pam-service config)))
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 0b9094cda1..b966f402d6 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -616,7 +616,7 @@ port=" (number->string vnc-server-port) "\n"
   (list
    (shepherd-service
     (documentation "LightDM display manager")
-    (requirement '(dbus-system user-processes host-name))
+    (requirement '(pam dbus-system user-processes host-name))
     (provision '(lightdm display-manager xorg-server))
     (respawn? #f)
     (start
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index bf4948dcfb..12dcc8e71d 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1578,7 +1578,7 @@ greyed out, instead of only later giving \"not selectable\" popup error.
     (list (shepherd-service
            (documentation "Run the Dovecot POP3/IMAP mail server.")
            (provision '(dovecot))
-           (requirement '(networking))
+           (requirement '(pam networking))
            (start #~(make-forkexec-constructor
                      (list (string-append #$dovecot "/sbin/dovecot")
                            "-F")))
@@ -1676,7 +1676,7 @@ match from local for any action outbound
                        (package config-file shepherd-requirement)
     (list (shepherd-service
            (provision '(smtpd))
-           (requirement `(loopback ,@shepherd-requirement))
+           (requirement `(pam loopback ,@shepherd-requirement))
            (documentation "Run the OpenSMTPD daemon.")
            (start (let ((smtpd (file-append package "/sbin/smtpd")))
                     #~(make-forkexec-constructor
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index e60781d05b..21c34ddd61 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -88,16 +88,19 @@
     (pam-entry
      (control "optional")
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
-  (list (lambda (pam)
-          (if (member (pam-service-name pam)
-                      '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
-              (pam-service
-               (inherit pam)
-               (auth (append (pam-service-auth pam)
-                             (list optional-pam-mount)))
-               (session (append (pam-service-session pam)
-                                (list optional-pam-mount))))
-              pam))))
+  (list
+   (pam-extension
+    (transformer
+     (lambda (pam)
+       (if (member (pam-service-name pam)
+                   '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
+           (pam-service
+            (inherit pam)
+            (auth (append (pam-service-auth pam)
+                          (list optional-pam-mount)))
+            (session (append (pam-service-session pam)
+                             (list optional-pam-mount))))
+           pam))))))
 
 (define pam-mount-service-type
   (service-type
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index 9e02f1cc81..c9a7ba96f4 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -169,7 +169,7 @@ Relogin="              (if (sddm-configuration-relogin? config)
 
   (list (shepherd-service
          (documentation "SDDM display manager.")
-         (requirement '(user-processes elogind))
+         (requirement '(user-processes elogind pam))
          (provision '(xorg-server display-manager))
          (start #~(make-forkexec-constructor #$sddm-command))
          (stop #~(make-kill-destructor)))))
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index b76544c1a8..de5afdaa1a 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -197,9 +197,11 @@
                      interfaces)))))
 
   (define requires
-    (if (and daemonic? (lsh-configuration-syslog-output? config))
-        '(networking syslogd)
-        '(networking)))
+    `(networking
+      pam
+      ,@(if (and daemonic? (lsh-configuration-syslog-output? config))
+            '(syslogd)
+            '())))
 
   (list (shepherd-service
          (documentation "GNU lsh SSH server")
@@ -566,7 +568,7 @@ of user-name/file-like tuples."
 
   (list (shepherd-service
          (documentation "OpenSSH server.")
-         (requirement '(syslogd loopback))
+         (requirement '(pam syslogd loopback))
          (provision '(ssh-daemon ssh sshd))
 
          (start #~(if #$inetd-style?
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 7295a45b59..8b6080fd26 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -667,7 +667,7 @@ reboot_cmd " shepherd "/sbin/reboot\n"
 
                        (list (symbol-append 'xorg-server-
                                             (string->symbol vt)))))
-           (requirement '(user-processes host-name udev))
+           (requirement '(pam user-processes host-name udev))
            (start
             #~(lambda ()
                 ;; A stale lock file can prevent SLiM from starting, so remove it to
@@ -1119,7 +1119,7 @@ argument.")))
   (list (shepherd-service
          (documentation "Xorg display server (GDM)")
          (provision '(xorg-server))
-         (requirement '(dbus-system user-processes host-name udev elogind))
+         (requirement '(dbus-system pam user-processes host-name udev elogind))
          (start #~(lambda ()
                     (fork+exec-command
                      (list #$(file-append (gdm-configuration-gdm config)