summaryrefslogtreecommitdiff
path: root/vkraus/services/guix-wot.scm
diff options
context:
space:
mode:
Diffstat (limited to 'vkraus/services/guix-wot.scm')
-rw-r--r--vkraus/services/guix-wot.scm86
1 files changed, 9 insertions, 77 deletions
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?