From ae9265b80a20498b85b72ce4b58d41db86503864 Mon Sep 17 00:00:00 2001 From: Vivien Date: Sun, 7 Nov 2021 15:41:34 +0100 Subject: System: use a mcron service to sync the keys --- vkraus/services/guix-wot-system.scm | 174 ++++++++++++++++++++++++++++++++++++ vkraus/services/guix-wot.scm | 86 ++---------------- 2 files changed, 183 insertions(+), 77 deletions(-) create mode 100644 vkraus/services/guix-wot-system.scm 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 + ( + + 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 () + (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 ) + (other )) + (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 ( - 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 + ( 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 - (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 - (($ 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 (make-guix-home-wot-configuration fingerprints) guix-home-wot-configuration? -- cgit v1.2.3