(define-module (vkraus services guix-wot) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services ssh) #:use-module (gnu services admin) #:use-module (gnu system shadow) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix build-system minetest) #:use-module (guix git-download) #:use-module (guix build utils) #:use-module (guix monads) #:use-module (guix store) #:use-module (gnu packages bash) #:use-module (gnu packages minetest) #:use-module (gnu packages admin) #: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 ((guix licenses) #:prefix license:) #:declarative? #t #:duplicates (merge-generics) #: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 guix-system-wot-service-type fetch-keys )) ;; 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 (fetch-keys fingerprints key-servers) (with-imported-modules '((guix build utils)) (gexp->derivation "gnupg-user-keys.gpg" #~(begin (use-modules (guix build utils)) (setenv "GNUPGHOME" (string-append (getcwd) "/gnupg")) (invoke #$(file-append gnupg "/bin/gpg") "--import" "/var/cache/gnupg-user-keys.gpg") (invoke #$(file-append gnupg "/bin/gpg") #$@(apply append (map (lambda (key-server) `("--keyserver" ,key-server)) key-servers)) "--recv-key" #$@fingerprints) (invoke #$(file-append gnupg "/bin/gpg") "--export" "-a" "-o" #$output #$@fingerprints))))) (define guix-system-wot-openssh ;; This service will export all approved authentication keys for the ;; openssh server to use. (match-lambda (($ users key-servers) (apply invoke `(,(run-with-store (open-connection) (package-file gnupg "/bin/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"))) (invoke (run-with-store (open-connection) (package-file gnupg "/bin/gpg")) "-o" (port-filename port) "--export-ssh-key" fingerprint) (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."))))