summaryrefslogtreecommitdiff
path: root/vkraus
diff options
context:
space:
mode:
authorVivien <vivien@pruneau.lan>2021-11-07 15:41:34 +0100
committerVivien <vivien@pruneau.lan>2021-11-07 21:46:35 +0100
commitae9265b80a20498b85b72ce4b58d41db86503864 (patch)
tree308cb8d5710d35f311657682d9051aa65aa20d5e /vkraus
parent3b4427522e01e8f537a7b3a922854167a70e1ecd (diff)
System: use a mcron service to sync the keysHEADmaster
Diffstat (limited to 'vkraus')
-rw-r--r--vkraus/services/guix-wot-system.scm174
-rw-r--r--vkraus/services/guix-wot.scm86
2 files changed, 183 insertions, 77 deletions
diff --git a/vkraus/services/guix-wot-system.scm b/vkraus/services/guix-wot-system.scm
new file mode 100644
index 0000000..45c408f
--- /dev/null
+++ b/vkraus/services/guix-wot-system.scm
@@ -0,0 +1,174 @@
+(define-module (vkraus services guix-wot-system)
+ #:use-module (gnu services)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu services ssh)
+ #:use-module (gnu services mcron)
+ #:use-module (guix gexp)
+ #:use-module (guix modules)
+ #:use-module (guix packages)
+ #:use-module (guix build utils)
+ #:use-module (gnu packages gnupg)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 optargs)
+ #:use-module (ice-9 threads)
+ #:use-module (ice-9 textual-ports)
+ #:use-module (ice-9 receive)
+ #:use-module (oop goops)
+ #:declarative? #t
+ #:export
+ (
+ <guix-system-wot-configuration>
+ users key-servers
+ guix-system-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 gpg-program
+ (file-append gnupg "/bin/gpg"))
+
+(define-class <guix-system-wot-configuration> ()
+ (users
+ #:init-keyword #:users
+ #:accessor users
+ #:init-value '())
+ (public-keys-file
+ #:init-keyword #:public-keys-file
+ #:accessor public-keys-file
+ #:init-value "/var/lib/user-keys.gpg")
+ (key-servers
+ #:init-keyword #:key-servers
+ #:accessor key-servers
+ #:init-value '()))
+
+(define-method (+ (main <guix-system-wot-configuration>)
+ (other <guix-system-wot-configuration>))
+ (let ((ret (shallow-clone main)))
+ (set! (users ret)
+ (append (users main) (users other)))
+ (unless (public-keys-file ret)
+ (set! (public-keys-file ret)
+ (public-keys-file other)))
+ (set! (key-servers ret)
+ (append (key-servers main) (key-servers other)))
+ ret))
+
+(define (sync-script configuration)
+ (program-file
+ "update-keys"
+ (with-imported-modules
+ (source-module-closure
+ '((guix build utils)))
+ #~(begin
+ (use-modules (guix build utils))
+ (let ((gpg #$gpg-program)
+ (all-public-keys
+ (list
+ #$@(apply append
+ (map (match-lambda
+ (((? string?) . (? string? fingerprint))
+ (list fingerprint))
+ (((? string?) (? string? fingerprint) ...)
+ fingerprint))
+ (users configuration)))))
+ (file #$(public-keys-file configuration)))
+ (mkdir-p ".tmp-gnupg-home")
+ (setenv "GNUPGHOME" (string-append (getcwd) "/.tmp-gnupg-home"))
+ (catch #t
+ (lambda ()
+ (invoke gpg "--import" file))
+ (lambda _ #t))
+ (apply invoke gpg
+ #$@(apply append
+ (map (cute list "--keyserver" <>)
+ (key-servers configuration)))
+ "--recv-key"
+ all-public-keys)
+ (catch #t
+ (lambda ()
+ (delete-file (string-append file "~")))
+ (lambda _ #t))
+ (apply invoke gpg "--export" "-o" (string-append file "~") all-public-keys)
+ (catch #t
+ (lambda ()
+ (delete-file (string-append (getcwd) "/.tmp-gnupg-home")))
+ (lambda _ #t))
+ (rename-file (string-append file "~") file))))))
+
+(define (guix-system-wot-mcron-service configuration)
+ (let ((script (sync-script configuration)))
+ (list
+ (with-imported-modules
+ (source-module-closure
+ '((guix build utils)))
+ #~(job '(next-hour)
+ (lambda ()
+ #$script))))))
+
+(define (guix-system-wot-openssh-service configuration)
+ (let ((script (sync-script configuration)))
+ (map
+ (lambda (record)
+ (receive (user fingerprints)
+ (match record
+ ((user . fingerprint)
+ (values user (list fingerprint)))
+ ((user fingerprint ...)
+ (values user fingerprint)))
+ (let ((fingerprint-files
+ (map
+ (lambda (fingerprint)
+ (computed-file
+ (format #f "ssh-key-for-~a" user)
+ (with-imported-modules
+ (source-module-closure
+ '((guix build utils)))
+ #~(begin
+ (use-modules (guix build utils))
+ (format (current-error-port) "To synchronize the keys, please run ~a.\n"
+ #$script)
+ (let ((gpg #$gpg-program)
+ (repository
+ #$(catch #t
+ (lambda ()
+ (local-file (public-keys-file configuration)))
+ (lambda exn
+ (let ((message
+ (format #f "Error: no keys have been downloaded yet. Please run ~a and reconfigure.\n"
+ script)))
+ (display message)
+ (apply throw exn))))))
+ (setenv "GNUPGHOME" (getcwd))
+ (invoke gpg "--import" repository)
+ (mkdir-p (dirname #$output))
+ (invoke gpg "-o" #$output "--export-ssh-key" #$fingerprint))))))
+ fingerprints)))
+ `(,user
+ ,@fingerprint-files))))
+ (users configuration))))
+
+(define guix-system-wot-service-type
+ (service-type
+ (name 'guix-system-wot)
+ (extensions
+ (list
+ (service-extension mcron-service-type guix-system-wot-mcron-service)
+ (service-extension openssh-service-type guix-system-wot-openssh-service)))
+ (compose
+ (lambda (extensions)
+ (apply append extensions)))
+ (extend
+ (lambda (base-configuration other-configurations)
+ (let fold-configurations ((cfgs other-configurations)
+ (total base-configuration))
+ (match cfgs
+ (() total)
+ ((next cfgs ...)
+ (fold-configurations cfgs (+ total next)))))))
+ (description
+ (format #f "Add every available authentication keys for each user
+as an auhorized SSH key."))))
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?