blob: 41c26678f07e28cc8cdb335dd0f8673380bb3b68 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
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))))))))
|
