[bug#62357] [PATCH] services: base: add pam-mount-volume support for greetd

[Brian Cully]

This patch lets users create mounts automatically on login with the greetd
service by adding `pam-mount-volume' records via the `extra-pam-mount-volumes'
field of `greetd-configuration'.

The existing rules for XDG_RUNTIME_DIR have been migrated to
`%base-pam-mount-volumes' and are installed by default.

* gnu/services/base.scm (<pam-mount-volume>): new record
(pam-mount-volume->sxml): new procedure
(%base-pam-mount-volumes): new variable
(greetd-pam-mount-rules): new function
(%greetd-pam-mount-rules): removed variable
(<greetd-configuration>): new field `extra-pam-mount-volumes'
---
 gnu/services/base.scm | 114 +++++++++++++++++++++++++++++++++++++++---
 1 file changed, 107 insertions(+), 7 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 2c984a0747..4da2090141 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -248,6 +248,27 @@ (define-module (gnu services base)
             pam-limits-service-type
             pam-limits-service
 
+            pam-mount-volume
+            pam-mount-volume-user
+            pam-mount-volume-uid
+            pam-mount-volume-pgrp
+            pam-mount-volume-gid
+            pam-mount-volume-sgrp
+            pam-mount-volume-fstype
+            pam-mount-volume-noroot
+            pam-mount-volume-server
+            pam-mount-volume-path
+            pam-mount-volume-path
+            pam-mount-volume-mountpoint
+            pam-mount-volume-header
+            pam-mount-volume-options
+            pam-mount-volume-ssh
+            pam-mount-volume-cipher
+            pam-mount-volume-fskeycipher
+            pam-mount-volume-fskeyhash
+            pam-mount-volume-fskeypath
+            %base-pam-mount-volumes
+
             greetd-service-type
             greetd-configuration
             greetd-terminal-configuration
@@ -3170,6 +3191,82 @@ (define (make-greetd-terminal-configuration-file config)
      "user = " default-session-user "\n"
      "command = " default-session-command "\n")))
 
+(define-record-type* <pam-mount-volume>
+  pam-mount-volume make-pam-mount-volume
+  pam-mount-volume?
+  (user pam-mount-volume-user (default #f)) ; string
+  (uid pam-mount-volume-uid (default #f)) ; number or (number . number)
+  (pgrp pam-mount-volume-pgrp (default #f)) ; string
+  (gid pam-mount-volume-gid (default #f)) ; number or (number . number)
+  (sgrp pam-mount-volume-sgrp (default #f)) ; string
+  (fstype pam-mount-volume-fstype (default #f)) ; string
+  (noroot pam-mount-volume-noroot (default #f)) ; bool
+  (server pam-mount-volume-server (default #f)) ; string
+  (path pam-mount-volume-path (default #f)) ; string
+  (mountpoint pam-mount-volume-mountpoint (default #f)) ; string
+  (header pam-mount-volume-header (default #f)) ; string
+  (options pam-mount-volume-options (default #f)) ; string
+  (ssh pam-mount-volume-ssh (default #f)) ; bool
+  (cipher pam-mount-volume-cipher (default #f)) ; string
+  (fskeycipher pam-mount-volume-fskeycipher (default #f)) ; string
+  (fskeyhash pam-mount-volume-fskeyhash (default #f)) ; string
+  (fskeypath pam-mount-volume-fskeypath (default #f))) ; string
+
+(define (pam-mount-volume->sxml volume)
+  "Return SXML formatted VOLUME, suitable for pam_mount configuration."
+  (define (string-for value)
+    (and value (format #f "~a" value)))
+
+  (define (bool-for value)
+    (if value
+        "1"
+        "0"))
+
+  (define (number-or-range-for value)
+    (match value
+      (#f #f)
+      ((start . end)
+       (format #f "~a-~a" start end))
+      (number
+       (format #f "~a" number))))
+
+  (define attrs
+    (filter
+     (cut cadr <>)
+     (map (lambda (field-desc)
+            (let* ((field-name (car field-desc))
+                   (field-formatter (cdr field-desc))
+                   (field-accessor (record-accessor <pam-mount-volume> 
field-name)))
+              (list field-name (field-formatter (field-accessor volume)))))
+          `((user . ,string-for)
+            (uid . ,number-or-range-for)
+            (pgrp . ,string-for)
+            (gid . ,number-or-range-for)
+            (sgrp . ,string-for)
+            (fstype . ,string-for)
+            (noroot . ,bool-for)
+            (server . ,string-for)
+            (path . ,string-for)
+            (mountpoint . ,string-for)
+            (header . ,string-for)
+            (options . ,string-for)
+            (ssh . ,bool-for)
+            (cipher . ,string-for)
+            (fskeycipher . ,string-for)
+            (fskeyhash . ,string-for)
+            (fskeypath . ,string-for)))))
+
+  `(volume (@ ,@attrs)))
+
+(define %base-pam-mount-volumes
+  (list
+   (pam-mount-volume->sxml
+    (pam-mount-volume
+     (sgrp "users")
+     (fstype "tmpfs")
+     (mountpoint "/run/user/%(USERUID)")
+     (options 
"noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))))
+
 (define %greetd-file-systems
   (list (file-system
           (device "none")
@@ -3180,12 +3277,14 @@ (define %greetd-file-systems
           (options "mode=0755")
           (create-mount-point? #t))))
 
-(define %greetd-pam-mount-rules
+(define (greetd-pam-mount-rules config)
+  (define volumes
+    (append (map pam-mount-volume->sxml
+                 (greetd-extra-pam-mount-volumes config))
+            %base-pam-mount-volumes))
+
   `((debug (@ (enable "0")))
-    (volume (@ (sgrp "users")
-               (fstype "tmpfs")
-               (mountpoint "/run/user/%(USERUID)")
-               (options 
"noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    ,@volumes
     (logout (@ (wait "0")
                (hup "0")
                (term "yes")
@@ -3198,7 +3297,8 @@ (define-record-type* <greetd-configuration>
   (motd greetd-motd (default %default-motd))
   (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
   (terminals greetd-terminals (default '()))
-  (greeter-supplementary-groups greetd-greeter-supplementary-groups (default 
'())))
+  (greeter-supplementary-groups greetd-greeter-supplementary-groups (default 
'()))
+  (extra-pam-mount-volumes greetd-extra-pam-mount-volumes (default '())))
 
 (define (greetd-accounts config)
   (list (user-group (name "greeter") (system? #t))
@@ -3219,7 +3319,7 @@ (define (make-greetd-pam-mount-conf-file config)
             '(*TOP*
               (*PI* xml "version='1.0' encoding='utf-8'")
               (pam_mount
-               #$@%greetd-pam-mount-rules
+               #$@(greetd-pam-mount-rules config)
                (pmvarrun
                 #$(file-append greetd-pam-mount
                                "/sbin/pmvarrun -u '%(USER)' -o 
'%(OPERATION)'"))))

base-commit: 306bd7b8b952b1e721fd36a9d69b3373862e8087
-- 
2.39.2