Commit | Line | Data |
---|---|---|
e9c6c584 NK |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> | |
434138e2 | 3 | ;;; Copyright © 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> |
e9c6c584 NK |
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 | ||
2c74fde0 LC |
20 | (define-module (test-substitute) |
21 | #:use-module (guix scripts substitute) | |
e9c6c584 | 22 | #:use-module (guix base64) |
ca719424 | 23 | #:use-module (gcrypt hash) |
0363991a | 24 | #:use-module (guix serialization) |
ca719424 | 25 | #:use-module (gcrypt pk-crypto) |
e9c6c584 | 26 | #:use-module (guix pki) |
cdea30e0 | 27 | #:use-module (guix config) |
e903b7c1 | 28 | #:use-module (guix base32) |
cdea30e0 | 29 | #:use-module ((guix store) #:select (%store-prefix)) |
f84f8590 | 30 | #:use-module ((guix ui) #:select (guix-warning-port)) |
9dfa20a2 LC |
31 | #:use-module ((guix utils) |
32 | #:select (call-with-temporary-directory | |
33 | call-with-compressed-output-port)) | |
a9468b42 | 34 | #:use-module ((guix build utils) |
b90ae065 | 35 | #:select (mkdir-p delete-file-recursively dump-port)) |
a9468b42 | 36 | #:use-module (guix tests http) |
e9c6c584 | 37 | #:use-module (rnrs bytevectors) |
cdea30e0 LC |
38 | #:use-module (rnrs io ports) |
39 | #:use-module (web uri) | |
52f80dfc | 40 | #:use-module (ice-9 regex) |
9dfa20a2 | 41 | #:use-module (srfi srfi-11) |
cdea30e0 | 42 | #:use-module (srfi srfi-26) |
e9c6c584 | 43 | #:use-module (srfi srfi-34) |
52f80dfc | 44 | #:use-module (srfi srfi-35) |
e9c6c584 NK |
45 | #:use-module ((srfi srfi-64) #:hide (test-error))) |
46 | ||
f84f8590 LC |
47 | (define-syntax-rule (test-quit name error-rx exp) |
48 | "Emit a test that passes when EXP throws to 'quit' with value 1, and when | |
49 | it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX." | |
cdea30e0 | 50 | (test-equal name |
f84f8590 LC |
51 | '(1 #t) |
52 | (let ((error-output (open-output-string))) | |
79c6614f LC |
53 | (parameterize ((current-error-port error-output) |
54 | (guix-warning-port error-output)) | |
f84f8590 LC |
55 | (catch 'quit |
56 | (lambda () | |
57 | exp | |
58 | #f) | |
59 | (lambda (key value) | |
60 | (list value | |
61 | (let ((message (get-output-string error-output))) | |
62 | (->bool (string-match error-rx message)))))))))) | |
e9c6c584 | 63 | |
711df9ef LC |
64 | (define (request-substitution item destination) |
65 | "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION." | |
66 | (parameterize ((guix-warning-port (current-error-port))) | |
67 | (with-input-from-string (string-append "substitute " item " " | |
68 | destination "\n") | |
69 | (lambda () | |
70 | (guix-substitute "--substitute"))))) | |
71 | ||
e9c6c584 | 72 | (define %public-key |
cdea30e0 LC |
73 | ;; This key is known to be in the ACL by default. |
74 | (call-with-input-file (string-append %config-directory "/signing-key.pub") | |
75 | (compose string->canonical-sexp get-string-all))) | |
e9c6c584 NK |
76 | |
77 | (define %private-key | |
cdea30e0 LC |
78 | (call-with-input-file (string-append %config-directory "/signing-key.sec") |
79 | (compose string->canonical-sexp get-string-all))) | |
e9c6c584 | 80 | |
52f80dfc LC |
81 | (define* (signature-body bv #:key (public-key %public-key)) |
82 | "Return the signature of BV as the base64-encoded body of a narinfo's | |
cdea30e0 | 83 | 'Signature' field." |
e9c6c584 NK |
84 | (base64-encode |
85 | (string->utf8 | |
86 | (canonical-sexp->string | |
52f80dfc | 87 | (signature-sexp (bytevector->hash-data (sha256 bv) |
e9c6c584 NK |
88 | #:key-type 'rsa) |
89 | %private-key | |
cdea30e0 | 90 | public-key))))) |
e9c6c584 | 91 | |
e9c6c584 NK |
92 | (define %wrong-public-key |
93 | (string->canonical-sexp "(public-key | |
94 | (rsa | |
95 | (n #00E05873AC2B168760343145918E954EE9AB73C026355693B192E01EE835261AA689E9EF46642E895BCD65C648524059FC450E4BA77A68F4C52D0E39EF0CC9359709AB6AAB153B63782201871325B0FDA19CB401CD99FD0C31A91CA9000AA90A77E82B89E036FB63BC1D3961207469B3B12468977148D376F8012BB12A4B11A8F1#) | |
96 | (e #010001#) | |
97 | ) | |
98 | )")) | |
99 | ||
52f80dfc LC |
100 | (define* (signature-field bv-or-str |
101 | #:key (version "1") (public-key %public-key)) | |
102 | "Return the 'Signature' field value of bytevector/string BV-OR-STR, using | |
103 | PUBLIC-KEY as the signature's principal, and using VERSION as the signature | |
104 | version identifier.." | |
105 | (string-append version ";example.gnu.org;" | |
106 | (signature-body (if (string? bv-or-str) | |
107 | (string->utf8 bv-or-str) | |
108 | bv-or-str) | |
109 | #:public-key public-key))) | |
110 | ||
e9c6c584 | 111 | |
cdea30e0 | 112 | \f |
2c74fde0 | 113 | (test-begin "substitute") |
e9c6c584 | 114 | |
f84f8590 LC |
115 | (test-quit "not a number" |
116 | "signature version" | |
52f80dfc LC |
117 | (narinfo-signature->canonical-sexp |
118 | (signature-field "foo" #:version "not a number"))) | |
e9c6c584 | 119 | |
f84f8590 LC |
120 | (test-quit "wrong version number" |
121 | "unsupported.*version" | |
52f80dfc LC |
122 | (narinfo-signature->canonical-sexp |
123 | (signature-field "foo" #:version "2"))) | |
e9c6c584 NK |
124 | |
125 | (test-assert "valid narinfo-signature->canonical-sexp" | |
52f80dfc | 126 | (canonical-sexp? (narinfo-signature->canonical-sexp (signature-field "foo")))) |
e9c6c584 | 127 | |
e9c6c584 | 128 | |
cdea30e0 | 129 | \f |
a9468b42 LC |
130 | (define %main-substitute-directory |
131 | ;; The place where 'call-with-narinfo' stores its data by default. | |
132 | (uri-path (string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL")))) | |
133 | ||
134 | (define %alternate-substitute-directory | |
135 | ;; Another place. | |
136 | (string-append (dirname %main-substitute-directory) | |
137 | "/substituter-alt-data")) | |
138 | ||
e9c6c584 | 139 | (define %narinfo |
52f80dfc | 140 | ;; Skeleton of the narinfo used below. |
cdea30e0 LC |
141 | (string-append "StorePath: " (%store-prefix) |
142 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo | |
e903b7c1 LC |
143 | URL: example.nar |
144 | Compression: none | |
145 | NarHash: sha256:" (bytevector->nix-base32-string | |
146 | (sha256 (string->utf8 "Substitutable data."))) " | |
e9c6c584 NK |
147 | NarSize: 42 |
148 | References: bar baz | |
cdea30e0 LC |
149 | Deriver: " (%store-prefix) "/foo.drv |
150 | System: mips64el-linux\n")) | |
e9c6c584 | 151 | |
a9468b42 LC |
152 | (define* (call-with-narinfo narinfo thunk |
153 | #:optional | |
154 | (narinfo-directory %main-substitute-directory)) | |
155 | "Call THUNK in a context where the directory at URL is populated with | |
cdea30e0 | 156 | a file for NARINFO." |
a9468b42 LC |
157 | (mkdir-p narinfo-directory) |
158 | (let ((cache-directory (string-append (getenv "XDG_CACHE_HOME") | |
159 | "/guix/substitute/"))) | |
cdea30e0 LC |
160 | (dynamic-wind |
161 | (lambda () | |
162 | (when (file-exists? cache-directory) | |
163 | (delete-file-recursively cache-directory)) | |
164 | (call-with-output-file (string-append narinfo-directory | |
165 | "/nix-cache-info") | |
166 | (lambda (port) | |
167 | (format port "StoreDir: ~a\nWantMassQuery: 0\n" | |
168 | (%store-prefix)))) | |
169 | (call-with-output-file (string-append narinfo-directory "/" | |
170 | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" | |
171 | ".narinfo") | |
172 | (cut display narinfo <>)) | |
173 | ||
e903b7c1 LC |
174 | ;; Prepare the nar. |
175 | (call-with-output-file | |
176 | (string-append narinfo-directory "/example.out") | |
177 | (cut display "Substitutable data." <>)) | |
178 | (call-with-output-file | |
179 | (string-append narinfo-directory "/example.nar") | |
180 | (cute write-file | |
181 | (string-append narinfo-directory "/example.out") <>)) | |
182 | ||
434138e2 | 183 | (%allow-unauthenticated-substitutes? #f)) |
cdea30e0 LC |
184 | thunk |
185 | (lambda () | |
a9468b42 LC |
186 | (when (file-exists? cache-directory) |
187 | (delete-file-recursively cache-directory)))))) | |
cdea30e0 LC |
188 | |
189 | (define-syntax-rule (with-narinfo narinfo body ...) | |
190 | (call-with-narinfo narinfo (lambda () body ...))) | |
191 | ||
a9468b42 LC |
192 | (define-syntax-rule (with-narinfo* narinfo directory body ...) |
193 | (call-with-narinfo narinfo (lambda () body ...) directory)) | |
194 | ||
2c74fde0 | 195 | ;; Transmit these options to 'guix substitute'. |
218f6ecc | 196 | (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) |
cdea30e0 | 197 | |
711df9ef LC |
198 | ;; Never use file descriptor 4, unlike what happens when invoked by the |
199 | ;; daemon. | |
200 | (%error-to-file-descriptor-4? #f) | |
201 | ||
202 | \f | |
e903b7c1 LC |
203 | (test-equal "query narinfo without signature" |
204 | "" ; not substitutable | |
205 | ||
206 | (with-narinfo %narinfo | |
207 | (string-trim-both | |
208 | (with-output-to-string | |
209 | (lambda () | |
210 | (with-input-from-string (string-append "have " (%store-prefix) | |
211 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
212 | (lambda () | |
2c74fde0 | 213 | (guix-substitute "--query")))))))) |
e903b7c1 | 214 | |
cdea30e0 | 215 | (test-equal "query narinfo with invalid hash" |
52f80dfc | 216 | ;; The hash in the signature differs from the hash of %NARINFO. |
cdea30e0 LC |
217 | "" |
218 | ||
52f80dfc LC |
219 | (with-narinfo (string-append %narinfo "Signature: " |
220 | (signature-field "different body") | |
221 | "\n") | |
cdea30e0 LC |
222 | (string-trim-both |
223 | (with-output-to-string | |
224 | (lambda () | |
225 | (with-input-from-string (string-append "have " (%store-prefix) | |
226 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
227 | (lambda () | |
2c74fde0 | 228 | (guix-substitute "--query")))))))) |
cdea30e0 | 229 | |
60b04024 LC |
230 | (test-equal "query narinfo with signature over nothing" |
231 | ;; The signature is computed over the empty string, not over the important | |
232 | ;; parts, so the narinfo must be ignored. | |
233 | "" | |
234 | ||
235 | (with-narinfo (string-append "Signature: " (signature-field "") "\n" | |
236 | %narinfo "\n") | |
237 | (string-trim-both | |
238 | (with-output-to-string | |
239 | (lambda () | |
240 | (with-input-from-string (string-append "have " (%store-prefix) | |
241 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
242 | (lambda () | |
243 | (guix-substitute "--query")))))))) | |
244 | ||
245 | (test-equal "query narinfo with signature over irrelevant bits" | |
246 | ;; The signature is valid but it does not cover the | |
247 | ;; StorePath/NarHash/References tuple and is thus irrelevant; the narinfo | |
248 | ;; must be ignored. | |
249 | "" | |
250 | ||
251 | (let ((prefix (string-append "StorePath: " (%store-prefix) | |
252 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo | |
253 | URL: example.nar | |
254 | Compression: none\n"))) | |
255 | (with-narinfo (string-append prefix | |
256 | "Signature: " (signature-field prefix) " | |
257 | NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa | |
258 | NarSize: 42 | |
259 | References: bar baz | |
260 | Deriver: " (%store-prefix) "/foo.drv | |
261 | System: mips64el-linux\n") | |
262 | (string-trim-both | |
263 | (with-output-to-string | |
264 | (lambda () | |
265 | (with-input-from-string (string-append "have " (%store-prefix) | |
266 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
267 | (lambda () | |
268 | (guix-substitute "--query"))))))))) | |
269 | ||
cdea30e0 LC |
270 | (test-equal "query narinfo signed with authorized key" |
271 | (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
272 | ||
52f80dfc LC |
273 | (with-narinfo (string-append %narinfo "Signature: " |
274 | (signature-field %narinfo) | |
275 | "\n") | |
cdea30e0 LC |
276 | (string-trim-both |
277 | (with-output-to-string | |
278 | (lambda () | |
279 | (with-input-from-string (string-append "have " (%store-prefix) | |
280 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
281 | (lambda () | |
2c74fde0 | 282 | (guix-substitute "--query")))))))) |
cdea30e0 LC |
283 | |
284 | (test-equal "query narinfo signed with unauthorized key" | |
285 | "" ; not substitutable | |
286 | ||
52f80dfc LC |
287 | (with-narinfo (string-append %narinfo "Signature: " |
288 | (signature-field | |
289 | %narinfo | |
290 | #:public-key %wrong-public-key) | |
291 | "\n") | |
cdea30e0 LC |
292 | (string-trim-both |
293 | (with-output-to-string | |
294 | (lambda () | |
295 | (with-input-from-string (string-append "have " (%store-prefix) | |
296 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
297 | (lambda () | |
2c74fde0 | 298 | (guix-substitute "--query")))))))) |
cdea30e0 | 299 | |
f84f8590 | 300 | (test-quit "substitute, no signature" |
a9468b42 | 301 | "no valid substitute" |
e903b7c1 | 302 | (with-narinfo %narinfo |
711df9ef LC |
303 | (with-input-from-string (string-append "substitute " |
304 | (%store-prefix) | |
305 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" | |
306 | " foo\n") | |
307 | (lambda () | |
308 | (guix-substitute "--substitute"))))) | |
e903b7c1 | 309 | |
9dfa20a2 | 310 | (test-quit "substitute, invalid narinfo hash" |
a9468b42 | 311 | "no valid substitute" |
52f80dfc LC |
312 | ;; The hash in the signature differs from the hash of %NARINFO. |
313 | (with-narinfo (string-append %narinfo "Signature: " | |
314 | (signature-field "different body") | |
315 | "\n") | |
711df9ef LC |
316 | (with-input-from-string (string-append "substitute " |
317 | (%store-prefix) | |
318 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" | |
319 | " foo\n") | |
320 | (lambda () | |
321 | (guix-substitute "--substitute"))))) | |
cdea30e0 | 322 | |
9dfa20a2 LC |
323 | (test-equal "substitute, invalid hash" |
324 | (string-append "hash-mismatch sha256 " | |
325 | (bytevector->nix-base32-string (sha256 #vu8())) " " | |
326 | (let-values (((port get-hash) | |
327 | (open-hash-port (hash-algorithm sha256))) | |
328 | ((content) | |
329 | "Substitutable data.")) | |
330 | (write-file-tree "foo" port | |
331 | #:file-type+size | |
332 | (lambda _ | |
333 | (values 'regular | |
334 | (string-length content))) | |
335 | #:file-port | |
336 | (lambda _ | |
337 | (open-input-string content))) | |
338 | (close-port port) | |
339 | (bytevector->nix-base32-string (get-hash))) | |
340 | "\n") | |
341 | ||
342 | ;; Arrange so the actual data hash does not match the 'NarHash' field in the | |
343 | ;; narinfo. | |
344 | (with-output-to-string | |
345 | (lambda () | |
346 | (let ((narinfo (string-append "StorePath: " (%store-prefix) | |
347 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash | |
348 | URL: example.nar | |
349 | Compression: none | |
350 | NarHash: sha256:" (bytevector->nix-base32-string (sha256 #vu8())) " | |
351 | NarSize: 42 | |
352 | References: | |
353 | Deriver: " (%store-prefix) "/foo.drv | |
354 | System: mips64el-linux\n"))) | |
355 | (with-narinfo (string-append narinfo "Signature: " | |
356 | (signature-field narinfo) "\n") | |
357 | (call-with-temporary-directory | |
358 | (lambda (directory) | |
359 | (with-input-from-string (string-append | |
360 | "substitute " (%store-prefix) | |
361 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash " | |
362 | directory "/wrong-hash\n") | |
363 | (lambda () | |
364 | (guix-substitute "--substitute")))))))))) | |
365 | ||
f84f8590 | 366 | (test-quit "substitute, unauthorized key" |
a9468b42 | 367 | "no valid substitute" |
52f80dfc LC |
368 | (with-narinfo (string-append %narinfo "Signature: " |
369 | (signature-field | |
370 | %narinfo | |
371 | #:public-key %wrong-public-key) | |
372 | "\n") | |
711df9ef LC |
373 | (with-input-from-string (string-append "substitute " |
374 | (%store-prefix) | |
375 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" | |
376 | " foo\n") | |
377 | (lambda () | |
378 | (guix-substitute "--substitute"))))) | |
e9c6c584 | 379 | |
e903b7c1 | 380 | (test-equal "substitute, authorized key" |
77a1efed | 381 | '("Substitutable data." 1 #o444) |
e903b7c1 LC |
382 | (with-narinfo (string-append %narinfo "Signature: " |
383 | (signature-field %narinfo)) | |
384 | (dynamic-wind | |
385 | (const #t) | |
386 | (lambda () | |
711df9ef LC |
387 | (request-substitution (string-append (%store-prefix) |
388 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
389 | "substitute-retrieved") | |
77a1efed LC |
390 | (list (call-with-input-file "substitute-retrieved" get-string-all) |
391 | (stat:mtime (lstat "substitute-retrieved")) | |
392 | (stat:perms (lstat "substitute-retrieved")))) | |
e903b7c1 LC |
393 | (lambda () |
394 | (false-if-exception (delete-file "substitute-retrieved")))))) | |
395 | ||
a9468b42 LC |
396 | (test-equal "substitute, unauthorized narinfo comes first" |
397 | "Substitutable data." | |
398 | (with-narinfo* | |
399 | (string-append %narinfo "Signature: " | |
400 | (signature-field | |
401 | %narinfo | |
402 | #:public-key %wrong-public-key)) | |
403 | %alternate-substitute-directory | |
404 | ||
405 | (with-narinfo* (string-append %narinfo "Signature: " | |
406 | (signature-field %narinfo)) | |
407 | %main-substitute-directory | |
408 | ||
409 | (dynamic-wind | |
410 | (const #t) | |
411 | (lambda () | |
412 | ;; Remove this file so that the substitute can only be retrieved | |
413 | ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. | |
414 | (delete-file (string-append %main-substitute-directory | |
415 | "/example.nar")) | |
416 | ||
417 | (parameterize ((substitute-urls | |
418 | (map (cut string-append "file://" <>) | |
419 | (list %alternate-substitute-directory | |
420 | %main-substitute-directory)))) | |
711df9ef LC |
421 | (request-substitution (string-append (%store-prefix) |
422 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
423 | "substitute-retrieved")) | |
a9468b42 LC |
424 | (call-with-input-file "substitute-retrieved" get-string-all)) |
425 | (lambda () | |
426 | (false-if-exception (delete-file "substitute-retrieved"))))))) | |
427 | ||
428 | (test-equal "substitute, unsigned narinfo comes first" | |
429 | "Substitutable data." | |
430 | (with-narinfo* %narinfo ;not signed! | |
431 | %alternate-substitute-directory | |
432 | ||
433 | (with-narinfo* (string-append %narinfo "Signature: " | |
434 | (signature-field %narinfo)) | |
435 | %main-substitute-directory | |
436 | ||
437 | (dynamic-wind | |
438 | (const #t) | |
439 | (lambda () | |
440 | ;; Remove this file so that the substitute can only be retrieved | |
441 | ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. | |
442 | (delete-file (string-append %main-substitute-directory | |
443 | "/example.nar")) | |
444 | ||
445 | (parameterize ((substitute-urls | |
446 | (map (cut string-append "file://" <>) | |
447 | (list %alternate-substitute-directory | |
448 | %main-substitute-directory)))) | |
711df9ef LC |
449 | (request-substitution (string-append (%store-prefix) |
450 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
451 | "substitute-retrieved")) | |
a9468b42 LC |
452 | (call-with-input-file "substitute-retrieved" get-string-all)) |
453 | (lambda () | |
454 | (false-if-exception (delete-file "substitute-retrieved"))))))) | |
455 | ||
456 | (test-equal "substitute, first narinfo is unsigned and has wrong hash" | |
457 | "Substitutable data." | |
458 | (with-narinfo* (regexp-substitute #f | |
459 | (string-match "NarHash: [[:graph:]]+" | |
460 | %narinfo) | |
461 | 'pre | |
462 | "NarHash: sha256:" | |
463 | (bytevector->nix-base32-string | |
464 | (make-bytevector 32)) | |
465 | 'post) | |
466 | %alternate-substitute-directory | |
467 | ||
468 | (with-narinfo* (string-append %narinfo "Signature: " | |
469 | (signature-field %narinfo)) | |
470 | %main-substitute-directory | |
471 | ||
472 | (dynamic-wind | |
473 | (const #t) | |
474 | (lambda () | |
475 | ;; This time remove the file so that the substitute can only be | |
476 | ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. | |
477 | (delete-file (string-append %alternate-substitute-directory | |
478 | "/example.nar")) | |
479 | ||
480 | (parameterize ((substitute-urls | |
481 | (map (cut string-append "file://" <>) | |
482 | (list %alternate-substitute-directory | |
483 | %main-substitute-directory)))) | |
711df9ef LC |
484 | (request-substitution (string-append (%store-prefix) |
485 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
486 | "substitute-retrieved")) | |
a9468b42 LC |
487 | (call-with-input-file "substitute-retrieved" get-string-all)) |
488 | (lambda () | |
489 | (false-if-exception (delete-file "substitute-retrieved"))))))) | |
490 | ||
491 | (test-equal "substitute, first narinfo is unsigned and has wrong refs" | |
492 | "Substitutable data." | |
493 | (with-narinfo* (regexp-substitute #f | |
494 | (string-match "References: ([^\n]+)\n" | |
495 | %narinfo) | |
496 | 'pre "References: " 1 | |
497 | " wrong set of references\n" | |
498 | 'post) | |
499 | %alternate-substitute-directory | |
500 | ||
501 | (with-narinfo* (string-append %narinfo "Signature: " | |
502 | (signature-field %narinfo)) | |
503 | %main-substitute-directory | |
504 | ||
505 | (dynamic-wind | |
506 | (const #t) | |
507 | (lambda () | |
508 | ;; This time remove the file so that the substitute can only be | |
509 | ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. | |
510 | (delete-file (string-append %alternate-substitute-directory | |
511 | "/example.nar")) | |
512 | ||
513 | (parameterize ((substitute-urls | |
514 | (map (cut string-append "file://" <>) | |
515 | (list %alternate-substitute-directory | |
516 | %main-substitute-directory)))) | |
711df9ef LC |
517 | (request-substitution (string-append (%store-prefix) |
518 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
519 | "substitute-retrieved")) | |
a9468b42 LC |
520 | (call-with-input-file "substitute-retrieved" get-string-all)) |
521 | (lambda () | |
522 | (false-if-exception (delete-file "substitute-retrieved"))))))) | |
523 | ||
524 | (test-quit "substitute, two invalid narinfos" | |
525 | "no valid substitute" | |
526 | (with-narinfo* %narinfo ;not signed | |
527 | %alternate-substitute-directory | |
528 | ||
529 | (with-narinfo* (string-append %narinfo "Signature: " ;unauthorized | |
530 | (signature-field | |
531 | %narinfo | |
532 | #:public-key %wrong-public-key)) | |
533 | %main-substitute-directory | |
534 | ||
711df9ef LC |
535 | (with-input-from-string (string-append "substitute " |
536 | (%store-prefix) | |
537 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" | |
538 | " substitute-retrieved\n") | |
539 | (lambda () | |
540 | (guix-substitute "--substitute")))))) | |
a9468b42 | 541 | |
b90ae065 LC |
542 | (test-equal "substitute, narinfo with several URLs" |
543 | "Substitutable data." | |
544 | (let ((narinfo (string-append "StorePath: " (%store-prefix) | |
545 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo | |
546 | URL: example.nar.gz | |
547 | Compression: gzip | |
548 | URL: example.nar.lz | |
549 | Compression: lzip | |
550 | URL: example.nar | |
551 | Compression: none | |
552 | NarHash: sha256:" (bytevector->nix-base32-string | |
553 | (sha256 (string->utf8 "Substitutable data."))) " | |
554 | NarSize: 42 | |
555 | References: bar baz | |
556 | Deriver: " (%store-prefix) "/foo.drv | |
557 | System: mips64el-linux\n"))) | |
558 | (with-narinfo (string-append narinfo "Signature: " | |
559 | (signature-field narinfo)) | |
560 | (dynamic-wind | |
561 | (const #t) | |
562 | (lambda () | |
563 | (define (compress input output compression) | |
564 | (call-with-output-file output | |
565 | (lambda (port) | |
566 | (call-with-compressed-output-port compression port | |
567 | (lambda (port) | |
568 | (call-with-input-file input | |
569 | (lambda (input) | |
570 | (dump-port input port)))))))) | |
571 | ||
572 | (let ((nar (string-append %main-substitute-directory | |
573 | "/example.nar"))) | |
574 | (compress nar (string-append nar ".gz") 'gzip) | |
4c0c65ac | 575 | (compress nar (string-append nar ".lz") 'lzip)) |
b90ae065 LC |
576 | |
577 | (parameterize ((substitute-urls | |
578 | (list (string-append "file://" | |
579 | %main-substitute-directory)))) | |
711df9ef LC |
580 | (request-substitution (string-append (%store-prefix) |
581 | "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") | |
582 | "substitute-retrieved")) | |
b90ae065 LC |
583 | (call-with-input-file "substitute-retrieved" get-string-all)) |
584 | (lambda () | |
585 | (false-if-exception (delete-file "substitute-retrieved"))))))) | |
586 | ||
2c74fde0 | 587 | (test-end "substitute") |
e9c6c584 | 588 | |
cdea30e0 LC |
589 | ;;; Local Variables: |
590 | ;;; eval: (put 'with-narinfo 'scheme-indent-function 1) | |
a9468b42 | 591 | ;;; eval: (put 'with-narinfo* 'scheme-indent-function 2) |
f84f8590 | 592 | ;;; eval: (put 'test-quit 'scheme-indent-function 2) |
cdea30e0 | 593 | ;;; End: |