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

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

[Brian Cully via Guix-patches via]

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

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

[Brian Cully via Guix-patches via]

Brian Cully <bjc@spork.org> writes:

> 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'

I know this patch will need documentation, but I've also assumed 
there'll be some discussion around whether or not this is the best 
way to proceed, so I'm delaying writing it until there's 
consensus.

FWIW, the main use-case of this patch, for me, is auto-mounting 
samba shares from a NAS which requires authentication. By using 
the PAM mount facility, as long as my local and remote credentials 
match, everything happens automatically at login without needing 
to type my password twice, and this lets login scripts use the 
remote services as well.

I'm sure there are countless other ways to use it, but this is 
mine.

It would be nice to have this more generic, since pam-mount isn't 
specifically tied to greetd, but it seems like greetd is the only 
thing in Guix that uses it currently, so that's why that's the 
only hook I've added. I've named the various symbols to express 
that they belong to PAM, generally, or greetd, specifically.

-bjc

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

[Ludovic Courtès]

Hi Brian,

Brian Cully <bjc@spork.org> skribis:

> 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'

I’m not familiar with pam-mount-volume, so this is a somewhat
superficial review, but the risks seem low anyway.

As you note, we’ll need documentation.  It would also be nice to have a
system test because it’s the kind of feature that can be quite central
and it’s annoying when it doesn’t work as advertised.

> +            pam-mount-volume-path
> +            pam-mount-volume-path

Duplicate.

> +(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

The general convention is to avoid abbreviations (so ‘mount-point’,
‘file-system-type’, etc.), unless there’s a good reason not to (for
instance because “fskeypath” is a thing that ‘pam-mount-volume’ experts
are familiar with).  Similarly, “file name” rather than “path”, except
when referring to a search path.

> +  (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)

Please always use ‘match’ (info "(guix) Data Types and Pattern
Matching").

So:

  (define attrs
    (filter-map (match-lambda
                  ((name . formatter)
                   …))
                …))
                  
> +(define %base-pam-mount-volumes
> +  (list
> +   (pam-mount-volume->sxml

Please add a comment below ‘define’ explaining what this is.

> -(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 '())))

Should there be a ‘pam-mount-volume-service-type’ that ‘greetd’ would
extend?  It would seem more natural to me.

Thanks!

Ludo’.

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

[Guillaume Le Vaillant]

[-- Attachment #1: Type: text/plain, Size: 539 bytes --]

Ludovic Courtès <ludo@gnu.org> skribis:

> Hi Brian,
>
> Brian Cully <bjc@spork.org> skribis:
>
>> 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'.
>
> Should there be a ‘pam-mount-volume-service-type’ that ‘greetd’ would
> extend?  It would seem more natural to me.

We already have a pam-mount-service-type (in
"gnu/services/pam-mount.scm"), maybe greetd can use it...

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]

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

[Ludovic Courtès]

Guillaume Le Vaillant <glv@posteo.net> skribis:

> Ludovic Courtès <ludo@gnu.org> skribis:
>
>> Hi Brian,
>>
>> Brian Cully <bjc@spork.org> skribis:
>>
>>> 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'.
>>
>> Should there be a ‘pam-mount-volume-service-type’ that ‘greetd’ would
>> extend?  It would seem more natural to me.
>
> We already have a pam-mount-service-type (in
> "gnu/services/pam-mount.scm"), maybe greetd can use it...

D’oh, indeed, thanks for the heads-up!

Ludo’.

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

[Brian Cully via Guix-patches via]

Ludovic Courtès <ludo@gnu.org> writes:

>> We already have a pam-mount-service-type (in
>> "gnu/services/pam-mount.scm"), maybe greetd can use it...
>
> D’oh, indeed, thanks for the heads-up!

I didn't realize this existed, so thanks. It looks like it has 
some kind of support for greetd already, or at least it's 
referenced. I'm not sure why the current greetd service doesn't 
use it, though.

I'll try to migrate the stuff I did over to the pam-mount service 
and integrate greetd with it directly. In the mean time, I'll 
close this ticket. Thanks for the feedback so far.

-bjc