Hello,

Ludovic Courtès <l...@gnu.org> writes:
> Could you write it in functional style using a vhash (info "(guile)
> VHashes")?  You’ll probably need two list traversals: one to build the
> user/key mapping, and one to compute the list of users.

I thought that as the vhash data structure inherited the drawbacks of
vlist, it would not be worth using in place of a hash table, but you’re
saying that it’s still a better (more functional) data structure, noted.

Here is the new patch (and I also forgot that appending short lists to
long lists was not great, so I do all the appending at the end of the
function now).

>From a2c4d7cefbc71fd3d35b0b7cc2f61118bd3a29b2 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <viv...@planete-kraus.eu>
Date: Fri, 29 Oct 2021 18:25:24 +0200
Subject: [PATCH] gnu: openssh-service: Collect all keys for all users.

* gnu/services/ssh.scm (extend-openssh-authorized-keys): ensure that no key is forgotten.
---
 gnu/services/ssh.scm | 29 +++++++++++++++++++++++++----
 1 file changed, 25 insertions(+), 4 deletions(-)

diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index a018052eeb..6ddaf55eeb 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -39,6 +39,7 @@ (define-module (gnu services ssh)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
   #:export (lsh-configuration
             lsh-configuration?
             lsh-service
@@ -532,10 +533,30 @@ (define (openssh-pam-services config)
 
 (define (extend-openssh-authorized-keys config keys)
   "Extend CONFIG with the extra authorized keys listed in KEYS."
-  (openssh-configuration
-   (inherit config)
-   (authorized-keys
-    (append (openssh-authorized-keys config) keys))))
+  (let generate-keys
+      ((user-keys
+        (append (openssh-authorized-keys config) keys))
+       ;; The by-user vhash indexes a list of list of keys for each user, the
+       ;; list of list is not concatenated eagerly to avoid quadratic
+       ;; complexity.
+       (by-user (alist->vhash '())))
+    (match user-keys
+      (()
+       (openssh-configuration
+        (inherit config)
+        (authorized-keys
+         (vhash-fold
+          (lambda (user keys other-users)
+            `((,user ,@(apply append (reverse keys))) ,@other-users))
+          '() by-user))))
+      (((user keys ...) other-user-keys ...)
+       (let ((existing
+              (match (vhash-assoc user by-user)
+                ((_ . keys) keys)
+                (#f '()))))
+         (generate-keys
+          other-user-keys
+          (vhash-cons user `(,keys ,@existing) by-user)))))))
 
 (define openssh-service-type
   (service-type (name 'openssh)
-- 
2.33.1

Vivien

Reply via email to