Commit | Line | Data |
---|---|---|
ec32d4f2 JN |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | |
4 | ;;; | |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu build secret-service) | |
21 | #:use-module (guix build utils) | |
22 | ||
23 | #:use-module (srfi srfi-26) | |
24 | #:use-module (rnrs bytevectors) | |
25 | #:use-module (ice-9 binary-ports) | |
26 | #:use-module (ice-9 match) | |
27 | #:use-module (ice-9 rdelim) | |
28 | ||
29 | #:export (secret-service-receive-secrets | |
30 | secret-service-send-secrets)) | |
31 | ||
32 | ;;; Commentary: | |
33 | ;;; | |
34 | ;;; Utility procedures for copying secrets into a VM. | |
35 | ;;; | |
36 | ;;; Code: | |
37 | ||
38 | (define* (secret-service-send-secrets port secret-root #:key (retry 60)) | |
39 | "Copy all files under SECRET-ROOT using TCP to secret-service listening at | |
40 | local PORT. If connect fails, sleep 1s and retry RETRY times." | |
41 | ||
42 | (define (file->file+size+mode file-name) | |
43 | (let ((stat (stat file-name)) | |
44 | (target (substring file-name (string-length secret-root)))) | |
45 | (list target (stat:size stat) (stat:mode stat)))) | |
46 | ||
47 | (format (current-error-port) "sending secrets to ~a~%" port) | |
48 | (let ((sock (socket AF_INET SOCK_STREAM 0)) | |
49 | (addr (make-socket-address AF_INET INADDR_LOOPBACK port))) | |
50 | ;; connect to wait for port | |
51 | (let loop ((retry retry)) | |
52 | (catch 'system-error | |
53 | (cute connect sock addr) | |
54 | (lambda (key . args) | |
55 | (when (zero? retry) | |
56 | (apply throw key args)) | |
118b6dbb LC |
57 | (format (current-error-port) |
58 | "secret service: retrying connection [~a attempts left]~%" | |
59 | (- retry 1)) | |
ec32d4f2 JN |
60 | (sleep 1) |
61 | (loop (1- retry))))) | |
62 | ||
118b6dbb LC |
63 | (format (current-error-port) |
64 | "secret service: connected; sending files in ~s~%" | |
ec32d4f2 JN |
65 | secret-root) |
66 | (let* ((files (if secret-root (find-files secret-root) '())) | |
67 | (files-sizes-modes (map file->file+size+mode files)) | |
68 | (secrets `(secrets | |
69 | (version 0) | |
70 | (files ,files-sizes-modes)))) | |
71 | (write secrets sock) | |
72 | (for-each (compose (cute dump-port <> sock) | |
73 | (cute open-input-file <>)) | |
74 | files)))) | |
75 | ||
76 | (define (secret-service-receive-secrets port) | |
77 | "Listen to local PORT and wait for a secret service client to send secrets. | |
78 | Write them to the file system." | |
79 | ||
80 | (define (wait-for-client port) | |
81 | ;; Wait for a TCP connection on PORT. Note: We cannot use the | |
82 | ;; virtio-serial ports, which would be safer, because they are | |
83 | ;; (presumably) unsupported on GNU/Hurd. | |
84 | (let ((sock (socket AF_INET SOCK_STREAM 0))) | |
85 | (bind sock AF_INET INADDR_ANY port) | |
86 | (listen sock 1) | |
87 | (format (current-error-port) | |
118b6dbb | 88 | "secret service: waiting for secrets on port ~a...~%" |
ec32d4f2 JN |
89 | port) |
90 | (match (accept sock) | |
91 | ((client . address) | |
118b6dbb LC |
92 | (format (current-error-port) |
93 | "secret service: client connection from ~a~%" | |
ec32d4f2 JN |
94 | (inet-ntop (sockaddr:fam address) |
95 | (sockaddr:addr address))) | |
96 | (close-port sock) | |
97 | client)))) | |
98 | ||
99 | ;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size' | |
100 | ;; parameter. | |
101 | (define (dump in out size) | |
102 | ;; Copy SIZE bytes from IN to OUT. | |
103 | (define buf-size 65536) | |
104 | (define buf (make-bytevector buf-size)) | |
105 | ||
106 | (let loop ((left size)) | |
107 | (if (<= left 0) | |
108 | 0 | |
109 | (let ((read (get-bytevector-n! in buf 0 (min left buf-size)))) | |
110 | (if (eof-object? read) | |
111 | left | |
112 | (begin | |
113 | (put-bytevector out buf 0 read) | |
114 | (loop (- left read)))))))) | |
115 | ||
116 | (define (read-secrets port) | |
117 | ;; Read secret files from PORT and install them. | |
118 | (match (false-if-exception (read port)) | |
119 | (('secrets ('version 0) | |
120 | ('files ((files sizes modes) ...))) | |
121 | (for-each (lambda (file size mode) | |
122 | (format (current-error-port) | |
118b6dbb LC |
123 | "secret service: \ |
124 | installing file '~a' (~a bytes)...~%" | |
ec32d4f2 JN |
125 | file size) |
126 | (mkdir-p (dirname file)) | |
127 | (call-with-output-file file | |
128 | (lambda (output) | |
129 | (dump port output size) | |
130 | (chmod file mode)))) | |
131 | files sizes modes)) | |
132 | (_ | |
133 | (format (current-error-port) | |
118b6dbb | 134 | "secret service: invalid secrets received~%") |
ec32d4f2 JN |
135 | #f))) |
136 | ||
137 | (let* ((port (wait-for-client port)) | |
138 | (result (read-secrets port))) | |
139 | (close-port port) | |
140 | result)) | |
141 | ||
142 | ;;; secret-service.scm ends here |