projects/guix·blob master · refs

803 lines · 35.8 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Ricardo Wurmus <[email protected]>
3;;; Copyright © 2019-2020, 2022, 2024, 2026 Ludovic Courtès <[email protected]>
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 (test-channels)
21 #:use-module (guix channels)
22 #:use-module (guix profiles)
23 #:use-module ((guix build syscalls) #:select (mkdtemp!))
24 #:use-module (guix tests)
25 #:use-module (guix store)
26 #:use-module (guix derivations)
27 #:use-module (guix sets)
28 #:use-module (guix gexp)
29 #:use-module ((guix diagnostics)
30 #:select (error-location?
31 error-location location-line
32 formatted-message?
33 formatted-message-string
34 formatted-message-arguments))
35 #:use-module ((guix build utils) #:select (which))
36 #:use-module (git)
37 #:use-module (guix git)
38 #:use-module (guix git-authenticate)
39 #:use-module (guix openpgp)
40 #:use-module (guix tests git)
41 #:use-module (guix tests gnupg)
42 #:use-module (srfi srfi-1)
43 #:use-module (srfi srfi-26)
44 #:use-module (srfi srfi-34)
45 #:use-module (srfi srfi-35)
46 #:use-module (srfi srfi-64)
47 #:use-module (rnrs bytevectors)
48 #:use-module (rnrs io ports)
49 #:use-module (ice-9 control)
50 #:use-module (ice-9 match))
51
52(define (gpg+git-available?)
53 (and #t ;'git' is always available
54 (which (gpg-command)) (which (gpgconf-command))))
55
56(define commit-id-string
57 (compose oid->string commit-id))
58
59
60(test-begin "channels")
61
62(define* (make-instance #:key
63 (name 'fake)
64 (commit "cafebabe")
65 (spec #f))
66 (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
67 (when spec
68 (call-with-output-file (string-append instance-dir "/.guix-channel")
69 (lambda (port) (write spec port))))
70 (checkout->channel-instance instance-dir
71 #:commit commit
72 #:name name))
73
74(define instance--boring (make-instance))
75(define instance--unsupported-version
76 (make-instance #:spec
77 '(channel (version 42) (dependencies whatever))))
78(define instance--no-deps
79 (make-instance #:spec
80 '(channel (version 0))))
81(define instance--sub-directory
82 (make-instance #:spec
83 '(channel (version 0) (directory "modules"))))
84(define instance--simple
85 (make-instance #:spec
86 '(channel
87 (version 0)
88 (dependencies
89 (channel
90 (name test-channel)
91 (url "https://example.com/test-channel"))))))
92(define instance--with-dupes
93 (make-instance #:spec
94 '(channel
95 (version 0)
96 (dependencies
97 (channel
98 (name test-channel)
99 (url "https://example.com/test-channel"))
100 (channel
101 (name test-channel)
102 (url "https://example.com/test-channel")
103 (commit "abc1234"))
104 (channel
105 (name test-channel)
106 (url "https://example.com/test-channel-elsewhere"))))))
107
108(define channel-instance-metadata
109 (@@ (guix channels) channel-instance-metadata))
110(define channel-metadata-directory
111 (@@ (guix channels) channel-metadata-directory))
112(define channel-metadata-dependencies
113 (@@ (guix channels) channel-metadata-dependencies))
114
115
116(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
117 '("/" ())
118 (let ((metadata (channel-instance-metadata instance--boring)))
119 (list (channel-metadata-directory metadata)
120 (channel-metadata-dependencies metadata))))
121
122(test-equal "channel-instance-metadata and default dependencies"
123 '()
124 (channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
125
126(test-equal "channel-instance-metadata and directory"
127 "/modules"
128 (channel-metadata-directory
129 (channel-instance-metadata instance--sub-directory)))
130
131(test-equal "channel-instance-metadata rejects unsupported version"
132 1 ;line number in the generated '.guix-channel'
133 (guard (c ((and (message-condition? c) (error-location? c))
134 (location-line (error-location c))))
135 (channel-instance-metadata instance--unsupported-version)))
136
137(test-assert "channel-instance-metadata returns <channel-metadata>"
138 (every (@@ (guix channels) channel-metadata?)
139 (map channel-instance-metadata
140 (list instance--no-deps
141 instance--simple
142 instance--with-dupes))))
143
144(test-assert "channel-instance-metadata dependencies are channels"
145 (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
146 (channel-instance-metadata instance--simple))))
147 (match deps
148 (((? channel? dep)) #t)
149 (_ #f))))
150
151(test-assert "latest-channel-instances includes channel dependencies"
152 (let* ((channel (channel
153 (name 'test)
154 (url "test")))
155 (test-dir (channel-instance-checkout instance--simple)))
156 (mock ((guix git) update-cached-checkout
157 (lambda* (url #:key ref starting-commit verify-certificate?)
158 (match url
159 ("test" (values test-dir "caf3cabba9e" #f))
160 (_ (values (channel-instance-checkout instance--no-deps)
161 "abcde1234" #f)))))
162 (with-store store
163 (let ((instances (latest-channel-instances store (list channel))))
164 (and (eq? 2 (length instances))
165 (lset= eq?
166 '(test test-channel)
167 (map (compose channel-name channel-instance-channel)
168 instances))))))))
169
170(test-assert "latest-channel-instances excludes duplicate channel dependencies"
171 (let* ((channel (channel
172 (name 'test)
173 (url "test")))
174 (test-dir (channel-instance-checkout instance--with-dupes)))
175 (mock ((guix git) update-cached-checkout
176 (lambda* (url #:key ref starting-commit verify-certificate?)
177 (match url
178 ("test" (values test-dir "caf3cabba9e" #f))
179 (_ (values (channel-instance-checkout instance--no-deps)
180 "abcde1234" #f)))))
181 (with-store store
182 (let ((instances (latest-channel-instances store (list channel))))
183 (and (= 2 (length instances))
184 (lset= eq?
185 '(test test-channel)
186 (map (compose channel-name channel-instance-channel)
187 instances))
188 ;; only the most specific channel dependency should remain,
189 ;; i.e. the one with a specified commit.
190 (find (lambda (instance)
191 (and (eq? (channel-name
192 (channel-instance-channel instance))
193 'test-channel)
194 (equal? (channel-commit
195 (channel-instance-channel instance))
196 "abc1234")))
197 instances)))))))
198
199(test-equal "latest-channel-instances reads dependencies from most-specific instance"
200 '(chan1 chan2)
201 ;; Here '.guix-channel' in DIRECTORY2 is less specific than the
202 ;; user-provided channel spec in ONE: the latter specifies a commit. Since
203 ;; the most specific one "wins", the bogus '.guix-channel' file added in
204 ;; DIRECTORY1 as its second commit must not be taken into account.
205 ;; See <https://issues.guix.gnu.org/68822>.
206 (with-temporary-git-repository directory1
207 `((add "a.scm" "(define-module (a))")
208 (commit "first commit")
209 (add ".guix-channel"
210 ,(object->string
211 '(channel
212 (version 0)
213 (dependencies
214 ;; Attempting to fetch this dependency would fail.
215 (channel
216 (name nonexistent-dependency)
217 (url "http://guix.example.org/does-not-exist.git"))))))
218 (commit "second commit"))
219 (with-temporary-git-repository directory2
220 `((add ".guix-channel"
221 ,(object->string
222 `(channel (version 0)
223 (dependencies
224 (channel
225 (name chan1)
226 ;; Note: no 'commit' field here.
227 (url ,(string-append "file://" directory1)))))))
228 (commit "initial commit"))
229 (with-repository directory1 repository
230 (let* ((commit (find-commit repository "first"))
231 (one (channel
232 (url (string-append "file://" directory1))
233 (commit (oid->string (commit-id commit))) ;<- specific
234 (name 'chan1)))
235 (two (channel
236 (url (string-append "file://" directory2))
237 (name 'chan2))))
238
239 (with-store store
240 (map (compose channel-name channel-instance-channel)
241 (delete-duplicates
242 (append (latest-channel-instances store (list one two))
243 (latest-channel-instances store (list two one)))
244 (lambda (instance1 instance2)
245 (string=? (channel-instance-commit instance1)
246 (channel-instance-commit instance2)))))))))))
247
248(test-equal "latest-channel-instances #:validate-pull"
249 'descendant
250
251 ;; Make sure the #:validate-pull procedure receives the right values.
252 (let/ec return
253 (with-temporary-git-repository directory
254 '((add "a.txt" "A")
255 (commit "first commit")
256 (add "b.scm" "#t")
257 (commit "second commit"))
258 (with-repository directory repository
259 (let* ((commit1 (find-commit repository "first"))
260 (commit2 (find-commit repository "second"))
261 (spec (channel (url (string-append "file://" directory))
262 (name 'foo)))
263 (new (channel (inherit spec)
264 (commit (oid->string (commit-id commit2)))))
265 (old (channel (inherit spec)
266 (commit (oid->string (commit-id commit1))))))
267 (define (validate-pull channel current commit relation)
268 (return (and (eq? channel old)
269 (string=? (oid->string (commit-id commit2))
270 current)
271 (string=? (oid->string (commit-id commit1))
272 commit)
273 relation)))
274
275 (with-store store
276 ;; Attempt a downgrade from NEW to OLD.
277 (latest-channel-instances store (list old)
278 #:current-channels (list new)
279 #:validate-pull validate-pull)))))))
280
281(test-equal "channel-instance-dependency-resolver"
282 '((c => (a b)) (b => (a)) (a => ()))
283 ;; Check that channel dependencies propagate. Here we create three channels
284 ;; that depend on one another: c depends on b, which depends on a. When
285 ;; resolving dependencies for c, we must get both a and b, such that
286 ;; (use-modules (b)) from channel c finds (a) when building the derivation
287 ;; of channel c. See <https://issues.guix.gnu.org/68797>.
288 (let ((call-with-channel
289 (lambda (name dependencies channels proc)
290 (with-temporary-git-repository directory
291 `((add ,(string-append (symbol->string name) ".scm")
292 ,(object->string
293 `(define-module (,name)
294 ,@(append-map (lambda (dependency)
295 `(#:use-module (,dependency)))
296 dependencies))))
297 (add ".guix-channel"
298 ,(object->string
299 `(channel
300 (version 0)
301 (dependencies
302 ,@(map (lambda (dependency)
303 `(channel
304 (name ,dependency)
305 (url "http://example.org")))
306 dependencies)))))
307 (commit "Initial commit."))
308 (proc (cons (channel
309 (name name)
310 (url directory))
311 channels))))))
312 (define-syntax with-channels
313 (syntax-rules (&initialized)
314 ((_ &initialized binding (name dependencies) rest ... exp)
315 (call-with-channel 'name dependencies binding
316 (lambda (binding)
317 (with-channels &initialized binding
318 rest ... exp))))
319 ((_ &initialized binding exp) exp)
320 ((_ binding rest ...)
321 (let ((binding '()))
322 (with-channels &initialized binding rest ...)))))
323
324 (with-channels
325 channels (a '()) (b '(a)) (c '(b))
326 (with-store store
327 (let* ((instances (latest-channel-instances store channels))
328 (resolve (channel-instance-dependency-resolver instances)))
329 (map (lambda (instance)
330 (list (channel-name (channel-instance-channel instance))
331 '=>
332 (map (compose channel-name channel-instance-channel)
333 (resolve instance))))
334 instances))))))
335
336(test-assert "channel-instances->manifest"
337 ;; Compute the manifest for a graph of instances and make sure we get a
338 ;; derivation graph that mirrors the instance graph. This test also ensures
339 ;; we don't try to access Git repositores at all at this stage.
340 (let* ((spec (lambda deps
341 `(channel (version 0)
342 (dependencies
343 ,@(map (lambda (dep)
344 `(channel
345 (name ,dep)
346 (url "http://example.org")))
347 deps)))))
348 (guix (make-instance #:name 'guix))
349 (instance0 (make-instance #:name 'a))
350 (instance1 (make-instance #:name 'b #:spec (spec 'a)))
351 (instance2 (make-instance #:name 'c #:spec (spec 'b)))
352 (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
353 (%graft? #f) ;don't try to build stuff
354
355 ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
356 (let ((source (channel-instance-checkout guix)))
357 (mkdir (string-append source "/build-aux"))
358 (call-with-output-file (string-append source
359 "/build-aux/build-self.scm")
360 (lambda (port)
361 (write '(begin
362 (use-modules (guix) (gnu packages bootstrap))
363
364 (lambda _
365 (package->derivation %bootstrap-guile)))
366 port))))
367
368 (with-store store
369 (let ()
370 (define manifest
371 (run-with-store store
372 (channel-instances->manifest (list guix
373 instance0 instance1
374 instance2 instance3))))
375
376 (define entries
377 (manifest-entries manifest))
378
379 (define (depends? drv in out)
380 ;; Return true if DRV depends (directly or indirectly) on all of IN
381 ;; and none of OUT.
382 (let ((set (list->set
383 (requisites store
384 (list (derivation-file-name drv)))))
385 (in (map derivation-file-name in))
386 (out (map derivation-file-name out)))
387 (and (every (cut set-contains? set <>) in)
388 (not (any (cut set-contains? set <>) out)))))
389
390 (define (lookup name)
391 (run-with-store store
392 (lower-object
393 (manifest-entry-item
394 (manifest-lookup manifest
395 (manifest-pattern (name name)))))))
396
397 (let ((drv-guix (lookup "guix"))
398 (drv0 (lookup "a"))
399 (drv1 (lookup "b"))
400 (drv2 (lookup "c"))
401 (drv3 (lookup "d")))
402 (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
403 (depends? drv0
404 (list) (list drv1 drv2 drv3))
405 (depends? drv1
406 (list drv0) (list drv2 drv3))
407 (depends? drv2
408 (list drv1) (list drv3))
409 (depends? drv3
410 (list drv2 drv0) (list))))))))
411
412(test-equal "channel-news, no news"
413 '()
414 (with-temporary-git-repository directory
415 '((add "a.txt" "A")
416 (commit "the commit"))
417 (with-repository directory repository
418 (let ((channel (channel (url (string-append "file://" directory))
419 (name 'foo)))
420 (latest (reference-name->oid repository "HEAD")))
421 (channel-news-for-commit channel (oid->string latest))))))
422
423(test-assert "channel-news, one entry"
424 (with-temporary-git-repository directory
425 `((add ".guix-channel"
426 ,(object->string
427 '(channel (version 0)
428 (news-file "news.scm"))))
429 (commit "first commit")
430 (add "src/a.txt" "A")
431 (commit "second commit")
432 (tag "tag-for-first-news-entry")
433 (add "news.scm"
434 ,(lambda (repository)
435 (let ((previous
436 (reference-name->oid repository "HEAD")))
437 (object->string
438 `(channel-news
439 (version 0)
440 (entry (commit ,(oid->string previous))
441 (title (en "New file!")
442 (eo "Nova dosiero!"))
443 (body (en "Yeah, a.txt."))))))))
444 (commit "third commit")
445 (add "src/b.txt" "B")
446 (commit "fourth commit")
447 (add "news.scm"
448 ,(lambda (repository)
449 (let ((second
450 (commit-id
451 (find-commit repository "second commit")))
452 (previous
453 (reference-name->oid repository "HEAD")))
454 (object->string
455 `(channel-news
456 (version 0)
457 (entry (commit ,(oid->string previous))
458 (title (en "Another file!"))
459 (body (en "Yeah, b.txt.")))
460 (entry (tag "tag-for-first-news-entry")
461 (title (en "Old news.")
462 (eo "Malnovaĵoj."))
463 (body (en "For a.txt"))))))))
464 (commit "fifth commit"))
465 (with-repository directory repository
466 (define (find-commit* message)
467 (oid->string (commit-id (find-commit repository message))))
468
469 (let ((channel (channel (url (string-append "file://" directory))
470 (name 'foo)))
471 (commit1 (find-commit* "first commit"))
472 (commit2 (find-commit* "second commit"))
473 (commit3 (find-commit* "third commit"))
474 (commit4 (find-commit* "fourth commit"))
475 (commit5 (find-commit* "fifth commit")))
476 ;; First try fetching all the news up to a given commit.
477 (and (null? (channel-news-for-commit channel commit2))
478 (lset= string=?
479 (map channel-news-entry-commit
480 (channel-news-for-commit channel commit5))
481 (list commit2 commit4))
482 (lset= equal?
483 (map channel-news-entry-title
484 (channel-news-for-commit channel commit5))
485 '((("en" . "Another file!"))
486 (("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
487 (lset= string=?
488 (map channel-news-entry-commit
489 (channel-news-for-commit channel commit3))
490 (list commit2))
491
492 ;; Now fetch news entries that apply to a commit range.
493 (lset= string=?
494 (map channel-news-entry-commit
495 (channel-news-for-commit channel commit3 commit1))
496 (list commit2))
497 (lset= string=?
498 (map channel-news-entry-commit
499 (channel-news-for-commit channel commit5 commit3))
500 (list commit4))
501 (lset= string=?
502 (map channel-news-entry-commit
503 (channel-news-for-commit channel commit5 commit1))
504 (list commit4 commit2))
505 (lset= equal?
506 (map channel-news-entry-tag
507 (channel-news-for-commit channel commit5 commit1))
508 '(#f "tag-for-first-news-entry")))))))
509
510(test-assert "channel-news, annotated tag"
511 (with-temporary-git-repository directory
512 `((add ".guix-channel"
513 ,(object->string
514 '(channel (version 0)
515 (news-file "news.scm"))))
516 (add "src/a.txt" "A")
517 (commit "first commit")
518 (tag "tag-for-first-news-entry"
519 "This is an annotated tag.")
520 (add "news.scm"
521 ,(lambda (repository)
522 (let ((previous
523 (reference-name->oid repository "HEAD")))
524 (object->string
525 `(channel-news
526 (version 0)
527 (entry (tag "tag-for-first-news-entry")
528 (title (en "New file!"))
529 (body (en "Yeah, a.txt."))))))))
530 (commit "second commit"))
531 (with-repository directory repository
532 (define (find-commit* message)
533 (oid->string (commit-id (find-commit repository message))))
534
535 (let ((channel (channel (url (string-append "file://" directory))
536 (name 'foo)))
537 (commit1 (find-commit* "first commit"))
538 (commit2 (find-commit* "second commit")))
539 (and (null? (channel-news-for-commit channel commit1))
540 (lset= equal?
541 (map channel-news-entry-title
542 (channel-news-for-commit channel commit2))
543 '((("en" . "New file!"))))
544 (lset= string=?
545 (map channel-news-entry-tag
546 (channel-news-for-commit channel commit2))
547 (list "tag-for-first-news-entry"))
548 ;; This is an annotated tag, but 'channel-news-entry-commit'
549 ;; should give us the commit ID, not the ID of the annotated tag
550 ;; object.
551 (lset= string=?
552 (map channel-news-entry-commit
553 (channel-news-for-commit channel commit2))
554 (list commit1)))))))
555
556(test-assert "latest-channel-instances, missing introduction for 'guix'"
557 (with-temporary-git-repository directory
558 '((add "a.txt" "A")
559 (commit "first commit")
560 (add "b.scm" "#t")
561 (commit "second commit"))
562 (with-repository directory repository
563 (let* ((commit1 (find-commit repository "first"))
564 (commit2 (find-commit repository "second"))
565 (channel (channel (url (string-append "file://" directory))
566 (name 'guix))))
567
568 (guard (c ((formatted-message? c)
569 (->bool (string-contains (formatted-message-string c)
570 "introduction"))))
571 (with-store store
572 ;; Attempt a downgrade from NEW to OLD.
573 (latest-channel-instances store (list channel))
574 #f))))))
575
576(unless (gpg+git-available?) (test-skip 1))
577(test-equal "authenticate-channel, wrong first commit signer"
578 #t
579 (with-fresh-gnupg-setup (list %ed25519-public-key-file
580 %ed25519-secret-key-file
581 %ed25519-2-public-key-file
582 %ed25519-2-secret-key-file)
583 (with-temporary-git-repository directory
584 `((add ".guix-channel"
585 ,(object->string
586 '(channel (version 0)
587 (keyring-reference "master"))))
588 (add ".guix-authorizations"
589 ,(object->string
590 `(authorizations (version 0)
591 ((,(key-fingerprint
592 %ed25519-public-key-file)
593 (name "Charlie"))))))
594 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
595 get-string-all))
596 (commit "first commit"
597 (signer ,(key-fingerprint %ed25519-public-key-file)))
598 (add "random" ,(random-text))
599 (commit "second commit"
600 (signer ,(key-fingerprint %ed25519-public-key-file))))
601 (with-repository directory repository
602 (let* ((commit1 (find-commit repository "first"))
603 (commit2 (find-commit repository "second"))
604 (intro (make-channel-introduction
605 (commit-id-string commit1)
606 (openpgp-public-key-fingerprint
607 (read-openpgp-packet
608 %ed25519-2-public-key-file)))) ;different key
609 (channel (channel (name 'example)
610 (url (string-append "file://" directory))
611 (introduction intro))))
612 (guard (c ((formatted-message? c)
613 (and (string-contains (formatted-message-string c)
614 "initial commit")
615 (equal? (formatted-message-arguments c)
616 (list
617 (oid->string (commit-id commit1))
618 (key-fingerprint %ed25519-public-key-file)
619 (key-fingerprint
620 %ed25519-2-public-key-file))))))
621 (authenticate-channel channel directory
622 (commit-id-string commit2)
623 #:keyring-reference-prefix "")
624 'failed))))))
625
626(unless (gpg+git-available?) (test-skip 1))
627(test-equal "authenticate-channel, not a descendant of introductory commit"
628 #t
629 (with-fresh-gnupg-setup (list %ed25519-public-key-file
630 %ed25519-secret-key-file
631 %ed25519-2-public-key-file
632 %ed25519-2-secret-key-file)
633 (with-temporary-git-repository directory
634 `((add ".guix-channel"
635 ,(object->string
636 '(channel (version 0)
637 (keyring-reference "master"))))
638 (add ".guix-authorizations"
639 ,(object->string
640 `(authorizations (version 0)
641 ((,(key-fingerprint
642 %ed25519-public-key-file)
643 (name "Charlie"))))))
644 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
645 get-string-all))
646 (commit "first commit"
647 (signer ,(key-fingerprint %ed25519-public-key-file)))
648 (branch "alternate-branch")
649 (checkout "alternate-branch")
650 (add "something.txt" ,(random-text))
651 (commit "intro commit"
652 (signer ,(key-fingerprint %ed25519-public-key-file)))
653 (checkout "master")
654 (add "random" ,(random-text))
655 (commit "second commit"
656 (signer ,(key-fingerprint %ed25519-public-key-file))))
657 (with-repository directory repository
658 (let* ((commit1 (find-commit repository "first"))
659 (commit2 (find-commit repository "second"))
660 (commit0 (commit-lookup
661 repository
662 (reference-target
663 (branch-lookup repository "alternate-branch"))))
664 (intro (make-channel-introduction
665 (commit-id-string commit0)
666 (openpgp-public-key-fingerprint
667 (read-openpgp-packet
668 %ed25519-public-key-file))))
669 (channel (channel (name 'example)
670 (url (string-append "file://" directory))
671 (introduction intro))))
672 (guard (c ((formatted-message? c)
673 (and (string-contains (formatted-message-string c)
674 "not a descendant")
675 (equal? (formatted-message-arguments c)
676 (list
677 (oid->string (commit-id commit2))
678 (oid->string (commit-id commit0)))))))
679 (authenticate-channel channel directory
680 (commit-id-string commit2)
681 #:keyring-reference-prefix "")
682 'failed))))))
683
684(unless (gpg+git-available?) (test-skip 1))
685(test-equal "authenticate-channel, .guix-authorizations"
686 #t
687 (with-fresh-gnupg-setup (list %ed25519-public-key-file
688 %ed25519-secret-key-file
689 %ed25519-2-public-key-file
690 %ed25519-2-secret-key-file)
691 (with-temporary-git-repository directory
692 `((add ".guix-channel"
693 ,(object->string
694 '(channel (version 0)
695 (keyring-reference "channel-keyring"))))
696 (add ".guix-authorizations"
697 ,(object->string
698 `(authorizations (version 0)
699 ((,(key-fingerprint
700 %ed25519-public-key-file)
701 (name "Charlie"))))))
702 (commit "zeroth commit")
703 (add "a.txt" "A")
704 (commit "first commit"
705 (signer ,(key-fingerprint %ed25519-public-key-file)))
706 (add "b.txt" "B")
707 (commit "second commit"
708 (signer ,(key-fingerprint %ed25519-public-key-file)))
709 (add "c.txt" "C")
710 (commit "third commit"
711 (signer ,(key-fingerprint %ed25519-2-public-key-file)))
712 (branch "channel-keyring")
713 (checkout "channel-keyring")
714 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
715 get-string-all))
716 (add "other.key" ,(call-with-input-file %ed25519-2-public-key-file
717 get-string-all))
718 (commit "keyring commit")
719 (checkout "master"))
720 (with-repository directory repository
721 (let* ((commit1 (find-commit repository "first"))
722 (commit2 (find-commit repository "second"))
723 (commit3 (find-commit repository "third"))
724 (intro (make-channel-introduction
725 (commit-id-string commit1)
726 (openpgp-public-key-fingerprint
727 (read-openpgp-packet
728 %ed25519-public-key-file))))
729 (channel (channel (name 'example)
730 (url (string-append "file://" directory))
731 (introduction intro))))
732 ;; COMMIT1 and COMMIT2 are fine.
733 (and (authenticate-channel channel directory
734 (commit-id-string commit2)
735 #:keyring-reference-prefix "")
736
737 ;; COMMIT3 is signed by an unauthorized key according to its
738 ;; parent's '.guix-authorizations' file.
739 (guard (c ((unauthorized-commit-error? c)
740 (and (oid=? (git-authentication-error-commit c)
741 (commit-id commit3))
742 (bytevector=?
743 (openpgp-public-key-fingerprint
744 (unauthorized-commit-error-signing-key c))
745 (openpgp-public-key-fingerprint
746 (read-openpgp-packet
747 %ed25519-2-public-key-file))))))
748 (authenticate-channel channel directory
749 (commit-id-string commit3)
750 #:keyring-reference-prefix "")
751 'failed)))))))
752
753(unless (gpg+git-available?) (test-skip 1))
754(test-equal "latest-channel-instances, authenticate dependency"
755 #t
756 ;; Make sure that a channel dependency that has an introduction is
757 ;; authenticated. This test checks that an authentication error is raised
758 ;; as it should when authenticating the dependency.
759 (with-fresh-gnupg-setup (list %ed25519-public-key-file
760 %ed25519-secret-key-file)
761 (with-temporary-git-repository dependency-directory
762 `((add ".guix-channel"
763 ,(object->string
764 '(channel (version 0)
765 (keyring-reference "master"))))
766 (add ".guix-authorizations"
767 ,(object->string
768 `(authorizations (version 0) ())))
769 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
770 get-string-all))
771 (commit "zeroth commit"
772 (signer ,(key-fingerprint %ed25519-public-key-file)))
773 (add "foo.txt" "evil")
774 (commit "unsigned commit"))
775 (with-repository dependency-directory dependency
776 (let* ((commit0 (find-commit dependency "zeroth"))
777 (commit1 (find-commit dependency "unsigned"))
778 (intro `(channel-introduction
779 (version 0)
780 (commit ,(commit-id-string commit0))
781 (signer ,(openpgp-format-fingerprint
782 (openpgp-public-key-fingerprint
783 (read-openpgp-packet
784 %ed25519-public-key-file)))))))
785 (with-temporary-git-repository directory
786 `((add ".guix-channel"
787 ,(object->string
788 `(channel (version 0)
789 (dependencies
790 (channel
791 (name test-channel)
792 (url ,dependency-directory)
793 (introduction ,intro))))))
794 (commit "single commit"))
795 (let ((channel (channel (name 'test) (url directory))))
796 (guard (c ((unsigned-commit-error? c)
797 (oid=? (git-authentication-error-commit c)
798 (commit-id commit1))))
799 (with-store store
800 (latest-channel-instances store (list channel))
801 'failed)))))))))
802
803(test-end "channels")