diff options
Diffstat (limited to 'tw/services/secrets.scm')
| -rw-r--r-- | tw/services/secrets.scm | 169 |
1 files changed, 169 insertions, 0 deletions
diff --git a/tw/services/secrets.scm b/tw/services/secrets.scm new file mode 100644 index 00000000..41c26678 --- /dev/null +++ b/tw/services/secrets.scm @@ -0,0 +1,169 @@ +(define-module (tw services secrets) + #:use-module (gnu) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix packages) + #:use-module ((guix records) #:select (match-record)) + #:use-module (srfi srfi-1) + #:export (secrets-service-type + secrets-configuration + secret + encsecret-program)) + +(define-configuration/no-serialization secret + (encrypted-file file-like "The file in the Guix store containing the +encrypted secret.") + (destination string "The file path into which the secret will be decrypted.") + (user (string "root") "The UNIX user owning the resulting decrypted file.") + (group (string "root") "The UNIX group owning the resulting decrypted file.") + (permissions (integer #o600) "UNIX file permissions for the resulting +decrypted file. Accessible only by the file's owning user by default.")) + +(define (list-of-secrets? thing) + (and (list? thing) + (every secret? thing))) + +(define-configuration/no-serialization secrets-configuration + (host-key (string "/etc/secrets.key") "The path to a file containing the +decryption key for the given secrets.") + (secrets (list-of-secrets '()) "A list of @code{secret} records ")) + +(define (secrets-activation config) + (match-record config <secrets-configuration> (host-key secrets) + (with-imported-modules (source-module-closure + '((guix base64) + (guix build utils))) + (with-extensions (list guile-sodium) + #~(begin + (use-modules (ice-9 format) + (ice-9 ports) + (ice-9 binary-ports) + (ice-9 textual-ports) + (rnrs bytevectors) + (srfi srfi-26) + (guix base64) + ((guix build utils) #:select (mkdir-p)) + (sodium stream)) + (define (install contents destination user group permissions) + (format (current-error-port) "Installing secret (~4,'0o ~a:~a) at ~a~%" + permissions user group destination) + (mkdir-p (dirname destination)) + (let ((port (open-file destination "wb"))) + (with-exception-handler + (lambda (exn) + (close port) + (raise-exception exn)) + (lambda () + ;; Change permissions before writing contents to avoid exposing + ;; the secret in the meantime. + (chown port (passwd:uid (getpw user)) (group:gid (getgr group))) + (chmod port permissions) + (put-bytevector port contents) + (close port))))) + ;; Generate a new host key if none exists yet. + ;; This allows instantiating this service with an empty list of + ;; secrets to generate a host key, and later add secrets. + (unless (file-exists? #$host-key) + (format (current-error-port) + "No host key found at ~a; creating one now~%" #$host-key) + (install (call-with-input-file "/dev/urandom" + (cut get-bytevector-n <> (crypto-stream-chacha20-ietf-keybytes))) + #$host-key "root" "root" #o600)) + (define host-key + (call-with-input-file #$host-key get-bytevector-all #:binary #t)) + (unless (= (crypto-stream-chacha20-ietf-keybytes) + (bytevector-length host-key)) + (error "Invalid key detected; expected ~d bytes but got ~d bytes." + (crypto-stream-chacha20-ietf-keybytes) + (bytevector-length host-key))) + (define nonce + ;; In practice, `crypto-stream-chacha20-ietf-xor' is limited to + ;; 256 GiB of data for each (key, nonce) pair, but secrets are + ;; expected to be small, so it's fine to use the same nonce. + (make-bytevector (crypto-stream-chacha20-ietf-noncebytes) 0)) + (define (decrypt encrypted-file) + (crypto-stream-chacha20-ietf-xor + #:message + (base64-decode + (string-delete ; `base64-decode' doesn't tolerate any whitespace + char-whitespace? + (call-with-input-file encrypted-file get-string-all))) + #:nonce nonce #:key host-key)) + #$@(map (lambda (secret) + (match-record secret <secret> (encrypted-file destination user group permissions) + #~(install (decrypt #$encrypted-file) #$destination #$user #$group #$permissions))) + secrets)))))) + +(define secrets-service-type + (service-type + (name 'secrets) + (extensions (list (service-extension activation-service-type secrets-activation))) + ;; `compose' is applied to unify all extensions into one first, ... + (compose concatenate) + ;; ...then `extend' combines the extensions with the initial config. + (extend (lambda (config more-secrets) + (secrets-configuration + (inherit config) + (secrets (append (secrets-configuration-secrets config) + more-secrets))))) + (default-value (secrets-configuration)) + (description "Install files containing secrets on the system."))) + +;; The following can be installed e.g. in "~/.local/bin" and used to import +;; secrets into local-files in a Guix channel. +(define encsecret-program + (program-file "encsecret" + (with-imported-modules (source-module-closure + '((guix base64))) + (with-extensions (list guile-sodium) + #~(begin + (use-modules (ice-9 match) + (ice-9 ports) + (ice-9 binary-ports) + (rnrs bytevectors) + (guix base64) + (sodium stream)) + (define (main key-port) + (let ((cryptotext + (crypto-stream-chacha20-ietf-xor + #:message (get-bytevector-all (current-input-port)) + #:nonce (make-bytevector (crypto-stream-chacha20-ietf-noncebytes) 0) + #:key (get-bytevector-all key-port)))) + (base64-encode cryptotext 0 (bytevector-length cryptotext) + #f #f base64-alphabet (current-output-port))) + (newline (current-output-port))) + + (define (help-message program-name) + (string-append "\ +usage: " (basename program-name) " [-h] KEY_FILE + +This utility encrypts data passed on stdin to stdout using the given key file, +in a way that the output can be decrypted with the same key file by the Guix +secrets-service-type. Symmetric encryption is used. Processing this utility's +base64-decoded output with the same key results in the original plaintext. + +arguments: + -h, --help show this message and exit + KEY_FILE the file containing the encryption key; required +")) + + (match (program-arguments) + ((program-name + . (? (lambda (args) + (or (member "-h" args) + (member "--help" args))) + _)) + (display (help-message program-name))) + + ((_ key-file) + (call-with-input-file key-file main #:binary #t)) + + ((program-name . _) + (display "error: invalid number of arguments\n\n" + (current-error-port)) + (display (help-message program-name) + (current-error-port)) + (exit 1)))))))) |