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