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

From: Sébastien Farge <[email-masked]>
Date: Tue, 15 Apr 2025 16:13:40 +0200

* gnu/home/services/gnupg.scm: New parameter.
* doc/guix.texi (GNU Privacy Guard): New description.
* gnu/tests/gnupg.scm: Alice use keyboxd, Bob normal keyring, test if both works

Change-Id: I27b4f686086b9740943dbb5347a14ada245cc9fb
---
 doc/guix.texi               |   5 +
 gnu/home/services/gnupg.scm |  18 ++-
 gnu/tests/gnupg.scm         | 246 ++++++++++++++++++++++++++++++++++++
 3 files changed, 268 insertions(+), 1 deletion(-)
 create mode 100644 gnu/tests/gnupg.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index d109877a32..46b2115aad 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49076,6 +49076,11 @@ 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)
+Whether to enable keyboxd and its keybox database instead of usual keyring. When true,
+@command{gpg-agent} call @command{keyboxd} who take care of keys management process and database. 
+The @file{~/.gnupg/common.conf} is created with parameter @code{use-keyboxd} for the switch to happen.
+
 @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..f7691f38e0 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,11 @@ (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)
+   "Whether to enable keyboxd and its keybox database instead of usual keyring. When true,
+@command{gpg-agent} call @command{keyboxd} who take care of keys management process and database. 
+The @file{~/.gnupg/common.conf} is created with parameter @code{use-keyboxd} for the switch to happen.")
   (default-cache-ttl
     (integer 600)
     "Time a cache entry is valid, in seconds.")
@@ -101,6 +107,13 @@ (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}."
+  (match-record config <home-gpg-agent-configuration>
+    (use-keyboxd?)
+    (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 +147,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/tests/gnupg.scm b/gnu/tests/gnupg.scm
new file mode 100644
index 0000000000..6be26b0073
--- /dev/null
+++ b/gnu/tests/gnupg.scm
@@ -0,0 +1,246 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016-2022, 2024 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2017, 2018 Clément Lassieur <[email-masked]>
+;;; Copyright © 2017 Marius Bakke <[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 gnupg)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages base)
+  #:use-module (guix gexp)
+  #:export (%test-gnupg-keyboxd))
+
+(define %keyboxd-home
+  (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))
+    ))
+
+(define %keyring-home
+  (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))
+    ))
+
+(define %gnupg-os
+  (operating-system
+    (inherit (simple-operating-system (service guix-home-service-type `(("alice" ,%keyboxd-home)
+                                                                        ("bob" ,%keyring-home)))))
+
+    (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")))
+            %base-user-accounts))
+    ))
+  
+(define* (run-gnupg-keyboxd-test)
+  "Run an OS using gnupg with and without keyboxd using 'use-keyboxd'? configuration option."
+  (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 (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (vm-type cmd-or-list)
+            (let ((cmd-list (if (list? cmd-or-list) cmd-or-list (list cmd-or-list))))
+             (for-each
+              (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+              cmd-list)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "gnupg-keyboxd")
+         
+          (test-equal "Alice is logged on tty1"
+            "alice\n"
+            (begin
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (vm-type  (list
+                         "alice\n"
+                         "alice\n"
+                         "id -un > alice.log\n"))
+              (file-get-all-strings "/home/alice/alice.log")))
+
+          (test-assert "Alice .gnupg dir is created"
+            (marionette-eval
+             `(file-exists? "/home/alice/.gnupg")
+             marionette))
+          
+          (test-equal "Alice gpg-agent.conf exists and is a symlink"
+            'symlink
+            (marionette-eval
+             `(and (file-exists? "/home/alice/.gnupg/gpg-agent.conf")
+                   (stat:type (lstat "/home/alice/.gnupg/gpg-agent.conf")))
+             marionette))
+
+          (test-equal "Alice common.conf exists and is a symlink"
+            'symlink
+            (marionette-eval
+             `(and (file-exists? "/home/alice/.gnupg/common.conf")
+                   (stat:type (lstat "/home/alice/.gnupg/common.conf")))
+             marionette))
+
+          (test-equal "Alice common.conf has keyboxd option set"
+            "use-keyboxd\n"
+            (file-get-all-strings "/home/alice/.gnupg/common.conf"))
+
+          (test-equal "Alice create a key that is saved in keybox format"
+            '("[keyboxd]" "enjoyguix")
+            (begin
+              (vm-type (list "gpg --batch --passphrase '' --quick-gen-key '<enjoyguix>' ed25519\n"
+                             "gpg --list-keys > keybox\n"))
+              (let* ((output (file-get-all-strings "/home/alice/keybox"))
+                     (keyboxd-hdr (if (string-contains output "[keyboxd]") "[keyboxd]" "fail"))
+                     (key-id (if (string-contains output "enjoyguix") "enjoyguix" "fail")))
+                (list keyboxd-hdr key-id))
+              )
+            )
+
+          (test-assert "Alice private keys are registered"
+            (marionette-eval
+             `(file-exists? "/home/alice/.gnupg/private-keys-v1.d")
+             marionette))
+
+          (test-equal "Alice has keyboxd running at home"
+            0
+            (marionette-eval
+             `(system* #$(file-append procps "/bin/pgrep") "keyboxd")
+             marionette))
+
+          ;; bob use gpg-agent
+          (test-equal "Bob is logged now"
+            "bob\n"
+            (begin
+              (vm-type
+               (list
+                "exit\n"
+                "bob\n"
+                "bob\n"
+                "id -un > logged-in\n"))
+              (file-get-all-strings "/home/bob/logged-in")))
+
+          (test-equal "Bob is at home"
+            "/home/bob\n"
+            (begin
+              (vm-type (list "printenv \"HOME\" > home.bob\n"))
+              (file-get-all-strings "/home/bob/home.bob")
+              ))
+
+          (test-assert "Bob .gnupg dir is created"
+            (marionette-eval
+             `(file-exists? "/home/bob/.gnupg")
+             marionette))
+          
+          (test-equal "Bob gpg-agent.conf exists and is a symlink"
+            'symlink
+            (marionette-eval
+             `(and (file-exists? "/home/bob/.gnupg/gpg-agent.conf")
+                   (stat:type (lstat "/home/bob/.gnupg/gpg-agent.conf")))
+             marionette))
+
+          (test-assert "Bob common.conf doesn't exists"
+            (marionette-eval
+             `(not (file-exists? "/home/bob/.gnupg/common.conf"))
+             marionette))
+
+          (test-equal "Bob create a key that is saved in a pubring"
+            '("pubring" "enjoyguix")
+            (begin
+              (vm-type (list "gpg --batch --passphrase '' --quick-gen-key '<enjoyguix>' ed25519\n"
+                             "gpg --list-keys > keybox\n"))
+              (let* ((output (file-get-all-strings "/home/bob/keybox"))
+                     (agent-hdr (if (string-contains output "/home/bob/.gnupg/pubring.kbx") "pubring" (format #f "fail with ~s" output)))
+                     (key-id (if (string-contains output "enjoyguix") "enjoyguix" (format #f "fail with ~s" output))))
+                (list agent-hdr key-id))
+              )
+            )
+
+          (test-assert "Bob private keys are registered"
+            (marionette-eval
+             `(file-exists? "/home/bob/.gnupg/private-keys-v1.d")
+             marionette))
+
+          (test-equal "Bob has gpg-agent running at home"
+            0
+            (marionette-eval
+             `(system* #$(file-append procps "/bin/pgrep") "gpg-agent")
+             marionette))
+
+          (test-end))))
+
+  (gexp->derivation "gnupg-keyboxd" test))
+
+(define %test-gnupg-keyboxd
+  (system-test
+   (name "gnupg-keyboxd")
+   (description "Test gnupg using keyboxd or keyring.")
+   (value (run-gnupg-keyboxd-test))))
+
+
-- 
2.48.1