Subject: [PATCH v3] home: home-gpg-agent-service: add new parameter 'use-keyboxd?'.

From: [email-masked]
Date: Mon, 19 May 2025 21:03:20 +0200

From: Sébastien Farge <[email-masked]>

Hi Ludo',

Here is the v3 updated following your recommendations.
One exception :

Ludo' wrote

> > +          ;; Close user session.
> > +          (marionette-type "exit\n" marionette)
> > +          (sleep 1)

> ‘sleep’?  Can this be removed?

if we remove that 1s temporisation the next user won't be able to start his session.

> Thanks for coming up with nice tests!

You're welcome, i'm pleased to contribute.

Sébastien.

PS : Hello Gabriel, you answered the first patch, as i lost the thread, i'm sending you the message again,
   	 in case you're still interested by the subject .

* gnu/home/services/gnupg.scm: New parameter.
* doc/guix.texi (GNU Privacy Guard): New description.
* gnu/tests/gnupg.scm: four scenarii,
  		       1) use-keyboxd? true, no keyring
		       2) use-keyboxd? unset, no keyring
		       3) use-keyboxd? false, legacy pubring.gpg
		       4) use-keyboxd? true, legacy pubring.gpg

Change-Id: I27b4f686086b9740943dbb5347a14ada245cc9fb
---
 doc/guix.texi               |  19 ++
 gnu/home/services/gnupg.scm |  17 +-
 gnu/local.mk                |   1 +
 gnu/tests/gnupg.scm         | 393 ++++++++++++++++++++++++++++++++++++
 4 files changed, 429 insertions(+), 1 deletion(-)
 create mode 100644 gnu/tests/gnupg.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 34092a2f73..88cb308948 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -50079,6 +50079,25 @@ Whether to enable @acronym{SSH,secure shell} support.  When true,
 @command{ssh-agent} program, taking care of OpenSSH secret keys and
 directing passphrase requests to the chosen Pinentry program.
 
+@item @code{use-keyboxd?} (default: @code{#f}) (type: boolean)
+Choose true if you want to use the new keys database daemon
+managed by @command{keyboxd}---the default settings on a fresh
+install since GnuPG 2.4.1---instead of keyring file(s).
+The @file{~/.gnupg/common.conf} is created with parameter
+@code{use-keyboxd} set for the switch to happen
+(@pxref{GPG Configuration,,, gnupg, Using the GNU Privacy Guard}).
+
+@quotation Warning
+Keys kept in a previous pubring file have to
+be imported in the keyboxd database or will be ignored (for
+more information please refer to ``Keys database daemon`` section
+of the GnuPG's @file{README} file).
+@end quotation
+
+When false @command{keyboxd} is not used and @command{gpg-agent}
+will manage keys in usual keyring file (legacy
+@file{pubring.gpg}, or newer @file{pubring.kbx}).
+
 @item @code{default-cache-ttl} (default: @code{600}) (type: integer)
 Time a cache entry is valid, in seconds.
 
diff --git a/gnu/home/services/gnupg.scm b/gnu/home/services/gnupg.scm
index 7fc99f793a..88bbdc6ccf 100644
--- a/gnu/home/services/gnupg.scm
+++ b/gnu/home/services/gnupg.scm
@@ -31,6 +31,7 @@ (define-module (gnu home services gnupg)
             home-gpg-agent-configuration-gnupg
             home-gpg-agent-configuration-pinentry-program
             home-gpg-agent-configuration-ssh-support?
+            home-gpg-agent-configuration-use-keyboxd?
             home-gpg-agent-configuration-default-cache-ttl
             home-gpg-agent-configuration-max-cache-ttl
             home-gpg-agent-configuration-max-cache-ttl-ssh
@@ -66,6 +67,12 @@ (define-configuration/no-serialization home-gpg-agent-configuration
 @command{gpg-agent} acts as a drop-in replacement for OpenSSH's
 @command{ssh-agent} program, taking care of OpenSSH secret keys and directing
 passphrase requests to the chosen Pinentry program.")
+  (use-keyboxd?
+   (boolean #f)
+   "Set it to true if you use keyboxd agent and want its configuration file @file{~/.gnupg/common.conf} 
+be saved in the store.  Note that choosing #f will not prevent GnuPG to use keyboxd if you init a new
+GnuPG environment. 
+The @file{~/.gnupg/common.conf} is created in the store with parameter @code{use-keyboxd}.")
   (default-cache-ttl
     (integer 600)
     "Time a cache entry is valid, in seconds.")
@@ -101,6 +108,11 @@ (define (home-gpg-agent-configuration-file config)
                      (number->string max-cache-ttl-ssh) "\n"
                      extra-content)))
 
+(define (home-gpg-common-configuration-file config)
+  "Return the @file{common.conf} file for @var{config}."
+  (mixed-text-file "common.conf" "use-keyboxd\n"))
+
+
 (define (home-gpg-agent-shepherd-services config)
   "Return the possibly-empty list of Shepherd services for @var{config}."
   (match-record config <home-gpg-agent-configuration>
@@ -134,7 +146,10 @@ (define (home-gpg-agent-shepherd-services config)
         '())))
 
 (define (home-gpg-agent-files config)
-  `((".gnupg/gpg-agent.conf" ,(home-gpg-agent-configuration-file config))))
+  (let ((files (cons `(".gnupg/gpg-agent.conf" ,(home-gpg-agent-configuration-file config)) '())))
+    (if (home-gpg-agent-configuration-use-keyboxd? config) 
+        (cons `(".gnupg/common.conf" ,(home-gpg-common-configuration-file config)) files)
+        files)))
 
 (define (home-gpg-agent-environment-variables config)
   "Return GnuPG environment variables needed for @var{config}."
diff --git a/gnu/local.mk b/gnu/local.mk
index dfafe8b895..08aafc67b6 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -857,6 +857,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/foreign.scm				\
   %D%/tests/ganeti.scm				\
   %D%/tests/gdm.scm				\
+  %D%/tests/gnupg.scm				\
   %D%/tests/guix.scm				\
   %D%/tests/monitoring.scm                      \
   %D%/tests/nfs.scm				\
diff --git a/gnu/tests/gnupg.scm b/gnu/tests/gnupg.scm
new file mode 100644
index 0000000000..fc521085a1
--- /dev/null
+++ b/gnu/tests/gnupg.scm
@@ -0,0 +1,393 @@
+
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Sébastien Farge <[email-masked]>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests gnupg)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services guix)
+  #:use-module (gnu system shadow) 
+  #:use-module (gnu services base)
+  #:use-module (gnu home)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services gnupg)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages base)
+  #:use-module (guix gexp)
+  #:use-module (rnrs io ports)
+  #:export (%test-gnupg-keyboxd))
+
+
+(define %gnupg-os
+  (operating-system
+    (inherit (simple-operating-system
+              (service guix-home-service-type
+                       ;; keyboxd, no keyring
+                       `(("alice" ,(home-environment
+                                     (packages (list gnupg procps))
+                                     (services
+                                      (append (list
+                                               (service home-gpg-agent-service-type
+                                                        (home-gpg-agent-configuration
+                                                         (default-cache-ttl 820)
+                                                         (use-keyboxd? #t))))
+                                              %base-home-services))))
+                         ;; keyboxd unset, no keyring
+                         ("bob" ,(home-environment
+                                   (packages (list gnupg procps))
+                                   (services
+                                    (append (list
+                                             (service home-gpg-agent-service-type
+                                                      (home-gpg-agent-configuration
+                                                       (default-cache-ttl 820))))
+                                            %base-home-services))))
+                         ;; keyboxd false, but legacy keyring.gpg
+                         ("charles" ,(home-environment
+                                       (packages (list gnupg procps))
+                                       (services
+                                        (append (list
+                                                 (service home-gpg-agent-service-type
+                                                          (home-gpg-agent-configuration
+                                                         (use-keyboxd? #f)
+                                                         (default-cache-ttl 820))))
+                                                %base-home-services))))
+                         ;; keyboxd true, but legacy keyring.gpg
+                         ("dorothee" ,(home-environment
+                                        (packages (list gnupg procps))
+                                        (services
+                                         (append (list
+                                                  (service home-gpg-agent-service-type
+                                                           (home-gpg-agent-configuration
+                                                            (default-cache-ttl 820)
+                                                            (use-keyboxd? #t))))
+                                                 %base-home-services))))))))
+
+    (users (cons*
+            (user-account
+             (name "alice")                  
+             (comment "Bob's sister")
+             (password (crypt "alice" "$6$abc"))
+             (group "users")
+             (supplementary-groups '("wheel" "audio" "video")))
+            (user-account
+             (name "bob")                  
+             (comment "Alice's brother")
+             (password (crypt "bob" "$6$abc"))
+             (group "users")
+             (supplementary-groups '("wheel" "audio" "video")))
+            (user-account
+             (name "charles")                  
+             (comment "Alice's best friend")
+             (password (crypt "charles" "$6$abc"))
+             (group "users")
+             (supplementary-groups '("wheel" "audio" "video")))
+            (user-account
+             (name "dorothee")                  
+             (comment "Charle's best friend")
+             (password (crypt "dorothee" "$6$abc"))
+             (group "users")
+             (supplementary-groups '("wheel" "audio" "video")))
+            %base-user-accounts))))
+  
+(define* (run-gnupg-keyboxd-test)
+  "Run an OS to test four situations related to 'use-keyboxd?' option:
+- Alice: 'use-keyboxd?' true, and has no keyring yet.
+- Bob: 'use-keyboxd?' unset, and has no keyring.
+- Charles: 'use-keyboxd?' false, has a legacy keyring.gpg
+- Dorothee: 'use-keyboxd?' true, has a legacy keyring.gpg."
+  (define os
+    (marionette-operating-system
+     %gnupg-os
+     #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)))
+
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (define (marionette-login-user user)
+            (let ((login (format #f "~a\n" user))
+                  (file-log  (format #f "/home/~a/logged-in" user)))
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list login login
+                     "id -un > logged-in\n"
+                     "printenv \"HOME\" >> logged-in\n"))
+              (marionette-eval '(use-modules (rnrs io ports)) marionette)
+              (wait-for-file file-log marionette #:read 'get-string-all)))
+
+          (define (marionette-create-keyring-for user)
+            "Ask GnuPG to create a legacy keyring 'pubring.gpg' for USER, and add a default key in it."
+            (marionette-eval
+             `(begin
+                ;; --chuid, root plays gpg user's role
+                (system*  #$(file-append gnupg "/bin/gpg")
+                          "-q"
+                          "--chuid" ,user
+                          "--no-default-keyring"
+                          "--keyring" "pubring.gpg"
+                          "--fingerprint")
+                (system*  #$(file-append gnupg "/bin/gpg")
+                          "-q"
+                          "--chuid" ,user
+                          "--batch"
+                          "--passphrase" "''"
+                          "--quick-gen-key" "<[email-masked]>" "ed25519"))             
+             marionette))
+
+          (define (marionette-create-gpgkey-for user)
+            "Ask GnuPG to create and save a new gpg key for USER."
+            (marionette-eval
+             `(begin                
+                (system*  #$(file-append gnupg "/bin/gpg")
+                          "-q"
+                          "--chuid" ,user
+                          "--batch"
+                          "--passphrase" "''"
+                          "--quick-gen-key" "<[email-masked]>" "ed25519"))
+             marionette))
+
+          (define (marionette-list-keys-for user)
+            "Ask GnuPG to list the USER's keys."
+            (marionette-eval
+             `(begin
+                (use-modules (ice-9 popen)
+                             (ice-9 textual-ports))          
+                (let* ((port (open-input-pipe
+                              (format #f "~a -q --chuid ~a --list-keys"
+                                      #$(file-append gnupg "/bin/gpg")
+                                      ,user)))
+                       (str (get-string-all port))) 
+                  (close-pipe port)
+                  str))
+             marionette))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "gnupg-keyboxd")
+
+          ;; start tty1
+          (marionette-eval
+           '(begin
+              (use-modules (gnu services herd))
+              (start-service 'term-tty1))
+           marionette)
+          (sleep 1)
+
+          ;;
+          ;; Alice tests: 'use-keyboxd?' true, no keyring
+          ;;
+
+          ;; Alice logs in to initiate gnupg environment
+          ;; according to its gnupg home service.
+          (test-equal "Alice: logged on tty1 ('use-keyboxd?' true, no keyring)."
+            "alice\n/home/alice\n"
+            (marionette-login-user "alice"))
+
+          (test-equal "Alice: create a key that is saved in keyboxd database."
+            '(#t #t)
+            (begin
+              (use-modules (ice-9 regex))
+              (marionette-create-gpgkey-for "alice")
+              (let ((keylist-str (marionette-list-keys-for "alice")))
+                (list
+                 (= 0 (string-contains keylist-str "[keyboxd]"))
+                 (< 0(string-contains keylist-str "[email-masked]"))))))
+
+          (test-assert "Alice: No 'pubring.kbx' file is created"
+            (marionette-eval
+             `(not (file-exists? "/home/alice/.gnupg/pubring.kbx"))
+             marionette))
+
+          (test-equal "Alice: 'keyboxd' and 'gpg-agent' are running"
+            '(0 0)
+            (marionette-eval
+             `(list
+               (status:exit-val
+                (system* #$(file-append procps "/bin/pgrep") "keyboxd"))
+               (status:exit-val
+                (system* #$(file-append procps "/bin/pgrep") "gpg-agent")))
+             marionette))
+
+          (test-equal "kill 'gpg-agent', and 'keyboxd'"
+            '(0 0) 
+            (marionette-eval
+             `(list
+               (system* #$(file-append procps "/bin/pkill") "gpg-agent")
+               (system* #$(file-append procps "/bin/pkill") "keyboxd"))
+             marionette))
+
+          ;; Close user session.
+          (marionette-type "exit\n" marionette)
+          (sleep 1)
+
+          ;;
+          ;; Bob tests: 'use-keyboxd?' unset, no keyring.
+          ;;
+          
+          (test-equal "Bob: logged on tty1 ('use-keyboxd?' unset, no keyring)"
+            "bob\n/home/bob\n"
+            (marionette-login-user "bob"))
+
+          (test-assert "Bob: common.conf is NOT created"
+            (marionette-eval
+             `(not (file-exists? "/home/bob/.gnupg/common.conf"))
+             marionette))
+          
+          (test-equal "Bob: create a key, gpg saved it in 'pubring.kbx' not in keyboxd database."
+            '(#t #t)
+            (begin
+              (use-modules (ice-9 regex))
+              (marionette-create-gpgkey-for "bob")
+              (let ((keylist-str  (marionette-list-keys-for "bob")))
+                (list
+                 (= 0(string-contains keylist-str  "/home/bob/.gnupg/pubring.kbx"))
+                 (< 0 (string-contains keylist-str  "[email-masked]"))))))
+
+          (test-equal "Bob: 'keyboxd' is NOT running"
+            1
+            (marionette-eval
+             `(status:exit-val
+               (system* #$(file-append procps "/bin/pgrep") "keyboxd"))
+             marionette))
+
+          (test-equal "Bob: 'gpg-agent' is running, kill it"
+            '(0 0)
+            (marionette-eval
+             `(list
+               (status:exit-val
+                (system* #$(file-append procps "/bin/pgrep") "gpg-agent"))
+               (status:exit-val
+                (system* #$(file-append procps "/bin/pkill") "gpg-agent")))
+             marionette))
+
+          ;; Close user session.
+          (marionette-type "exit\n" marionette)
+          (sleep 1)
+          
+
+          ;;
+          ;; Charles tests: 'use-keyboxd?' false, a legacy keyring pubring.gpg
+          ;;
+
+          (marionette-create-keyring-for "charles")
+
+          (test-equal "Charles: logged on tty1 (use-keyboxd?' false + legacy pubring.gpg)."
+            "charles\n/home/charles\n"
+            (marionette-login-user "charles"))
+
+
+          (test-equal "Charles: create a key, saved in its legacy pubring.gpg"
+            '(#t #t)
+            (begin
+              (use-modules (ice-9 regex))
+              (marionette-create-gpgkey-for "charles")
+              (let ((keylist-str (marionette-list-keys-for "charles")))
+                (list
+                 (= 0 (string-contains keylist-str "/home/charles/.gnupg/pubring.gpg"))
+                 (< 0 (string-contains keylist-str "[email-masked]"))))))                      
+
+          (test-equal "Charles: 'keyboxd' is NOT in use"
+            1
+            (marionette-eval
+             `(status:exit-val
+               (system* #$(file-append procps "/bin/pgrep") "keyboxd"))
+             marionette))
+
+          (test-equal "Charles: 'gpg-agent' is running"
+            0
+            (marionette-eval
+             `(status:exit-val
+               (system* #$(file-append procps "/bin/pgrep") "gpg-agent"))
+             marionette))
+
+          ;; Close user session.
+          (marionette-type "exit\n" marionette)
+          (sleep 1)
+          
+
+          ;;
+          ;; Dorothee tests: 'use-keyboxd?' true, a legacy keyring pubring.gpg
+          ;;
+
+          ;;(marionette-create-keyring-for "dorothee")
+          ;; => gpg don't allow creating keyring when 'use-keyboxd' is set.
+          ;; hack and use charles's keyring
+          (marionette-eval
+           '(let ((dorothee (getpw "dorothee")))
+             (copy-file "/home/charles/.gnupg/pubring.gpg" "/home/dorothee/.gnupg/pubring.gpg")
+             (chown "/home/dorothee/.gnupg/pubring.gpg" (passwd:uid dorothee) (passwd:gid dorothee)))
+           marionette)
+          
+          (test-equal "Dorothee: logged on tty1 ('use-keyboxd?' true + legacy pubring.gpg)."
+            "dorothee\n/home/dorothee\n"
+            (marionette-login-user "dorothee"))
+
+          (test-equal "Dorothee: create a key, gpg ignore the legacy pubring.gpg and saved it in its keyboxd database."
+            '(#t #t #f)
+            (begin
+              (use-modules (ice-9 regex))
+              (marionette-create-gpgkey-for "dorothee")
+              (let ((keylist-str (marionette-list-keys-for "dorothee")))
+                (list
+                 (= 0 (string-contains keylist-str "[keyboxd]"))
+                 (< 0 (string-contains keylist-str "[email-masked]"))
+                 (string-contains keylist-str "[email-masked]")))))
+
+          (test-equal "Dorothee: 'keyboxd' is in use"
+            0
+            (marionette-eval
+             `(status:exit-val
+                (system* #$(file-append procps "/bin/pgrep") "keyboxd"))
+             marionette))
+
+          (test-equal "Dorothee: 'gpg-agent' is running"
+            0
+            (marionette-eval
+             `(status:exit-val
+               (system* #$(file-append procps "/bin/pgrep") "gpg-agent"))
+             marionette))
+
+          ;; Close user session.
+          (marionette-type "exit\n" marionette)
+          ;; (sleep 1)
+          
+          (test-end))))
+
+  (gexp->derivation "gnupg-keyboxd" test))
+
+(define %test-gnupg-keyboxd
+  (system-test
+   (name "gnupg-keyboxd")
+   (description "Test GnuPG with and without use-keyboxd option.")
+   (value (run-gnupg-keyboxd-test))))
+
+

base-commit: efac01f19b65d7d77a98bbfd57fe2073fb13064a
-- 
2.49.0