GNU bug report logs - #63314
[PATCH 0/2] Add PAM shepherd requirements

Previous Next

Package: guix-patches;

Reported by: Josselin Poiret <dev <at> jpoiret.xyz>

Date: Fri, 5 May 2023 17:51:01 UTC

Severity: normal

Tags: patch

Done: Ludovic Courtès <ludo <at> gnu.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 63314 in the body.
You can then email your comments to 63314 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Fri, 05 May 2023 17:51:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Josselin Poiret <dev <at> jpoiret.xyz>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Fri, 05 May 2023 17:51:01 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Josselin Poiret <dev <at> jpoiret.xyz>
To: guix-patches <at> gnu.org
Cc: Josselin Poiret <dev <at> jpoiret.xyz>
Subject: [PATCH 0/2] Add PAM shepherd requirements
Date: Fri,  5 May 2023 19:50:46 +0200
Hi everyone,

With shepherd 0.10 incoming, I've been running into a nasty issue: I use
elogind and greetd, and greetd, when starting needs to let its greeter log-in
through PAM.  However, its PAM entry requires pam_elogind.so, which might not
work if elogind isn't started yet, and so my greetd would just fail to start.
This patch adds a shepherd synchronization point for services needed by PAM,
and any PAM-using program should have the synchronization point as a
requirement.  I've mostly tested this with greetd only, so I would appreciate
if other PAM users could try it out.

Best,

Josselin Poiret (2):
  system: pam: Let PAM extenders add shepherd requirements.
  services: elogind: Add elogind as a shepherd PAM requirement.

 gnu/services/authentication.scm | 28 +++++++++--------
 gnu/services/base.scm           | 54 +++++++++++++++++---------------
 gnu/services/desktop.scm        | 45 +++++++++++++++------------
 gnu/services/kerberos.scm       | 44 +++++++++++++-------------
 gnu/services/lightdm.scm        |  2 +-
 gnu/services/mail.scm           |  4 +--
 gnu/services/pam-mount.scm      | 23 ++++++++------
 gnu/services/sddm.scm           |  2 +-
 gnu/services/ssh.scm            | 10 +++---
 gnu/services/xorg.scm           |  4 +--
 gnu/system/pam.scm              | 55 ++++++++++++++++++++++++++-------
 11 files changed, 161 insertions(+), 110 deletions(-)


base-commit: 6922069bcbe5c08da09c00e5aad44e390ebd1cc7
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Fri, 05 May 2023 17:52:02 GMT) Full text and rfc822 format available.

Message #8 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Josselin Poiret <dev <at> jpoiret.xyz>
To: 63314 <at> debbugs.gnu.org
Cc: Josselin Poiret <dev <at> jpoiret.xyz>
Subject: [PATCH 1/2] system: pam: Let PAM extenders add shepherd requirements.
Date: Fri,  5 May 2023 19:51:48 +0200
From: Josselin Poiret <dev <at> jpoiret.xyz>

* gnu/system/pam.scm (<pam-extender>): 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 pam-extenders.
---
 gnu/services/authentication.scm | 28 +++++++++--------
 gnu/services/base.scm           | 54 +++++++++++++++++---------------
 gnu/services/desktop.scm        | 44 ++++++++++++++------------
 gnu/services/kerberos.scm       | 44 +++++++++++++-------------
 gnu/services/lightdm.scm        |  2 +-
 gnu/services/mail.scm           |  4 +--
 gnu/services/pam-mount.scm      | 23 ++++++++------
 gnu/services/sddm.scm           |  2 +-
 gnu/services/ssh.scm            | 10 +++---
 gnu/services/xorg.scm           |  4 +--
 gnu/system/pam.scm              | 55 ++++++++++++++++++++++++++-------
 11 files changed, 160 insertions(+), 110 deletions(-)

diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index f7becdfafb..5ec7634789 100644
--- a/gnu/services/authentication.scm
+++ b/gnu/services/authentication.scm
@@ -506,19 +506,21 @@ (define (pam-ldap-pam-service config)
   (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-extender
+    (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 4adb551796..eaf5030935 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1608,20 +1608,22 @@ (define-deprecated (syslog-service #:optional (config (syslog-configuration)))
 
 (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-extender
+          (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
@@ -3269,16 +3271,18 @@ (define (greetd-pam-service config)
                      (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-extender
+    (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
@@ -3290,7 +3294,7 @@ (define (greetd-shepherd-services config)
           (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..3adcfe8e5d 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1187,10 +1187,12 @@ (define (pam-extension-procedure config)
      (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-extender
+         (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 @@ (define (pam-gnome-keyring config)
      (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-extender
+    (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..0ae7c127d1 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -428,27 +428,29 @@ (define-record-type* <pam-krb5-configuration>
 
 (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-extender
+   (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 @@ (define (lightdm-shepherd-service config)
   (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 @@ (define (dovecot-shepherd-service config)
     (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 @@ (define (opensmtpd-shepherd-service config)
                        (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..3e6667af9c 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -88,16 +88,19 @@ (define (pam-mount-pam-service config)
     (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-extender
+    (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 @@ (define (sddm-shepherd-service 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 @@ (define (lsh-shepherd-service config)
                      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 @@ (define (openssh-shepherd-service config)
 
   (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 @@ (define (slim-shepherd-service config)
 
                        (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 @@ (define (gdm-shepherd-service config)
   (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)
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index b635681642..6d9a7484c3 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -21,6 +21,7 @@ (define-module (gnu system pam)
   #:use-module (guix derivations)
   #:use-module (guix gexp)
   #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
   #:use-module (gnu system setuid)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -55,6 +56,10 @@ (define-module (gnu system pam)
             session-environment-service
             session-environment-service-type
 
+            pam-extender
+            pam-extender-transformer
+            pam-extender-shepherd-requirements
+
             pam-root-service-type
             pam-root-service))
 
@@ -347,32 +352,58 @@ (define (session-environment-service vars)
 ;;; PAM root service.
 ;;;
 
+;; A PAM transformer consists of a procedure acting on each PAM entry, with an
+;; additional list of shepherd-requirements that the meta PAM sheherd service
+;; will rely on.
+(define-record-type* <pam-extender>
+  pam-extender make-pam-extender pam-extender?
+  (transformer pam-extender-transformer)
+  (shepherd-requirements pam-extender-shepherd-requirements
+                         (default '())))
+
 ;; Overall PAM configuration: a list of services, plus a procedure that takes
 ;; one <pam-service> and returns a <pam-service>.  The procedure is used to
 ;; implement cross-cutting concerns such as the use of the 'elogind.so'
 ;; session module that keeps track of logged-in users.
 (define-record-type* <pam-configuration>
-  pam-configuration make-pam-configuration? pam-configuration?
+  pam-configuration make-pam-configuration pam-configuration?
   (services  pam-configuration-services)          ;list of <pam-service>
-  (transform pam-configuration-transform))        ;procedure
+  (extenders pam-configuration-extenders))        ;list of <pam-extender>
 
 (define (/etc-entry config)
   "Return the /etc/pam.d entry corresponding to CONFIG."
   (match config
-    (($ <pam-configuration> services transform)
-     (let ((services (map transform services)))
+    (($ <pam-configuration> services extenders)
+     (let ((services
+            (map
+             ;; XXX We need to add identity because compose expects at least
+             ;; one argument for some reason.
+             (apply compose (cons identity (map pam-extender-transformer extenders)))
+             services)))
        `(("pam.d" ,(pam-services->directory services)))))))
 
+(define (pam-shepherd-service config)
+  (define requirements
+    (match config
+      (($ <pam-configuration> services extenders)
+       (concatenate (map pam-extender-shepherd-requirements extenders)))))
+  (list (shepherd-service
+         (documentation "Synchronization point for services that need to be
+started for PAM to work.")
+         (provision '(pam))
+         (requirement requirements)
+         (start #~(const #t))
+         (stop #~(const #t)))))
+
 (define (extend-configuration initial extensions)
   "Extend INITIAL with NEW."
-  (let-values (((services procs)
+  (let-values (((services extenders)
                 (partition pam-service? extensions)))
     (pam-configuration
      (services (append (pam-configuration-services initial)
                        services))
-     (transform (apply compose
-                       (pam-configuration-transform initial)
-                       procs)))))
+     (extenders (append (pam-configuration-extenders initial)
+                        extenders)))))
 
 (define pam-root-service-type
   (service-type (name 'pam)
@@ -382,7 +413,9 @@ (define pam-root-service-type
                         (lambda (_)
                           (list (file-like->setuid-program
                                  (file-append linux-pam "/sbin/unix_chkpwd")))))
-                       (service-extension etc-service-type /etc-entry)))
+                       (service-extension etc-service-type /etc-entry)
+                       (service-extension shepherd-root-service-type
+                                          pam-shepherd-service)))
 
                 ;; Arguments include <pam-service> as well as procedures.
                 (compose concatenate)
@@ -394,7 +427,7 @@ (define pam-root-service-type
 program may authenticate users or what it should do when opening a new
 session.")))
 
-(define* (pam-root-service base #:key (transform identity))
+(define* (pam-root-service base #:key (extenders '()))
   "The \"root\" PAM service, which collects <pam-service> instance and turns
 them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
 TRANSFORM is a procedure that takes a <pam-service> and returns a
@@ -402,6 +435,6 @@ (define* (pam-root-service base #:key (transform identity))
 all the PAM services."
   (service pam-root-service-type
            (pam-configuration (services base)
-                              (transform transform))))
+                              (extenders extenders))))
 
 
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Fri, 05 May 2023 17:52:02 GMT) Full text and rfc822 format available.

Message #11 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Josselin Poiret <dev <at> jpoiret.xyz>
To: 63314 <at> debbugs.gnu.org
Cc: Josselin Poiret <dev <at> jpoiret.xyz>
Subject: [PATCH 2/2] services: elogind: Add elogind as a shepherd PAM
 requirement.
Date: Fri,  5 May 2023 19:51:49 +0200
From: Josselin Poiret <dev <at> jpoiret.xyz>

* gnu/services/desktop.scm (pam-extension-procedure): Add the elogind shepherd
requirement to the PAM extender.
---
 gnu/services/desktop.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 3adcfe8e5d..d62536a27e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1192,7 +1192,8 @@ (define (pam-extension-procedure config)
           (lambda (pam)
             (pam-service
              (inherit pam)
-             (session (cons pam-elogind (pam-service-session pam)))))))))
+             (session (cons pam-elogind (pam-service-session pam))))))
+         (shepherd-requirements '(elogind)))))
 
 (define (elogind-shepherd-service config)
   "Return a Shepherd service to start elogind according to @var{config}."
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Mon, 08 May 2023 09:46:01 GMT) Full text and rfc822 format available.

Message #14 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314 <at> debbugs.gnu.org
Subject: Re: bug#63314: [PATCH 0/2] Add PAM shepherd requirements
Date: Mon, 08 May 2023 11:45:05 +0200
Hello!

Josselin Poiret <dev <at> jpoiret.xyz> skribis:

> From: Josselin Poiret <dev <at> jpoiret.xyz>
>
> * gnu/system/pam.scm (<pam-extender>): 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 pam-extenders.

The approach looks reasonable to me, well done!

> +;; A PAM transformer consists of a procedure acting on each PAM entry, with an
> +;; additional list of shepherd-requirements that the meta PAM sheherd service
> +;; will rely on.
> +(define-record-type* <pam-extender>
> +  pam-extender make-pam-extender pam-extender?
> +  (transformer pam-extender-transformer)
> +  (shepherd-requirements pam-extender-shepherd-requirements
> +                         (default '())))

I would call it <pam-extension> (similar to <home-bash-extension>).
There’s a typo in the comment (“sheherd”); s/rely on/depend on/.

>  ;; Overall PAM configuration: a list of services, plus a procedure that takes
>  ;; one <pam-service> and returns a <pam-service>.  The procedure is used to
>  ;; implement cross-cutting concerns such as the use of the 'elogind.so'
>  ;; session module that keeps track of logged-in users.
>  (define-record-type* <pam-configuration>
> -  pam-configuration make-pam-configuration? pam-configuration?
> +  pam-configuration make-pam-configuration pam-configuration?
>    (services  pam-configuration-services)          ;list of <pam-service>
> -  (transform pam-configuration-transform))        ;procedure
> +  (extenders pam-configuration-extenders))        ;list of <pam-extender>

Instead of storing extensions, we should keep the full configuration
here (similar to <home-bash-configuration>).  That is, remove
‘extenders’ and instead add ‘shepherd-requirements’.

> +(define (pam-shepherd-service config)
> +  (define requirements
> +    (match config
> +      (($ <pam-configuration> services extenders)
> +       (concatenate (map pam-extender-shepherd-requirements extenders)))))

Rather: (append-map …)

Also please add a docstring.

>  (define (extend-configuration initial extensions)
>    "Extend INITIAL with NEW."
> -  (let-values (((services procs)
> +  (let-values (((services extenders)
>                  (partition pam-service? extensions)))
>      (pam-configuration
>       (services (append (pam-configuration-services initial)
>                         services))
> -     (transform (apply compose
> -                       (pam-configuration-transform initial)
> -                       procs)))))
> +     (extenders (append (pam-configuration-extenders initial)
> +                        extenders)))))

This would need to be adjusted accordingly.

Also, we need to preserve backward compatibility, so we should first do
something like:

  (let ((extensions (map (lambda (extension)
                           (if (pam-extension? extension)
                               extension
                               (begin
                                 (warn-about-deprecation …)
                                 (pam-extension (transformer extension)))))
                         extensions)))
   …)                         

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Mon, 08 May 2023 09:47:02 GMT) Full text and rfc822 format available.

Message #17 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314 <at> debbugs.gnu.org
Subject: Re: bug#63314: [PATCH 0/2] Add PAM shepherd requirements
Date: Mon, 08 May 2023 11:46:14 +0200
Josselin Poiret <dev <at> jpoiret.xyz> skribis:

> From: Josselin Poiret <dev <at> jpoiret.xyz>
>
> * gnu/services/desktop.scm (pam-extension-procedure): Add the elogind shepherd
> requirement to the PAM extender.
> ---
>  gnu/services/desktop.scm | 3 ++-
>  1 file changed, 2 insertions(+), 1 deletion(-)
>
> diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
> index 3adcfe8e5d..d62536a27e 100644
> --- a/gnu/services/desktop.scm
> +++ b/gnu/services/desktop.scm
> @@ -1192,7 +1192,8 @@ (define (pam-extension-procedure config)
>            (lambda (pam)
>              (pam-service
>               (inherit pam)
> -             (session (cons pam-elogind (pam-service-session pam)))))))))
> +             (session (cons pam-elogind (pam-service-session pam))))))
> +         (shepherd-requirements '(elogind)))))

LGTM.

Should we add a greetd system test that catches the bug?

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Tue, 09 May 2023 16:46:01 GMT) Full text and rfc822 format available.

Message #20 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Josselin Poiret <dev <at> jpoiret.xyz>
To: Ludovic Courtès <ludo <at> gnu.org>,
 Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314 <at> debbugs.gnu.org
Subject: [PATCH v2 0/2] Add PAM shepherd requirements
Date: Tue,  9 May 2023 18:45:06 +0200
Hi Ludo,

Thanks for the review.  Here is an updated patchset with the changes you
requested.  I don't think it's possible to have a reliable system test to
check for the greetd issue, since it is a race problem in the end.

Best,

Josselin Poiret (2):
  system: pam: Let PAM extensions add shepherd requirements.
  services: elogind: Add elogind as a shepherd PAM requirement.

 gnu/services/authentication.scm | 28 ++++++------
 gnu/services/base.scm           | 54 +++++++++++-----------
 gnu/services/desktop.scm        | 45 ++++++++++---------
 gnu/services/kerberos.scm       | 44 +++++++++---------
 gnu/services/lightdm.scm        |  2 +-
 gnu/services/mail.scm           |  4 +-
 gnu/services/pam-mount.scm      | 23 +++++-----
 gnu/services/sddm.scm           |  2 +-
 gnu/services/ssh.scm            | 10 +++--
 gnu/services/xorg.scm           |  4 +-
 gnu/system/pam.scm              | 80 +++++++++++++++++++++++++++------
 11 files changed, 184 insertions(+), 112 deletions(-)


base-commit: a759cbffafbf67b3a03c80b5bdbe3f3478affc50
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Tue, 09 May 2023 16:46:02 GMT) Full text and rfc822 format available.

Message #23 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Josselin Poiret <dev <at> jpoiret.xyz>
To: Ludovic Courtès <ludo <at> gnu.org>,
 Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314 <at> debbugs.gnu.org
Subject: [PATCH v2 2/2] services: elogind: Add elogind as a shepherd PAM
 requirement.
Date: Tue,  9 May 2023 18:45:08 +0200
From: Josselin Poiret <dev <at> jpoiret.xyz>

* gnu/services/desktop.scm (pam-extension-procedure): Add the elogind shepherd
requirement to the PAM extension.
---
 gnu/services/desktop.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 6b1b21cf80..64eac1117d 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1192,7 +1192,8 @@ (define (pam-extension-procedure config)
           (lambda (pam)
             (pam-service
              (inherit pam)
-             (session (cons pam-elogind (pam-service-session pam)))))))))
+             (session (cons pam-elogind (pam-service-session pam))))))
+         (shepherd-requirements '(elogind)))))
 
 (define (elogind-shepherd-service config)
   "Return a Shepherd service to start elogind according to @var{config}."
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Tue, 09 May 2023 16:46:02 GMT) Full text and rfc822 format available.

Message #26 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Josselin Poiret <dev <at> jpoiret.xyz>
To: Ludovic Courtès <ludo <at> gnu.org>,
 Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314 <at> debbugs.gnu.org
Subject: [PATCH v2 1/2] system: pam: Let PAM extensions add shepherd
 requirements.
Date: Tue,  9 May 2023 18:45:07 +0200
From: Josselin Poiret <dev <at> jpoiret.xyz>

* 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.
---
 gnu/services/authentication.scm | 28 ++++++------
 gnu/services/base.scm           | 54 +++++++++++-----------
 gnu/services/desktop.scm        | 44 +++++++++---------
 gnu/services/kerberos.scm       | 44 +++++++++---------
 gnu/services/lightdm.scm        |  2 +-
 gnu/services/mail.scm           |  4 +-
 gnu/services/pam-mount.scm      | 23 +++++-----
 gnu/services/sddm.scm           |  2 +-
 gnu/services/ssh.scm            | 10 +++--
 gnu/services/xorg.scm           |  4 +-
 gnu/system/pam.scm              | 80 +++++++++++++++++++++++++++------
 11 files changed, 183 insertions(+), 112 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 @@ (define (pam-ldap-pam-service config)
   (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 4adb551796..a69e99343b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1608,20 +1608,22 @@ (define-deprecated (syslog-service #:optional (config (syslog-configuration)))
 
 (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
@@ -3269,16 +3271,18 @@ (define (greetd-pam-service config)
                      (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
@@ -3290,7 +3294,7 @@ (define (greetd-shepherd-services config)
           (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 @@ (define (pam-extension-procedure config)
      (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 @@ (define (pam-gnome-keyring config)
      (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 @@ (define-record-type* <pam-krb5-configuration>
 
 (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 @@ (define (lightdm-shepherd-service config)
   (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 @@ (define (dovecot-shepherd-service config)
     (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 @@ (define (opensmtpd-shepherd-service config)
                        (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 @@ (define (pam-mount-pam-service config)
     (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 @@ (define (sddm-shepherd-service 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 @@ (define (lsh-shepherd-service config)
                      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 @@ (define (openssh-shepherd-service config)
 
   (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 @@ (define (slim-shepherd-service config)
 
                        (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 @@ (define (gdm-shepherd-service config)
   (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)
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index b635681642..f624064999 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -19,8 +19,11 @@
 (define-module (gnu system pam)
   #:use-module (guix records)
   #:use-module (guix derivations)
+  #:use-module (guix diagnostics)
   #:use-module (guix gexp)
+  #:use-module (guix i18n)
   #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
   #:use-module (gnu system setuid)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -55,6 +58,10 @@ (define-module (gnu system pam)
             session-environment-service
             session-environment-service-type
 
+            pam-extension
+            pam-extension-transformer
+            pam-extension-shepherd-requirements
+
             pam-root-service-type
             pam-root-service))
 
@@ -347,32 +354,76 @@ (define (session-environment-service vars)
 ;;; PAM root service.
 ;;;
 
+;; A PAM transformer consists of a procedure acting on each PAM entry, with an
+;; additional list of shepherd-requirements that the meta PAM shepherd service
+;; will depend on.
+(define-record-type* <pam-extension>
+  pam-extension make-pam-extension pam-extension?
+  (transformer pam-extension-transformer)
+  (shepherd-requirements pam-extension-shepherd-requirements
+                         (default '())))
+
 ;; Overall PAM configuration: a list of services, plus a procedure that takes
 ;; one <pam-service> and returns a <pam-service>.  The procedure is used to
 ;; implement cross-cutting concerns such as the use of the 'elogind.so'
 ;; session module that keeps track of logged-in users.
 (define-record-type* <pam-configuration>
-  pam-configuration make-pam-configuration? pam-configuration?
-  (services  pam-configuration-services)          ;list of <pam-service>
-  (transform pam-configuration-transform))        ;procedure
+  pam-configuration make-pam-configuration pam-configuration?
+  ;list of <pam-service>
+  (services  pam-configuration-services)
+  ;list of procedures <pam-entry> -> <pam-entry>
+  (transformers pam-configuration-transformers)
+  ;list of symbols
+  (shepherd-requirements pam-configuration-shepherd-requirements))
 
 (define (/etc-entry config)
   "Return the /etc/pam.d entry corresponding to CONFIG."
   (match config
-    (($ <pam-configuration> services transform)
-     (let ((services (map transform services)))
+    (($ <pam-configuration> services transformers shepherd-requirements)
+     (let ((services
+            (map
+             ;; XXX We need to add identity because compose expects at least
+             ;; one argument for some reason.
+             (apply compose (cons identity transformers))
+             services)))
        `(("pam.d" ,(pam-services->directory services)))))))
 
+(define (pam-shepherd-service config)
+  "Return the PAM synchronization shepherd service corresponding to CONFIG."
+  (match config
+    (($ <pam-configuration> services transformers shepherd-requirements)
+     (list (shepherd-service
+            (documentation "Synchronization point for services that need to be
+started for PAM to work.")
+            (provision '(pam))
+            (requirement shepherd-requirements)
+            (start #~(const #t))
+            (stop #~(const #t)))))))
+
 (define (extend-configuration initial extensions)
   "Extend INITIAL with NEW."
-  (let-values (((services procs)
-                (partition pam-service? extensions)))
+  ;; TODO: Remove deprecation shim.
+  (define cleaned-extensions
+    (map
+     (lambda (ext)
+       (cond
+        ((procedure? ext)
+         (begin
+           (warning (G_ "pam-root-service-type transformer extensions should\
+now use the <pam-extension> record."))
+           (pam-extension (transformer ext))))
+        (#t ext)))
+     extensions))
+  (let-values (((services pam-extensions)
+                (partition pam-service? cleaned-extensions)))
     (pam-configuration
      (services (append (pam-configuration-services initial)
                        services))
-     (transform (apply compose
-                       (pam-configuration-transform initial)
-                       procs)))))
+     (transformers (append (pam-configuration-transformers initial)
+                           (map pam-extension-transformer pam-extensions)))
+     (shepherd-requirements
+      (append (pam-configuration-shepherd-requirements initial)
+              (append-map pam-extension-shepherd-requirements pam-extensions))))))
 
 (define pam-root-service-type
   (service-type (name 'pam)
@@ -382,7 +433,9 @@ (define pam-root-service-type
                         (lambda (_)
                           (list (file-like->setuid-program
                                  (file-append linux-pam "/sbin/unix_chkpwd")))))
-                       (service-extension etc-service-type /etc-entry)))
+                       (service-extension etc-service-type /etc-entry)
+                       (service-extension shepherd-root-service-type
+                                          pam-shepherd-service)))
 
                 ;; Arguments include <pam-service> as well as procedures.
                 (compose concatenate)
@@ -394,7 +447,7 @@ (define pam-root-service-type
 program may authenticate users or what it should do when opening a new
 session.")))
 
-(define* (pam-root-service base #:key (transform identity))
+(define* (pam-root-service base #:key (transformers '()) (shepherd-requirements '()))
   "The \"root\" PAM service, which collects <pam-service> instance and turns
 them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
 TRANSFORM is a procedure that takes a <pam-service> and returns a
@@ -402,6 +455,7 @@ (define* (pam-root-service base #:key (transform identity))
 all the PAM services."
   (service pam-root-service-type
            (pam-configuration (services base)
-                              (transform transform))))
+                              (transformers transformers)
+                              (shepherd-requirements shepherd-requirements))))
 
 
-- 
2.39.2





Information forwarded to guix-patches <at> gnu.org:
bug#63314; Package guix-patches. (Thu, 11 May 2023 11:16:02 GMT) Full text and rfc822 format available.

Message #29 received at 63314 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314 <at> debbugs.gnu.org
Subject: Re: [PATCH v2 1/2] system: pam: Let PAM extensions add shepherd
 requirements.
Date: Thu, 11 May 2023 13:15:42 +0200
[Message part 1 (text/plain, inline)]
Hi,

Josselin Poiret <dev <at> jpoiret.xyz> skribis:

> From: Josselin Poiret <dev <at> jpoiret.xyz>
>
> * 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.

Excellent!  I committed with the cosmetic changes below:

[Message part 2 (text/x-patch, inline)]
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index f624064999..adc40c975f 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2023 Josselin Poiret <dev <at> jpoiret.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -354,9 +355,9 @@ (define (session-environment-service vars)
 ;;; PAM root service.
 ;;;
 
-;; A PAM transformer consists of a procedure acting on each PAM entry, with an
-;; additional list of shepherd-requirements that the meta PAM shepherd service
-;; will depend on.
+;; Extension of the PAM configuration.  A PAM transformer consists of a
+;; procedure acting on each PAM entry; 'shepherd-requirements' lists services
+;; that the meta 'pam' Shepherd service will depend on.
 (define-record-type* <pam-extension>
   pam-extension make-pam-extension pam-extension?
   (transformer pam-extension-transformer)
@@ -380,12 +381,8 @@ (define (/etc-entry config)
   "Return the /etc/pam.d entry corresponding to CONFIG."
   (match config
     (($ <pam-configuration> services transformers shepherd-requirements)
-     (let ((services
-            (map
-             ;; XXX We need to add identity because compose expects at least
-             ;; one argument for some reason.
-             (apply compose (cons identity transformers))
-             services)))
+     (let ((services (map (apply compose identity transformers)
+                          services)))
        `(("pam.d" ,(pam-services->directory services)))))))
 
 (define (pam-shepherd-service config)
@@ -404,16 +401,15 @@ (define (extend-configuration initial extensions)
   "Extend INITIAL with NEW."
   ;; TODO: Remove deprecation shim.
   (define cleaned-extensions
-    (map
-     (lambda (ext)
-       (cond
-        ((procedure? ext)
-         (begin
-           (warning (G_ "pam-root-service-type transformer extensions should\
-now use the <pam-extension> record."))
-           (pam-extension (transformer ext))))
-        (#t ext)))
-     extensions))
+    (map (lambda (ext)
+           (if (procedure? ext)
+               (begin
+                 (warning (G_ "'pam-root-service-type' extensions should \
+now use the <pam-extension> record~%"))
+                 (pam-extension (transformer ext)))
+               ext))
+         extensions))
+
   (let-values (((services pam-extensions)
                 (partition pam-service? cleaned-extensions)))
     (pam-configuration
[Message part 3 (text/plain, inline)]
Ludo’.

Reply sent to Ludovic Courtès <ludo <at> gnu.org>:
You have taken responsibility. (Thu, 11 May 2023 11:17:01 GMT) Full text and rfc822 format available.

Notification sent to Josselin Poiret <dev <at> jpoiret.xyz>:
bug acknowledged by developer. (Thu, 11 May 2023 11:17:02 GMT) Full text and rfc822 format available.

Message #34 received at 63314-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Josselin Poiret <dev <at> jpoiret.xyz>
Cc: 63314-done <at> debbugs.gnu.org
Subject: Re: [PATCH v2 2/2] services: elogind: Add elogind as a shepherd PAM
 requirement.
Date: Thu, 11 May 2023 13:16:36 +0200
Josselin Poiret <dev <at> jpoiret.xyz> skribis:

> From: Josselin Poiret <dev <at> jpoiret.xyz>
>
> * gnu/services/desktop.scm (pam-extension-procedure): Add the elogind shepherd
> requirement to the PAM extension.

Applied, thanks!




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Thu, 08 Jun 2023 11:24:05 GMT) Full text and rfc822 format available.

This bug report was last modified 316 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.