[bug#65538] [PATCH v2] services: greetd: Add pam-gnupg support.

[bug#65538] [PATCH v2] services: greetd: Add pam-gnupg support.

[guix-patches--- via]

I retry to implement the pam-gnupg module for the greetd system service. It is A PAM module that hands over your login password to gpg-agent. I added de documentation and the insert-before procedure (maybe it needs a better name), to ensure that the pam-gnupg module will be loaded at the end.

* doc/guix.texi: documentation about #:gnupg? option on (greetd-configuration).
* gnu/services.scm (insert-before): new procedure.
* gnu/services/base.scm (greetd-configuration): new option #:gnupg?.
* gnu/services/pam-mount.scm: ensure that pam mount module goes before pam gnupg module.
* gnu/system/pam.scm (pam-gnupg-module?): new procedure and ensure that pam gnupg module is at the end of (unix-pam-service).
---
 doc/guix.texi              |  9 +++++++++
 gnu/services.scm           | 11 ++++++++++-
 gnu/services/base.scm      | 28 ++++++++++++++++++----------
 gnu/services/pam-mount.scm | 14 +++++++++-----
 gnu/system/pam.scm         | 13 ++++++++++---
 5 files changed, 56 insertions(+), 19 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index e8c67b0cd8..1fe38bd971 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -119,6 +119,7 @@ Copyright @copyright{} 2023 Tanguy Le Carrour@*
 Copyright @copyright{} 2023 Zheng Junjie@*
 Copyright @copyright{} 2023 Brian Cully@*
 Copyright @copyright{} 2023 Felix Lechner@*
+Copyright @copyright{} 2023 Carlos Durán Domínguez@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19666,6 +19667,14 @@ A file-like object containing the ``message of the day''.
 Allow empty passwords by default so that first-time users can log in when
 the 'root' account has just been created.
 
+@item @code{gnupg?} (default: @code{#f})
+If enabled, @code{pam-gnupg} will attempt to automatically unlock the
+user's GPG keys with the login password via @code{gpg-agent}.  The
+keygrips of all keys to be unlocked should be written to
+@file{~/.pam-gnupg}, and can be queried with @code{gpg -K
+--with-keygrip}.  Presetting passphrases must be enabled by adding
+@code{allow-preset-passphrase} in @file{~/.gnupg/gpg-agent.conf}.
+
 @item @code{terminals} (default: @code{'()})
 List of @code{greetd-terminal-configuration} per terminal for which
 @code{greetd} should be started.
diff --git a/gnu/services.scm b/gnu/services.scm
index eb9258977e..118b8973ff 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -129,7 +129,8 @@ (define-module (gnu services)
 
             %boot-service
             %activation-service
-            etc-service)  ; deprecated
+            etc-service  ; deprecated
+            insert-before)
   #:re-export (;; Note: Re-export 'delete' to allow for proper syntax matching
                ;; in 'modify-services' forms.  See
                ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=26805#16>.
@@ -1248,4 +1249,12 @@ (define-syntax-rule (for-home exp ...)
   (syntax-parameterize ((for-home? (identifier-syntax #t)))
     exp ...))
 
+(define (insert-before pred lst1 lst2)
+    "Return a list appending LST2 just before the first element on LST1 that
+ satisfy the predicate PRED."
+    (cond
+     ((null? lst1) lst2)
+     ((pred (car lst1)) (append lst2 lst1))
+     (else (cons (car lst1) (insert-before pred (cdr lst1) lst2)))))
+
 ;;; services.scm ends here.
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index b3f2d2e8b8..34aeb4f7d2 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -21,6 +21,7 @@
 ;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li>
 ;;; Copyright © 2022 ( <paren@disroot.org>
 ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -3227,6 +3228,7 @@ (define-record-type* <greetd-configuration>
   greetd-configuration?
   (motd greetd-motd (default %default-motd))
   (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (gnupg? greetd-gnupg? (default #f))
   (terminals greetd-terminals (default '()))
   (greeter-supplementary-groups greetd-greeter-supplementary-groups (default '())))
 
@@ -3266,25 +3268,31 @@ (define optional-pam-mount
      (module (file-append greetd-pam-mount "/lib/security/pam_mount.so"))
      (arguments '("disable_interactive"))))
 
+  (define (optional-pam-mount-transformer pam)
+    (if (member (pam-service-name pam)
+                '("login" "greetd" "su" "slim" "gdm-password"))
+        (pam-service
+         (inherit pam)
+         ;; SLiM could have pam-gnupg module, and pam-mount must be before it.
+         (auth (insert-before pam-gnupg-module?
+                              (pam-service-auth pam)
+                              (list optional-pam-mount)))
+         (session (insert-before pam-gnupg-module?
+                                 (pam-service-session pam)
+                                 (list optional-pam-mount))))
+        pam))
   (list
    (unix-pam-service "greetd"
                      #:login-uid? #t
                      #:allow-empty-passwords?
                      (greetd-allow-empty-passwords? config)
+                     #:gnupg?
+                     (greetd-gnupg? config)
                      #:motd
                      (greetd-motd config))
    (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))))))
+     optional-pam-mount-transformer))))
 
 (define (greetd-shepherd-services config)
   (map
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index b3a02e82e9..a7470e1fcb 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2023 Brian Cully <bjc@spork.org>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -94,7 +95,8 @@ (define (pam-mount-pam-service config)
   (define optional-pam-mount
     (pam-entry
      (control "optional")
-     (module (file-append pam-mount "/lib/security/pam_mount.so"))))
+     (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
+
   (list
    (pam-extension
     (transformer
@@ -103,10 +105,12 @@ (module (file-append pam-mount "/lib/security/pam_mount.so"))))
                    '("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))))
+            (auth (insert-before pam-gnupg-module?
+                                 (pam-service-auth pam)
+                                 (list optional-pam-mount)))
+            (session (insert-before pam-gnupg-module?
+                                   (pam-service-session pam)
+                                   (list optional-pam-mount))))
            pam))))))
 
 (define (extend-pam-mount-configuration initial extensions)
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a035a92e25..445e45c5ef 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,7 +65,9 @@ (define-module (gnu system pam)
             pam-extension-shepherd-requirements
 
             pam-root-service-type
-            pam-root-service))
+            pam-root-service
+
+            pam-gnupg-module?))
 
 ;;; Commentary:
 ;;;
@@ -264,12 +267,12 @@ (module "pam_motd.so")
                                (control "required")
                                (module "pam_loginuid.so")))
                         '())
+                  ,env ,unix
                   ,@(if gnupg?
                         (list (pam-entry
                                (control "required")
                                (module (file-append pam-gnupg "/lib/security/pam_gnupg.so"))))
-                        '())
-                  ,env ,unix))))))
+                        '())))))))
 
 (define (rootok-pam-service command)
   "Return a PAM service for COMMAND such that 'root' does not need to
@@ -454,4 +457,8 @@ (define* (pam-root-service base #:key (transformers '()) (shepherd-requirements
                               (transformers transformers)
                               (shepherd-requirements shepherd-requirements))))
 
+(define (pam-gnupg-module? name)
+  "Return `#t' if NAME is the path to the pam-gnupg module, `#f' otherwise."
+ (equal? (pam-entry-module name)
+         (file-append pam-gnupg "/lib/security/pam_gnupg.so")))
 
-- 
2.41.0

[bug#65538] [PATCH v2] services: greetd: Add pam-gnupg support.

[Ludovic Courtès]

Hello,

Carlos Durán Domínguez <wurt@wurtshell.com> skribis:

> I retry to implement the pam-gnupg module for the greetd system service. It is A PAM module that hands over your login password to gpg-agent. I added de documentation and the insert-before procedure (maybe it needs a better name), to ensure that the pam-gnupg module will be loaded at the end.
>
> * doc/guix.texi: documentation about #:gnupg? option on (greetd-configuration).
> * gnu/services.scm (insert-before): new procedure.
> * gnu/services/base.scm (greetd-configuration): new option #:gnupg?.
> * gnu/services/pam-mount.scm: ensure that pam mount module goes before pam gnupg module.
> * gnu/system/pam.scm (pam-gnupg-module?): new procedure and ensure that pam gnupg module is at the end of (unix-pam-service).

Nice work!

A minor point: the commit log should normally lists all
changed/added/removed entities.  You can use ‘git log’ to see examples,
but the committer will tweak it for you if needed (no big deal).

[...]

> +@item @code{gnupg?} (default: @code{#f})
> +If enabled, @code{pam-gnupg} will attempt to automatically unlock the
> +user's GPG keys with the login password via @code{gpg-agent}.  The
> +keygrips of all keys to be unlocked should be written to
> +@file{~/.pam-gnupg}, and can be queried with @code{gpg -K
> +--with-keygrip}.  Presetting passphrases must be enabled by adding
> +@code{allow-preset-passphrase} in @file{~/.gnupg/gpg-agent.conf}.

Perhaps you can add a cross-reference to the relevant part of the GnuPG
manual?  (With @pxref or similar.)

> +(define (insert-before pred lst1 lst2)
> +    "Return a list appending LST2 just before the first element on LST1 that
> + satisfy the predicate PRED."
> +    (cond
> +     ((null? lst1) lst2)
> +     ((pred (car lst1)) (append lst2 lst1))
> +     (else (cons (car lst1) (insert-before pred (cdr lst1) lst2)))))

I’d rather have it in (guix utils).  Also, please use ‘match’ and avoid
car/cdr as per
<https://guix.gnu.org/manual/devel/en/html_node/Data-Types-and-Pattern-Matching.html>.

>             (pam-service
>              (inherit pam)
> -            (auth (append (pam-service-auth pam)
> -                          (list optional-pam-mount)))
> -            (session (append (pam-service-session pam)
> -                             (list optional-pam-mount))))
> +            (auth (insert-before pam-gnupg-module?
> +                                 (pam-service-auth pam)
> +                                 (list optional-pam-mount)))
> +            (session (insert-before pam-gnupg-module?
> +                                   (pam-service-session pam)
> +                                   (list optional-pam-mount))))

Could you add a comment explaining why this ordering is important?

> +(define (pam-gnupg-module? name)
> +  "Return `#t' if NAME is the path to the pam-gnupg module, `#f' otherwise."
> + (equal? (pam-entry-module name)
> +         (file-append pam-gnupg "/lib/security/pam_gnupg.so")))

<package> records in general cannot be compared with ‘equal?’, so the
above procedure won’t work in the general case.  (It wouldn’t work with
custom variants of the ‘pam-gnupg’ package, too.)

Can you think of another way we could check whether a <pam-entry>
corresponds to ‘pam-gnupg’?

Thanks,
Ludo’.

[bug#65538] [PATCH v3] services: greetd: Add pam-gnupg support.

[guix-patches--- via]

Hi Ludo,

I appreciate your corrections and your kind words. I hope that my changes
solve these problems, although I have a few doubts.

My main concern is that the new 'pam-gnupg-module?' procedure could be wrong,
but I did not find any other solution.

I also think that using 'insert-before' in gnu/services/pam-mount.scm could be
a problem. If other PAM modules needs to be on certain positions, it could be
an “if mess” or maybe not, I do not know much about PAM modules.

Thanks,

* guix/utils.scm (insert-before): New procedure.
It is needed to sort PAM modules.
* gnu/system/pam.scm (unix-pam-service): Change pam-gnupg module position.
pam-gnupg needs to be the latest loaded module.
* gnu/system/pam.scm (pam-gnupg-module?): New procedure.
Checks if a <pam-entry> uses the library */etc/security/pam_gnupg.so.
* gnu/services/pam-mount.scm (pam-mount-pam-service): Modify pam-mount module.
pam_mount.so must be loaded before pam_gnupg.so.
* gnu/services/base.scm (greetd-configuration): Add gnupg? slot.
This slot enable the pam-gnupg PAM module.
* doc/guix.texi: Add gnupg? option to greetd service.
---
 doc/guix.texi              | 19 ++++++++++++++++---
 gnu/services/base.scm      | 29 +++++++++++++++++++----------
 gnu/services/pam-mount.scm | 15 +++++++++++----
 gnu/system/pam.scm         | 15 ++++++++++++---
 guix/utils.scm             | 24 ++++++++++++++++++++----
 5 files changed, 78 insertions(+), 24 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8c5697589f..cc63d6d48d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -119,6 +119,7 @@ Copyright @copyright{} 2023 Tanguy Le Carrour@*
 Copyright @copyright{} 2023 Zheng Junjie@*
 Copyright @copyright{} 2023 Brian Cully@*
 Copyright @copyright{} 2023 Felix Lechner@*
+Copyright @copyright{} 2023 Carlos Durán Domínguez@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19742,6 +19743,14 @@ A file-like object containing the ``message of the day''.
 Allow empty passwords by default so that first-time users can log in when
 the 'root' account has just been created.
 
+@item @code{gnupg?} (default: @code{#f})
+If enabled, @code{pam-gnupg} will attempt to automatically unlock the
+user's GPG keys with the login password via @code{gpg-agent}.  The
+keygrips of all keys to be unlocked should be written to
+@file{~/.pam-gnupg}, and can be queried with @code{gpg -K
+--with-keygrip}.  Presetting passphrases must be enabled by adding
+@code{allow-preset-passphrase} in @file{~/.gnupg/gpg-agent.conf}.
+
 @item @code{terminals} (default: @code{'()})
 List of @code{greetd-terminal-configuration} per terminal for which
 @code{greetd} should be started.
@@ -22495,9 +22504,13 @@ Whether to allow logins with empty passwords.
 If enabled, @code{pam-gnupg} will attempt to automatically unlock the
 user's GPG keys with the login password via @code{gpg-agent}.  The
 keygrips of all keys to be unlocked should be written to
-@file{~/.pam-gnupg}, and can be queried with @code{gpg -K
---with-keygrip}.  Presetting passphrases must be enabled by adding
-@code{allow-preset-passphrase} in @file{~/.gnupg/gpg-agent.conf}.
+@file{~/.pam-gnupg} (see
+@url{https://github.com/cruegge/pam-gnupg#setup-guide, pam-gnupg setup
+guide}), and can be queried with @code{gpg -K --with-keygrip}
+(@pxref{Commands to select the type of operation,,,gnupg}).  Presetting
+passphrases must be enabled by adding @code{allow-preset-passphrase} in
+@file{~/.gnupg/gpg-agent.conf} (@pxref{Put a passphrase into the
+cache,,,gnupg}).
 
 @item @code{auto-login?} (default: @code{#f})
 @itemx @code{default-user} (default: @code{""})
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 98d59fd36d..800ffe9306 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -21,6 +21,7 @@
 ;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li>
 ;;; Copyright © 2022 ( <paren@disroot.org>
 ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -85,6 +86,7 @@ (define-module (gnu services base)
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module (guix pki)
+  #:use-module (guix utils)
   #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (guix diagnostics)
   #:use-module (guix i18n)
@@ -3277,6 +3279,7 @@ (define-record-type* <greetd-configuration>
   greetd-configuration?
   (motd greetd-motd (default %default-motd))
   (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (gnupg? greetd-gnupg? (default #f))
   (terminals greetd-terminals (default '()))
   (greeter-supplementary-groups greetd-greeter-supplementary-groups (default '())))
 
@@ -3316,25 +3319,31 @@ (define optional-pam-mount
      (module (file-append greetd-pam-mount "/lib/security/pam_mount.so"))
      (arguments '("disable_interactive"))))
 
+  (define (optional-pam-mount-transformer pam)
+    (if (member (pam-service-name pam)
+                '("login" "greetd" "su" "slim" "gdm-password"))
+        (pam-service
+         (inherit pam)
+         ;; SLiM could have pam-gnupg module, and pam-mount must be before it.
+         (auth (insert-before pam-gnupg-module?
+                              (pam-service-auth pam)
+                              (list optional-pam-mount)))
+         (session (insert-before pam-gnupg-module?
+                                 (pam-service-session pam)
+                                 (list optional-pam-mount))))
+        pam))
   (list
    (unix-pam-service "greetd"
                      #:login-uid? #t
                      #:allow-empty-passwords?
                      (greetd-allow-empty-passwords? config)
+                     #:gnupg?
+                     (greetd-gnupg? config)
                      #:motd
                      (greetd-motd config))
    (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))))))
+     optional-pam-mount-transformer))))
 
 (define (greetd-shepherd-services config)
   (map
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index b3a02e82e9..ecd56cd5c3 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2023 Brian Cully <bjc@spork.org>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,7 @@ (define-module (gnu services pam-mount)
   #:use-module (gnu system pam)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (guix utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:export (pam-mount-configuration
@@ -95,6 +97,7 @@ (define optional-pam-mount
     (pam-entry
      (control "optional")
      (module (file-append pam-mount "/lib/security/pam_mount.so"))))
+
   (list
    (pam-extension
     (transformer
@@ -102,11 +105,15 @@ (module (file-append pam-mount "/lib/security/pam_mount.so"))))
        (if (member (pam-service-name pam)
                    '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
            (pam-service
+            ;; pam-mount module must be before pam-gnupg, because the later
+            ;; needs to be at the end (See pam-gnupg README.md)
             (inherit pam)
-            (auth (append (pam-service-auth pam)
-                          (list optional-pam-mount)))
-            (session (append (pam-service-session pam)
-                             (list optional-pam-mount))))
+            (auth (insert-before pam-gnupg-module?
+                                 (pam-service-auth pam)
+                                 (list optional-pam-mount)))
+            (session (insert-before pam-gnupg-module?
+                                   (pam-service-session pam)
+                                   (list optional-pam-mount))))
            pam))))))
 
 (define (extend-pam-mount-configuration initial extensions)
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a035a92e25..193243a588 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,7 +65,9 @@ (define-module (gnu system pam)
             pam-extension-shepherd-requirements
 
             pam-root-service-type
-            pam-root-service))
+            pam-root-service
+
+            pam-gnupg-module?))
 
 ;;; Commentary:
 ;;;
@@ -264,12 +267,12 @@ (module "pam_motd.so")
                                (control "required")
                                (module "pam_loginuid.so")))
                         '())
+                  ,env ,unix
                   ,@(if gnupg?
                         (list (pam-entry
                                (control "required")
                                (module (file-append pam-gnupg "/lib/security/pam_gnupg.so"))))
-                        '())
-                  ,env ,unix))))))
+                        '())))))))
 
 (define (rootok-pam-service command)
   "Return a PAM service for COMMAND such that 'root' does not need to
@@ -454,4 +457,10 @@ (define* (pam-root-service base #:key (transformers '()) (shepherd-requirements
                               (transformers transformers)
                               (shepherd-requirements shepherd-requirements))))
 
+(define (pam-gnupg-module? name)
+  "Return `#t' if NAME is the path to the pam-gnupg module, `#f' otherwise."
+  (let ((module (pam-entry-module name)))
+    (and (file-append? module)
+         (equal? (first (file-append-suffix module))
+                 "/lib/security/pam_gnupg.so"))))
 
diff --git a/guix/utils.scm b/guix/utils.scm
index e9af33bdeb..de43945278 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
 ;;; Copyright © 2023 Philip McGrath <philip@philipmcgrath.com>
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2023 Carlos Durán Domínguez <wurt@wurtshell.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,15 +41,15 @@ (define-module (guix utils)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-71)
-  #:use-module (rnrs io ports)                    ;need 'port-position' etc.
+  #:use-module (rnrs io ports)          ;need 'port-position' etc.
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module (guix memoization)
   #:use-module ((guix build utils)
                 #:select (dump-port mkdir-p delete-file-recursively
-                          call-with-temporary-output-file %xz-parallel-args))
+                                    call-with-temporary-output-file %xz-parallel-args))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
   #:use-module ((guix combinators) #:select (fold2))
-  #:use-module (guix diagnostics)           ;<location>, &error-location, etc.
+  #:use-module (guix diagnostics)       ;<location>, &error-location, etc.
   #:use-module (ice-9 format)
   #:use-module ((ice-9 iconv) #:prefix iconv:)
   #:use-module (ice-9 match)
@@ -57,7 +58,7 @@ (define-module (guix utils)
   #:use-module (ice-9 vlist)
   #:autoload   (zlib) (make-zlib-input-port make-zlib-output-port)
   #:use-module (system foreign)
-  #:re-export (<location>                         ;for backwards compatibility
+  #:re-export (<location>               ;for backwards compatibility
                location
                location?
                location-file
@@ -80,6 +81,8 @@ (define-module (guix utils)
             substitute-keyword-arguments
             ensure-keyword-arguments
 
+            insert-before
+
             %guix-source-root-directory
             current-source-directory
 
@@ -598,6 +601,19 @@ (define (ensure-keyword-arguments args kw/values)
          (#f
           (loop rest kw/values (cons* value kw result))))))))
 
+\f
+;;;
+;;; Lists.
+;;;
+
+(define (insert-before pred lst1 lst2)
+  "Return a list appending LST2 just before the first element on LST1 that
+ satisfy the predicate PRED."
+  (match lst1
+    (() lst2)
+    (((? pred x) . rest) (append lst2 lst1))
+    ((first . rest) (cons first (insert-before pred rest lst2)))))
+
 \f
 ;;;
 ;;; System strings.
-- 
Carlos Durán Domínguez
GPG key: https://wurtshell.com/wurt.gpg

[bug#65538] [PATCH v2] services: greetd: Add pam-gnupg support.

[Ludovic Courtès]

Hi,

Carlos Durán Domínguez <wurt@wurtshell.com> skribis:

> My main concern is that the new 'pam-gnupg-module?' procedure could be wrong,
> but I did not find any other solution.

OK.

> I also think that using 'insert-before' in gnu/services/pam-mount.scm could be
> a problem. If other PAM modules needs to be on certain positions, it could be
> an “if mess” or maybe not, I do not know much about PAM modules.

Yeah, I’m also wondering what will happen if several services have
ordering requirements.  This seems to break composability, but maybe
it’s a problem that PAM has.

> +@file{~/.pam-gnupg} (see
> +@url{https://github.com/cruegge/pam-gnupg#setup-guide, pam-gnupg setup
> +guide}), and can be queried with @code{gpg -K --with-keygrip}
> +(@pxref{Commands to select the type of operation,,,gnupg}).  Presetting
> +passphrases must be enabled by adding @code{allow-preset-passphrase} in
> +@file{~/.gnupg/gpg-agent.conf} (@pxref{Put a passphrase into the
> +cache,,,gnupg}).

Note that @pxref should first name the “node” (section) of the manual
you’re referring to, and there should be one last argument giving the
title of the manual:

  https://www.gnu.org/software/texinfo/manual/texinfo/html_node/Four-and-Five-Arguments.html

The ones above should be adjusted to refer to existing nodes of the
GnuPG manual.

>         (if (member (pam-service-name pam)
>                     '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
>             (pam-service
> +            ;; pam-mount module must be before pam-gnupg, because the later
> +            ;; needs to be at the end (See pam-gnupg README.md)
>              (inherit pam)

I went to look at the ‘README.md’ file, and all I could find is:

  At least, `pam_gnupg.so` should come after `pam_unix.so`,
  `pam_systemd_home.so`, `pam_systemd.so` and `pam_env.so` in case you
  use those modules.

Is it what you’re referring to?

The ‘README.md’ also gave me a sense that pam-gnupg is not fully baked:

  The code was written mainly by looking at and occasionally copying
  from Gnome Keyring's PAM module and pam_mount and is based on a
  somewhat mediocre understanding of the details of both PAM and C. You
  should be aware that there may be potentially dangerous bugs lurking.

It also makes this recommendation, which I find dubious security-wise:

  - Add

        allow-preset-passphrase

    to `~/.gnupg/gpg-agent.conf`. Optionally, customize the cache timeout via
    `max-cache-ttl`, e.g. set

        max-cache-ttl 86400

    to have it expire after a day.

I guess that’s expected given the purpose of the tool, but still.

Overall that made me wonder if this is something we should promote.
WDYT?

> +(define (pam-gnupg-module? name)
> +  "Return `#t' if NAME is the path to the pam-gnupg module, `#f' otherwise."
> +  (let ((module (pam-entry-module name)))
> +    (and (file-append? module)
> +         (equal? (first (file-append-suffix module))
> +                 "/lib/security/pam_gnupg.so"))))

This is not ideal, because someone might give a module that’s not a
<file-append>, but I can’t think of a better way.

> -  #:use-module (rnrs io ports)                    ;need 'port-position' etc.
> +  #:use-module (rnrs io ports)          ;need 'port-position' etc.
>    #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
>    #:use-module (guix memoization)
>    #:use-module ((guix build utils)
>                  #:select (dump-port mkdir-p delete-file-recursively
> -                          call-with-temporary-output-file %xz-parallel-args))
> +                                    call-with-temporary-output-file %xz-parallel-args))
>    #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
>    #:use-module ((guix combinators) #:select (fold2))
> -  #:use-module (guix diagnostics)           ;<location>, &error-location, etc.
> +  #:use-module (guix diagnostics)       ;<location>, &error-location, etc.
>    #:use-module (ice-9 format)
>    #:use-module ((ice-9 iconv) #:prefix iconv:)
>    #:use-module (ice-9 match)
> @@ -57,7 +58,7 @@ (define-module (guix utils)
>    #:use-module (ice-9 vlist)
>    #:autoload   (zlib) (make-zlib-input-port make-zlib-output-port)
>    #:use-module (system foreign)
> -  #:re-export (<location>                         ;for backwards compatibility
> +  #:re-export (<location>               ;for backwards compatibility

Unnecessary changes.  :-)

Thanks,
Ludo’.