Commit | Line | Data |
---|---|---|
0f41c26f | 1 | ;;; GNU Guix --- Functional package management for GNU |
70a7a1b5 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org> |
d2d8779b | 3 | ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> |
0f41c26f LC |
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 (guix nar) | |
0f41c26f | 21 | #:use-module (guix serialization) |
4e0ea3eb | 22 | #:use-module (guix build syscalls) |
cd4027fa LC |
23 | #:use-module ((guix build utils) |
24 | #:select (delete-file-recursively with-directory-excursion)) | |
1afe1985 LC |
25 | |
26 | ;; XXX: Eventually we should use (guix store database) exclusively, and not | |
27 | ;; (guix store) since this is "daemon-side" code. | |
cd4027fa | 28 | #:use-module (guix store) |
df2f6400 | 29 | #:use-module (guix store database) |
1afe1985 | 30 | |
cd4027fa | 31 | #:use-module (guix ui) ; for '_' |
ca719424 | 32 | #:use-module (gcrypt hash) |
cd4027fa | 33 | #:use-module (guix pki) |
ca719424 | 34 | #:use-module (gcrypt pk-crypto) |
0f41c26f | 35 | #:use-module (srfi srfi-1) |
cd4027fa | 36 | #:use-module (srfi srfi-11) |
0f41c26f | 37 | #:use-module (srfi srfi-26) |
53c63ee9 LC |
38 | #:use-module (srfi srfi-34) |
39 | #:use-module (srfi srfi-35) | |
0363991a | 40 | #:export (nar-invalid-hash-error? |
cd4027fa LC |
41 | nar-invalid-hash-error-expected |
42 | nar-invalid-hash-error-actual | |
43 | ||
44 | nar-signature-error? | |
45 | nar-signature-error-signature | |
46 | ||
cd4027fa | 47 | restore-file-set)) |
0f41c26f LC |
48 | |
49 | ;;; Comment: | |
50 | ;;; | |
51 | ;;; Read and write Nix archives, aka. ‘nar’. | |
52 | ;;; | |
53 | ;;; Code: | |
54 | ||
cd4027fa LC |
55 | (define-condition-type &nar-signature-error &nar-error |
56 | nar-signature-error? | |
57 | (signature nar-signature-error-signature)) ; faulty signature or #f | |
53c63ee9 | 58 | |
cd4027fa LC |
59 | (define-condition-type &nar-invalid-hash-error &nar-signature-error |
60 | nar-invalid-hash-error? | |
61 | (expected nar-invalid-hash-error-expected) ; expected hash (a bytevector) | |
62 | (actual nar-invalid-hash-error-actual)) ; actual hash | |
63 | ||
53c63ee9 | 64 | |
cd4027fa LC |
65 | \f |
66 | ;;; | |
67 | ;;; Restoring a file set into the store. | |
68 | ;;; | |
69 | ||
70 | ;; The code below accesses the store directly and is meant to be run from | |
71 | ;; "build hooks", which cannot invoke the daemon's 'import-paths' RPC since | |
72 | ;; (1) the locks on the files to be restored as already held, and (2) the | |
73 | ;; $NIX_HELD_LOCKS hackish environment variable cannot be set. | |
74 | ;; | |
75 | ;; So we're really duplicating that functionality of the daemon (well, until | |
76 | ;; most of the daemon is in Scheme :-)). But note that we do use a couple of | |
77 | ;; RPCs for functionality not available otherwise, like 'valid-path?'. | |
78 | ||
cd4027fa LC |
79 | (define* (finalize-store-file source target |
80 | #:key (references '()) deriver (lock? #t)) | |
81 | "Rename SOURCE to TARGET and register TARGET as a valid store item, with | |
82 | REFERENCES and DERIVER. When LOCK? is true, acquire exclusive locks on TARGET | |
83 | before attempting to register it; otherwise, assume TARGET's locks are already | |
84 | held." | |
1afe1985 LC |
85 | (with-database %default-database-file db |
86 | (unless (path-id db target) | |
70a7a1b5 LC |
87 | (let ((lock (and lock? |
88 | (lock-file (string-append target ".lock"))))) | |
cd4027fa | 89 | |
70a7a1b5 LC |
90 | (unless (path-id db target) |
91 | ;; If FILE already exists, delete it (it's invalid anyway.) | |
92 | (when (file-exists? target) | |
93 | (delete-file-recursively target)) | |
cd4027fa | 94 | |
70a7a1b5 LC |
95 | ;; Install the new TARGET. |
96 | (rename-file source target) | |
cd4027fa | 97 | |
70a7a1b5 LC |
98 | ;; Register TARGET. As a side effect, it resets the timestamps of all |
99 | ;; its files, recursively, and runs a deduplication pass. | |
100 | (register-path target | |
101 | #:references references | |
102 | #:deriver deriver)) | |
cd4027fa | 103 | |
70a7a1b5 LC |
104 | (when lock? |
105 | (unlock-file lock)))))) | |
cd4027fa | 106 | |
6071b55e | 107 | (define (temporary-store-file) |
50db7d82 | 108 | "Return the file name of a temporary file created in the store." |
cd4027fa LC |
109 | (let* ((template (string-append (%store-prefix) "/guix-XXXXXX")) |
110 | (port (mkstemp! template))) | |
111 | (close-port port) | |
50db7d82 | 112 | template)) |
6071b55e LC |
113 | |
114 | (define-syntax-rule (with-temporary-store-file name body ...) | |
115 | "Evaluate BODY with NAME bound to the file name of a temporary store item | |
116 | protected from GC." | |
50db7d82 LC |
117 | (let loop ((name (temporary-store-file))) |
118 | (with-store store | |
119 | ;; Add NAME to the current process' roots. (Opening this connection to | |
120 | ;; the daemon allows us to reuse its code that deals with the | |
121 | ;; per-process roots file.) | |
122 | (add-temp-root store name) | |
123 | ||
124 | ;; There's a window during which GC could delete NAME. Try again when | |
125 | ;; that happens. | |
126 | (if (file-exists? name) | |
127 | (begin | |
128 | (delete-file name) | |
129 | body ...) | |
130 | (loop (temporary-store-file)))))) | |
6071b55e LC |
131 | |
132 | (define* (restore-one-item port | |
133 | #:key acl (verify-signature? #t) (lock? #t) | |
cd4027fa | 134 | (log-port (current-error-port))) |
6071b55e | 135 | "Restore one store item from PORT; return its file name on success." |
cd4027fa LC |
136 | |
137 | (define (assert-valid-signature signature hash file) | |
24194b6b NK |
138 | ;; Bail out if SIGNATURE, which must be a string as produced by |
139 | ;; 'canonical-sexp->string', doesn't match HASH, a bytevector containing | |
140 | ;; the expected hash for FILE. | |
e4687a5e LC |
141 | (let ((signature (catch 'gcry-error |
142 | (lambda () | |
143 | (string->canonical-sexp signature)) | |
6ef3644e | 144 | (lambda (key proc err) |
e4687a5e LC |
145 | (raise (condition |
146 | (&message | |
147 | (message "signature is not a valid \ | |
cd4027fa | 148 | s-expression")) |
e4687a5e LC |
149 | (&nar-signature-error |
150 | (file file) | |
151 | (signature signature) (port port)))))))) | |
152 | (signature-case (signature hash (current-acl)) | |
153 | (valid-signature #t) | |
154 | (invalid-signature | |
155 | (raise (condition | |
156 | (&message (message "invalid signature")) | |
157 | (&nar-signature-error | |
158 | (file file) (signature signature) (port port))))) | |
159 | (hash-mismatch | |
160 | (raise (condition (&message (message "invalid hash")) | |
161 | (&nar-invalid-hash-error | |
162 | (port port) (file file) | |
163 | (signature signature) | |
164 | (expected (hash-data->bytevector | |
165 | (signature-signed-data signature))) | |
166 | (actual hash))))) | |
167 | (unauthorized-key | |
168 | (raise (condition (&message (message "unauthorized public key")) | |
169 | (&nar-signature-error | |
170 | (signature signature) (file file) (port port))))) | |
171 | (corrupt-signature | |
172 | (raise (condition | |
173 | (&message (message "corrupt signature data")) | |
174 | (&nar-signature-error | |
175 | (signature signature) (file file) (port port)))))))) | |
cd4027fa | 176 | |
6071b55e LC |
177 | (define %export-magic |
178 | ;; Number used to identify genuine file set archives. | |
179 | #x4558494e) | |
180 | ||
181 | (define port* | |
182 | ;; Keep that one around, for error conditions. | |
183 | port) | |
184 | ||
185 | (let-values (((port get-hash) | |
186 | (open-sha256-input-port port))) | |
187 | (with-temporary-store-file temp | |
188 | (restore-file port temp) | |
189 | ||
190 | (let ((magic (read-int port))) | |
191 | (unless (= magic %export-magic) | |
192 | (raise (condition | |
193 | (&message (message "corrupt file set archive")) | |
194 | (&nar-read-error | |
195 | (port port*) (file #f) (token #f)))))) | |
196 | ||
197 | (let ((file (read-store-path port)) | |
198 | (refs (read-store-path-list port)) | |
199 | (deriver (read-string port)) | |
200 | (hash (get-hash)) | |
201 | (has-sig? (= 1 (read-int port)))) | |
202 | (format log-port | |
69daee23 | 203 | (G_ "importing file or directory '~a'...~%") |
6071b55e LC |
204 | file) |
205 | ||
71c1d528 LC |
206 | ;; The signature may contain characters that are meant to be |
207 | ;; interpreted as bytes in a 'char *', so read them as a ISO-8859-1. | |
208 | (let ((sig (and has-sig? (read-latin1-string port)))) | |
6071b55e LC |
209 | (when verify-signature? |
210 | (if sig | |
211 | (begin | |
212 | (assert-valid-signature sig hash file) | |
213 | (format log-port | |
69daee23 | 214 | (G_ "found valid signature for '~a'~%") |
6071b55e LC |
215 | file) |
216 | (finalize-store-file temp file | |
217 | #:references refs | |
218 | #:deriver deriver | |
219 | #:lock? lock?)) | |
220 | (raise (condition | |
221 | (&message (message "imported file lacks \ | |
222 | a signature")) | |
223 | (&nar-signature-error | |
224 | (port port*) (file file) (signature #f)))))) | |
225 | file))))) | |
226 | ||
227 | (define* (restore-file-set port | |
228 | #:key (verify-signature? #t) (lock? #t) | |
229 | (log-port (current-error-port))) | |
230 | "Restore the file set read from PORT to the store. The format of the data | |
231 | on PORT must be as created by 'export-paths'---i.e., a series of Nar-formatted | |
232 | archives with interspersed meta-data joining them together, possibly with a | |
233 | digital signature at the end. Log progress to LOG-PORT. Return the list of | |
234 | files restored. | |
235 | ||
236 | When LOCK? is #f, assume locks for the files to be restored are already held. | |
237 | This is the case when the daemon calls a build hook. | |
238 | ||
239 | Note that this procedure accesses the store directly, so it's only meant to be | |
240 | used by the daemon's build hooks since they cannot call back to the daemon | |
241 | while the locks are held." | |
242 | (define acl | |
243 | (current-acl)) | |
244 | ||
cd4027fa LC |
245 | (let loop ((n (read-long-long port)) |
246 | (files '())) | |
247 | (case n | |
248 | ((0) | |
249 | (reverse files)) | |
250 | ((1) | |
6071b55e LC |
251 | (let ((file |
252 | (restore-one-item port | |
253 | #:acl acl #:verify-signature? verify-signature? | |
254 | #:lock? lock? #:log-port log-port))) | |
255 | (loop (read-long-long port) | |
256 | (cons file files)))) | |
cd4027fa LC |
257 | (else |
258 | ;; Neither 0 nor 1. | |
259 | (raise (condition | |
260 | (&message (message "invalid inter-file archive mark")) | |
261 | (&nar-read-error | |
262 | (port port) (file #f) (token #f)))))))) | |
263 | ||
6071b55e LC |
264 | ;;; Local Variables: |
265 | ;;; eval: (put 'with-temporary-store-file 'scheme-indent-function 1) | |
266 | ;;; End: | |
267 | ||
0f41c26f | 268 | ;;; nar.scm ends here |