From ae9265b80a20498b85b72ce4b58d41db86503864 Mon Sep 17 00:00:00 2001
From: Vivien <vivien@pruneau.lan>
Date: Sun, 7 Nov 2021 15:41:34 +0100
Subject: System: use a mcron service to sync the keys

---
 vkraus/services/guix-wot.scm | 86 +++++---------------------------------------
 1 file changed, 9 insertions(+), 77 deletions(-)

(limited to 'vkraus/services/guix-wot.scm')

diff --git a/vkraus/services/guix-wot.scm b/vkraus/services/guix-wot.scm
index 5b53f9c..17880f6 100644
--- a/vkraus/services/guix-wot.scm
+++ b/vkraus/services/guix-wot.scm
@@ -1,8 +1,10 @@
 (define-module (vkraus services guix-wot)
+  #:use-module (vkraus services guix-wot-system)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services ssh)
   #:use-module (gnu services admin)
+  #:use-module (gnu services mcron)
   #:use-module (gnu home services)
   #:use-module (gnu home services shells)
   #:use-module (gnu system shadow)
@@ -26,20 +28,19 @@
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 receive)
   #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (oop goops)
   #:declarative? #t
   #:duplicates (merge-generics)
-  #:export
+  #:re-export
   (
    <guix-system-wot-configuration>
-   make-guix-system-wot-configuration
-   guix-system-wot-configuration?
-   guix-system-wot-configuration-users
-   guix-system-wot-configuration-key-servers
-
-   guix-system-wot-openssh
+   users key-servers
    guix-system-wot-service-type
-
+   )
+  #:export
+  (
    <guix-home-wot-configuration>
    make-guix-home-wot-configuration
    guix-home-wot-configuration?
@@ -51,75 +52,6 @@
    guix-home-wot-service-type
    ))
 
-;; This module defines a guix system service that converts GPG key
-;; fingerprints to authorized SSH keys. The public keys are pulled
-;; from key servers at reconfiguration time.
-
-(define-record-type <guix-system-wot-configuration>
-  (make-guix-system-wot-configuration users key-servers)
-  guix-system-wot-configuration?
-  (users guix-system-wot-configuration-users)
-  (key-servers guix-system-wot-configuration-key-servers))
-
-(define guix-system-wot-openssh
-  ;; This service will export all approved authentication keys for the
-  ;; openssh server to use.
-  (match-lambda
-    (($ <guix-system-wot-configuration> users key-servers)
-     (run-with-store
-      (open-connection)
-      (mlet %store-monad ((gpg (package-file gnupg "/bin/gpg")))
-            (apply invoke
-                   `(,gpg
-                     ,@(apply append
-                              (map
-                               (lambda (key-server)
-                                 `("--keyserver" ,key-server))
-                               key-servers))
-                     "--recv-key"
-                     ,@(map cdr users)))))
-     (par-map
-      (match-lambda
-        ((user . fingerprint)
-         `(,user
-           ,(let ((port (mkstemp "/tmp/user-key-file-XXXXXXXX")))
-              (with-exception-handler
-                  (lambda (exn)
-                    (format (current-error-port) "Warning: no SSH key exported for ~a ~a: ~a.\n" user fingerprint exn))
-                (lambda ()
-                  (run-with-store
-                   (open-connection)
-                   (mlet %store-monad ((gpg (package-file gnupg "/bin/gpg")))
-                         (invoke  gpg
-                                  "-o" (port-filename port)
-                                  "--export-ssh-key" fingerprint))))
-                #:unwind? #t)
-              (let ((interned
-                     (plain-file (format #f "user-key-file-~a" fingerprint)
-                                 (get-string-all port))))
-                (delete-file (port-filename port))
-                interned)))))
-      users))))
-
-(define guix-system-wot-service-type
-  (service-type
-   (name 'guix-system-wot)
-   (extensions
-    (list
-     (service-extension openssh-service-type guix-system-wot-openssh)))
-   (compose
-    (lambda (extensions)
-      (apply append extensions)))
-   (extend
-    (lambda (base-configuration other-users)
-      (make-guix-system-wot-configuration
-       (append (guix-system-wot-configuration-users base-configuration)
-           other-users)
-       (guix-system-wot-configuration-key-servers base-configuration))))
-   (description
-    (format #f "Add every available authentication keys for each user
-as an auhorized SSH key."))))
-
 (define-record-type <guix-home-wot-configuration>
   (make-guix-home-wot-configuration fingerprints)
   guix-home-wot-configuration?
-- 
cgit v1.2.3