[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’.