1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
5 ;;; This file is part of GNU Guix.
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.
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.
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/>.
20 (define-module (guix nar)
21 #:use-module (guix serialization)
22 #:use-module (guix build syscalls)
23 #:use-module ((guix build utils)
24 #:select (delete-file-recursively with-directory-excursion))
25 #:use-module (guix store)
26 #:use-module (guix ui) ; for '_'
27 #:use-module (guix hash)
28 #:use-module (guix pki)
29 #:use-module (guix pk-crypto)
30 #:use-module (srfi srfi-1)
31 #:use-module (srfi srfi-11)
32 #:use-module (srfi srfi-26)
33 #:use-module (srfi srfi-34)
34 #:use-module (srfi srfi-35)
35 #:export (nar-invalid-hash-error?
36 nar-invalid-hash-error-expected
37 nar-invalid-hash-error-actual
40 nar-signature-error-signature
46 ;;; Read and write Nix archives, aka. ‘nar’.
50 (define-condition-type &nar-signature-error &nar-error
52 (signature nar-signature-error-signature)) ; faulty signature or #f
54 (define-condition-type &nar-invalid-hash-error &nar-signature-error
55 nar-invalid-hash-error?
56 (expected nar-invalid-hash-error-expected) ; expected hash (a bytevector)
57 (actual nar-invalid-hash-error-actual)) ; actual hash
62 ;;; Restoring a file set into the store.
65 ;; The code below accesses the store directly and is meant to be run from
66 ;; "build hooks", which cannot invoke the daemon's 'import-paths' RPC since
67 ;; (1) the locks on the files to be restored as already held, and (2) the
68 ;; $NIX_HELD_LOCKS hackish environment variable cannot be set.
70 ;; So we're really duplicating that functionality of the daemon (well, until
71 ;; most of the daemon is in Scheme :-)). But note that we do use a couple of
72 ;; RPCs for functionality not available otherwise, like 'valid-path?'.
74 (define (lock-store-file file)
75 "Acquire exclusive access to FILE, a store file."
76 (call-with-output-file (string-append file ".lock")
77 (cut fcntl-flock <> 'write-lock)))
79 (define (unlock-store-file file)
80 "Release access to FILE."
81 (call-with-input-file (string-append file ".lock")
82 (cut fcntl-flock <> 'unlock)))
84 (define* (finalize-store-file source target
85 #:key (references '()) deriver (lock? #t))
86 "Rename SOURCE to TARGET and register TARGET as a valid store item, with
87 REFERENCES and DERIVER. When LOCK? is true, acquire exclusive locks on TARGET
88 before attempting to register it; otherwise, assume TARGET's locks are already
91 ;; XXX: Currently we have to call out to the daemon to check whether TARGET
94 (unless (valid-path? store target)
96 (lock-store-file target))
98 (unless (valid-path? store target)
99 ;; If FILE already exists, delete it (it's invalid anyway.)
100 (when (file-exists? target)
101 (delete-file-recursively target))
103 ;; Install the new TARGET.
104 (rename-file source target)
106 ;; Register TARGET. As a side effect, it resets the timestamps of all
107 ;; its files, recursively, and runs a deduplication pass.
108 (register-path target
109 #:references references
113 (unlock-store-file target)))))
115 (define (temporary-store-file)
116 "Return the file name of a temporary file created in the store."
117 (let* ((template (string-append (%store-prefix) "/guix-XXXXXX"))
118 (port (mkstemp! template)))
122 (define-syntax-rule (with-temporary-store-file name body ...)
123 "Evaluate BODY with NAME bound to the file name of a temporary store item
125 (let loop ((name (temporary-store-file)))
127 ;; Add NAME to the current process' roots. (Opening this connection to
128 ;; the daemon allows us to reuse its code that deals with the
129 ;; per-process roots file.)
130 (add-temp-root store name)
132 ;; There's a window during which GC could delete NAME. Try again when
134 (if (file-exists? name)
138 (loop (temporary-store-file))))))
140 (define* (restore-one-item port
141 #:key acl (verify-signature? #t) (lock? #t)
142 (log-port (current-error-port)))
143 "Restore one store item from PORT; return its file name on success."
145 (define (assert-valid-signature signature hash file)
146 ;; Bail out if SIGNATURE, which must be a string as produced by
147 ;; 'canonical-sexp->string', doesn't match HASH, a bytevector containing
148 ;; the expected hash for FILE.
149 (let ((signature (catch 'gcry-error
151 (string->canonical-sexp signature))
152 (lambda (key proc err)
155 (message "signature is not a valid \
157 (&nar-signature-error
159 (signature signature) (port port))))))))
160 (signature-case (signature hash (current-acl))
164 (&message (message "invalid signature"))
165 (&nar-signature-error
166 (file file) (signature signature) (port port)))))
168 (raise (condition (&message (message "invalid hash"))
169 (&nar-invalid-hash-error
170 (port port) (file file)
171 (signature signature)
172 (expected (hash-data->bytevector
173 (signature-signed-data signature)))
176 (raise (condition (&message (message "unauthorized public key"))
177 (&nar-signature-error
178 (signature signature) (file file) (port port)))))
181 (&message (message "corrupt signature data"))
182 (&nar-signature-error
183 (signature signature) (file file) (port port))))))))
185 (define %export-magic
186 ;; Number used to identify genuine file set archives.
190 ;; Keep that one around, for error conditions.
193 (let-values (((port get-hash)
194 (open-sha256-input-port port)))
195 (with-temporary-store-file temp
196 (restore-file port temp)
198 (let ((magic (read-int port)))
199 (unless (= magic %export-magic)
201 (&message (message "corrupt file set archive"))
203 (port port*) (file #f) (token #f))))))
205 (let ((file (read-store-path port))
206 (refs (read-store-path-list port))
207 (deriver (read-string port))
209 (has-sig? (= 1 (read-int port))))
211 (G_ "importing file or directory '~a'...~%")
214 ;; The signature may contain characters that are meant to be
215 ;; interpreted as bytes in a 'char *', so read them as a ISO-8859-1.
216 (let ((sig (and has-sig? (read-latin1-string port))))
217 (when verify-signature?
220 (assert-valid-signature sig hash file)
222 (G_ "found valid signature for '~a'~%")
224 (finalize-store-file temp file
229 (&message (message "imported file lacks \
231 (&nar-signature-error
232 (port port*) (file file) (signature #f))))))
235 (define* (restore-file-set port
236 #:key (verify-signature? #t) (lock? #t)
237 (log-port (current-error-port)))
238 "Restore the file set read from PORT to the store. The format of the data
239 on PORT must be as created by 'export-paths'---i.e., a series of Nar-formatted
240 archives with interspersed meta-data joining them together, possibly with a
241 digital signature at the end. Log progress to LOG-PORT. Return the list of
244 When LOCK? is #f, assume locks for the files to be restored are already held.
245 This is the case when the daemon calls a build hook.
247 Note that this procedure accesses the store directly, so it's only meant to be
248 used by the daemon's build hooks since they cannot call back to the daemon
249 while the locks are held."
253 (let loop ((n (read-long-long port))
260 (restore-one-item port
261 #:acl acl #:verify-signature? verify-signature?
262 #:lock? lock? #:log-port log-port)))
263 (loop (read-long-long port)
268 (&message (message "invalid inter-file archive mark"))
270 (port port) (file #f) (token #f))))))))
273 ;;; eval: (put 'with-temporary-store-file 'scheme-indent-function 1)
276 ;;; nar.scm ends here