channels.scm 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
  3. ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
  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. (define-module (test-channels)
  20. #:use-module (guix channels)
  21. #:use-module (guix profiles)
  22. #:use-module ((guix build syscalls) #:select (mkdtemp!))
  23. #:use-module (guix tests)
  24. #:use-module (guix store)
  25. #:use-module ((guix grafts) #:select (%graft?))
  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. (define (gpg+git-available?)
  52. (and (which (git-command))
  53. (which (gpg-command)) (which (gpgconf-command))))
  54. (define commit-id-string
  55. (compose oid->string commit-id))
  56. (test-begin "channels")
  57. (define* (make-instance #:key
  58. (name 'fake)
  59. (commit "cafebabe")
  60. (spec #f))
  61. (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
  62. (when spec
  63. (call-with-output-file (string-append instance-dir "/.guix-channel")
  64. (lambda (port) (write spec port))))
  65. (checkout->channel-instance instance-dir
  66. #:commit commit
  67. #:name name))
  68. (define instance--boring (make-instance))
  69. (define instance--unsupported-version
  70. (make-instance #:spec
  71. '(channel (version 42) (dependencies whatever))))
  72. (define instance--no-deps
  73. (make-instance #:spec
  74. '(channel (version 0))))
  75. (define instance--sub-directory
  76. (make-instance #:spec
  77. '(channel (version 0) (directory "modules"))))
  78. (define instance--simple
  79. (make-instance #:spec
  80. '(channel
  81. (version 0)
  82. (dependencies
  83. (channel
  84. (name test-channel)
  85. (url "https://example.com/test-channel"))))))
  86. (define instance--with-dupes
  87. (make-instance #:spec
  88. '(channel
  89. (version 0)
  90. (dependencies
  91. (channel
  92. (name test-channel)
  93. (url "https://example.com/test-channel"))
  94. (channel
  95. (name test-channel)
  96. (url "https://example.com/test-channel")
  97. (commit "abc1234"))
  98. (channel
  99. (name test-channel)
  100. (url "https://example.com/test-channel-elsewhere"))))))
  101. (define channel-instance-metadata
  102. (@@ (guix channels) channel-instance-metadata))
  103. (define channel-metadata-directory
  104. (@@ (guix channels) channel-metadata-directory))
  105. (define channel-metadata-dependencies
  106. (@@ (guix channels) channel-metadata-dependencies))
  107. (test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
  108. '("/" ())
  109. (let ((metadata (channel-instance-metadata instance--boring)))
  110. (list (channel-metadata-directory metadata)
  111. (channel-metadata-dependencies metadata))))
  112. (test-equal "channel-instance-metadata and default dependencies"
  113. '()
  114. (channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
  115. (test-equal "channel-instance-metadata and directory"
  116. "/modules"
  117. (channel-metadata-directory
  118. (channel-instance-metadata instance--sub-directory)))
  119. (test-equal "channel-instance-metadata rejects unsupported version"
  120. 1 ;line number in the generated '.guix-channel'
  121. (guard (c ((and (message-condition? c) (error-location? c))
  122. (location-line (error-location c))))
  123. (channel-instance-metadata instance--unsupported-version)))
  124. (test-assert "channel-instance-metadata returns <channel-metadata>"
  125. (every (@@ (guix channels) channel-metadata?)
  126. (map channel-instance-metadata
  127. (list instance--no-deps
  128. instance--simple
  129. instance--with-dupes))))
  130. (test-assert "channel-instance-metadata dependencies are channels"
  131. (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
  132. (channel-instance-metadata instance--simple))))
  133. (match deps
  134. (((? channel? dep)) #t)
  135. (_ #f))))
  136. (test-assert "latest-channel-instances includes channel dependencies"
  137. (let* ((channel (channel
  138. (name 'test)
  139. (url "test")))
  140. (test-dir (channel-instance-checkout instance--simple)))
  141. (mock ((guix git) update-cached-checkout
  142. (lambda* (url #:key ref starting-commit)
  143. (match url
  144. ("test" (values test-dir "caf3cabba9e" #f))
  145. (_ (values (channel-instance-checkout instance--no-deps)
  146. "abcde1234" #f)))))
  147. (with-store store
  148. (let ((instances (latest-channel-instances store (list channel))))
  149. (and (eq? 2 (length instances))
  150. (lset= eq?
  151. '(test test-channel)
  152. (map (compose channel-name channel-instance-channel)
  153. instances))))))))
  154. (test-assert "latest-channel-instances excludes duplicate channel dependencies"
  155. (let* ((channel (channel
  156. (name 'test)
  157. (url "test")))
  158. (test-dir (channel-instance-checkout instance--with-dupes)))
  159. (mock ((guix git) update-cached-checkout
  160. (lambda* (url #:key ref starting-commit)
  161. (match url
  162. ("test" (values test-dir "caf3cabba9e" #f))
  163. (_ (values (channel-instance-checkout instance--no-deps)
  164. "abcde1234" #f)))))
  165. (with-store store
  166. (let ((instances (latest-channel-instances store (list channel))))
  167. (and (= 2 (length instances))
  168. (lset= eq?
  169. '(test test-channel)
  170. (map (compose channel-name channel-instance-channel)
  171. instances))
  172. ;; only the most specific channel dependency should remain,
  173. ;; i.e. the one with a specified commit.
  174. (find (lambda (instance)
  175. (and (eq? (channel-name
  176. (channel-instance-channel instance))
  177. 'test-channel)
  178. (string=? (channel-commit
  179. (channel-instance-channel instance))
  180. "abc1234")))
  181. instances)))))))
  182. (unless (which (git-command)) (test-skip 1))
  183. (test-equal "latest-channel-instances #:validate-pull"
  184. 'descendant
  185. ;; Make sure the #:validate-pull procedure receives the right values.
  186. (let/ec return
  187. (with-temporary-git-repository directory
  188. '((add "a.txt" "A")
  189. (commit "first commit")
  190. (add "b.scm" "#t")
  191. (commit "second commit"))
  192. (with-repository directory repository
  193. (let* ((commit1 (find-commit repository "first"))
  194. (commit2 (find-commit repository "second"))
  195. (spec (channel (url (string-append "file://" directory))
  196. (name 'foo)))
  197. (new (channel (inherit spec)
  198. (commit (oid->string (commit-id commit2)))))
  199. (old (channel (inherit spec)
  200. (commit (oid->string (commit-id commit1))))))
  201. (define (validate-pull channel current commit relation)
  202. (return (and (eq? channel old)
  203. (string=? (oid->string (commit-id commit2))
  204. current)
  205. (string=? (oid->string (commit-id commit1))
  206. commit)
  207. relation)))
  208. (with-store store
  209. ;; Attempt a downgrade from NEW to OLD.
  210. (latest-channel-instances store (list old)
  211. #:current-channels (list new)
  212. #:validate-pull validate-pull)))))))
  213. (test-assert "channel-instances->manifest"
  214. ;; Compute the manifest for a graph of instances and make sure we get a
  215. ;; derivation graph that mirrors the instance graph. This test also ensures
  216. ;; we don't try to access Git repositores at all at this stage.
  217. (let* ((spec (lambda deps
  218. `(channel (version 0)
  219. (dependencies
  220. ,@(map (lambda (dep)
  221. `(channel
  222. (name ,dep)
  223. (url "http://example.org")))
  224. deps)))))
  225. (guix (make-instance #:name 'guix))
  226. (instance0 (make-instance #:name 'a))
  227. (instance1 (make-instance #:name 'b #:spec (spec 'a)))
  228. (instance2 (make-instance #:name 'c #:spec (spec 'b)))
  229. (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
  230. (%graft? #f) ;don't try to build stuff
  231. ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
  232. (let ((source (channel-instance-checkout guix)))
  233. (mkdir (string-append source "/build-aux"))
  234. (call-with-output-file (string-append source
  235. "/build-aux/build-self.scm")
  236. (lambda (port)
  237. (write '(begin
  238. (use-modules (guix) (gnu packages bootstrap))
  239. (lambda _
  240. (package->derivation %bootstrap-guile)))
  241. port))))
  242. (with-store store
  243. (let ()
  244. (define manifest
  245. (run-with-store store
  246. (channel-instances->manifest (list guix
  247. instance0 instance1
  248. instance2 instance3))))
  249. (define entries
  250. (manifest-entries manifest))
  251. (define (depends? drv in out)
  252. ;; Return true if DRV depends (directly or indirectly) on all of IN
  253. ;; and none of OUT.
  254. (let ((set (list->set
  255. (requisites store
  256. (list (derivation-file-name drv)))))
  257. (in (map derivation-file-name in))
  258. (out (map derivation-file-name out)))
  259. (and (every (cut set-contains? set <>) in)
  260. (not (any (cut set-contains? set <>) out)))))
  261. (define (lookup name)
  262. (run-with-store store
  263. (lower-object
  264. (manifest-entry-item
  265. (manifest-lookup manifest
  266. (manifest-pattern (name name)))))))
  267. (let ((drv-guix (lookup "guix"))
  268. (drv0 (lookup "a"))
  269. (drv1 (lookup "b"))
  270. (drv2 (lookup "c"))
  271. (drv3 (lookup "d")))
  272. (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
  273. (depends? drv0
  274. (list) (list drv1 drv2 drv3))
  275. (depends? drv1
  276. (list drv0) (list drv2 drv3))
  277. (depends? drv2
  278. (list drv1) (list drv3))
  279. (depends? drv3
  280. (list drv2 drv0) (list))))))))
  281. (unless (which (git-command)) (test-skip 1))
  282. (test-equal "channel-news, no news"
  283. '()
  284. (with-temporary-git-repository directory
  285. '((add "a.txt" "A")
  286. (commit "the commit"))
  287. (with-repository directory repository
  288. (let ((channel (channel (url (string-append "file://" directory))
  289. (name 'foo)))
  290. (latest (reference-name->oid repository "HEAD")))
  291. (channel-news-for-commit channel (oid->string latest))))))
  292. (unless (which (git-command)) (test-skip 1))
  293. (test-assert "channel-news, one entry"
  294. (with-temporary-git-repository directory
  295. `((add ".guix-channel"
  296. ,(object->string
  297. '(channel (version 0)
  298. (news-file "news.scm"))))
  299. (commit "first commit")
  300. (add "src/a.txt" "A")
  301. (commit "second commit")
  302. (tag "tag-for-first-news-entry")
  303. (add "news.scm"
  304. ,(lambda (repository)
  305. (let ((previous
  306. (reference-name->oid repository "HEAD")))
  307. (object->string
  308. `(channel-news
  309. (version 0)
  310. (entry (commit ,(oid->string previous))
  311. (title (en "New file!")
  312. (eo "Nova dosiero!"))
  313. (body (en "Yeah, a.txt."))))))))
  314. (commit "third commit")
  315. (add "src/b.txt" "B")
  316. (commit "fourth commit")
  317. (add "news.scm"
  318. ,(lambda (repository)
  319. (let ((second
  320. (commit-id
  321. (find-commit repository "second commit")))
  322. (previous
  323. (reference-name->oid repository "HEAD")))
  324. (object->string
  325. `(channel-news
  326. (version 0)
  327. (entry (commit ,(oid->string previous))
  328. (title (en "Another file!"))
  329. (body (en "Yeah, b.txt.")))
  330. (entry (tag "tag-for-first-news-entry")
  331. (title (en "Old news.")
  332. (eo "Malnovaĵoj."))
  333. (body (en "For a.txt"))))))))
  334. (commit "fifth commit"))
  335. (with-repository directory repository
  336. (define (find-commit* message)
  337. (oid->string (commit-id (find-commit repository message))))
  338. (let ((channel (channel (url (string-append "file://" directory))
  339. (name 'foo)))
  340. (commit1 (find-commit* "first commit"))
  341. (commit2 (find-commit* "second commit"))
  342. (commit3 (find-commit* "third commit"))
  343. (commit4 (find-commit* "fourth commit"))
  344. (commit5 (find-commit* "fifth commit")))
  345. ;; First try fetching all the news up to a given commit.
  346. (and (null? (channel-news-for-commit channel commit2))
  347. (lset= string=?
  348. (map channel-news-entry-commit
  349. (channel-news-for-commit channel commit5))
  350. (list commit2 commit4))
  351. (lset= equal?
  352. (map channel-news-entry-title
  353. (channel-news-for-commit channel commit5))
  354. '((("en" . "Another file!"))
  355. (("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
  356. (lset= string=?
  357. (map channel-news-entry-commit
  358. (channel-news-for-commit channel commit3))
  359. (list commit2))
  360. ;; Now fetch news entries that apply to a commit range.
  361. (lset= string=?
  362. (map channel-news-entry-commit
  363. (channel-news-for-commit channel commit3 commit1))
  364. (list commit2))
  365. (lset= string=?
  366. (map channel-news-entry-commit
  367. (channel-news-for-commit channel commit5 commit3))
  368. (list commit4))
  369. (lset= string=?
  370. (map channel-news-entry-commit
  371. (channel-news-for-commit channel commit5 commit1))
  372. (list commit4 commit2))
  373. (lset= equal?
  374. (map channel-news-entry-tag
  375. (channel-news-for-commit channel commit5 commit1))
  376. '(#f "tag-for-first-news-entry")))))))
  377. (unless (which (git-command)) (test-skip 1))
  378. (test-assert "channel-news, annotated tag"
  379. (with-temporary-git-repository directory
  380. `((add ".guix-channel"
  381. ,(object->string
  382. '(channel (version 0)
  383. (news-file "news.scm"))))
  384. (add "src/a.txt" "A")
  385. (commit "first commit")
  386. (tag "tag-for-first-news-entry"
  387. "This is an annotated tag.")
  388. (add "news.scm"
  389. ,(lambda (repository)
  390. (let ((previous
  391. (reference-name->oid repository "HEAD")))
  392. (object->string
  393. `(channel-news
  394. (version 0)
  395. (entry (tag "tag-for-first-news-entry")
  396. (title (en "New file!"))
  397. (body (en "Yeah, a.txt."))))))))
  398. (commit "second commit"))
  399. (with-repository directory repository
  400. (define (find-commit* message)
  401. (oid->string (commit-id (find-commit repository message))))
  402. (let ((channel (channel (url (string-append "file://" directory))
  403. (name 'foo)))
  404. (commit1 (find-commit* "first commit"))
  405. (commit2 (find-commit* "second commit")))
  406. (and (null? (channel-news-for-commit channel commit1))
  407. (lset= equal?
  408. (map channel-news-entry-title
  409. (channel-news-for-commit channel commit2))
  410. '((("en" . "New file!"))))
  411. (lset= string=?
  412. (map channel-news-entry-tag
  413. (channel-news-for-commit channel commit2))
  414. (list "tag-for-first-news-entry"))
  415. ;; This is an annotated tag, but 'channel-news-entry-commit'
  416. ;; should give us the commit ID, not the ID of the annotated tag
  417. ;; object.
  418. (lset= string=?
  419. (map channel-news-entry-commit
  420. (channel-news-for-commit channel commit2))
  421. (list commit1)))))))
  422. (unless (which (git-command)) (test-skip 1))
  423. (test-assert "latest-channel-instances, missing introduction for 'guix'"
  424. (with-temporary-git-repository directory
  425. '((add "a.txt" "A")
  426. (commit "first commit")
  427. (add "b.scm" "#t")
  428. (commit "second commit"))
  429. (with-repository directory repository
  430. (let* ((commit1 (find-commit repository "first"))
  431. (commit2 (find-commit repository "second"))
  432. (channel (channel (url (string-append "file://" directory))
  433. (name 'guix))))
  434. (guard (c ((formatted-message? c)
  435. (->bool (string-contains (formatted-message-string c)
  436. "introduction"))))
  437. (with-store store
  438. ;; Attempt a downgrade from NEW to OLD.
  439. (latest-channel-instances store (list channel))
  440. #f))))))
  441. (unless (gpg+git-available?) (test-skip 1))
  442. (test-equal "authenticate-channel, wrong first commit signer"
  443. #t
  444. (with-fresh-gnupg-setup (list %ed25519-public-key-file
  445. %ed25519-secret-key-file
  446. %ed25519-2-public-key-file
  447. %ed25519-2-secret-key-file)
  448. (with-temporary-git-repository directory
  449. `((add ".guix-channel"
  450. ,(object->string
  451. '(channel (version 0)
  452. (keyring-reference "master"))))
  453. (add ".guix-authorizations"
  454. ,(object->string
  455. `(authorizations (version 0)
  456. ((,(key-fingerprint
  457. %ed25519-public-key-file)
  458. (name "Charlie"))))))
  459. (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
  460. get-string-all))
  461. (commit "first commit"
  462. (signer ,(key-fingerprint %ed25519-public-key-file)))
  463. (add "random" ,(random-text))
  464. (commit "second commit"
  465. (signer ,(key-fingerprint %ed25519-public-key-file))))
  466. (with-repository directory repository
  467. (let* ((commit1 (find-commit repository "first"))
  468. (commit2 (find-commit repository "second"))
  469. (intro (make-channel-introduction
  470. (commit-id-string commit1)
  471. (openpgp-public-key-fingerprint
  472. (read-openpgp-packet
  473. %ed25519-2-public-key-file)))) ;different key
  474. (channel (channel (name 'example)
  475. (url (string-append "file://" directory))
  476. (introduction intro))))
  477. (guard (c ((formatted-message? c)
  478. (and (string-contains (formatted-message-string c)
  479. "initial commit")
  480. (equal? (formatted-message-arguments c)
  481. (list
  482. (oid->string (commit-id commit1))
  483. (key-fingerprint %ed25519-public-key-file)
  484. (key-fingerprint
  485. %ed25519-2-public-key-file))))))
  486. (authenticate-channel channel directory
  487. (commit-id-string commit2)
  488. #:keyring-reference-prefix "")
  489. 'failed))))))
  490. (unless (gpg+git-available?) (test-skip 1))
  491. (test-equal "authenticate-channel, not a descendant of introductory commit"
  492. #t
  493. (with-fresh-gnupg-setup (list %ed25519-public-key-file
  494. %ed25519-secret-key-file
  495. %ed25519-2-public-key-file
  496. %ed25519-2-secret-key-file)
  497. (with-temporary-git-repository directory
  498. `((add ".guix-channel"
  499. ,(object->string
  500. '(channel (version 0)
  501. (keyring-reference "master"))))
  502. (add ".guix-authorizations"
  503. ,(object->string
  504. `(authorizations (version 0)
  505. ((,(key-fingerprint
  506. %ed25519-public-key-file)
  507. (name "Charlie"))))))
  508. (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
  509. get-string-all))
  510. (commit "first commit"
  511. (signer ,(key-fingerprint %ed25519-public-key-file)))
  512. (branch "alternate-branch")
  513. (checkout "alternate-branch")
  514. (add "something.txt" ,(random-text))
  515. (commit "intro commit"
  516. (signer ,(key-fingerprint %ed25519-public-key-file)))
  517. (checkout "master")
  518. (add "random" ,(random-text))
  519. (commit "second commit"
  520. (signer ,(key-fingerprint %ed25519-public-key-file))))
  521. (with-repository directory repository
  522. (let* ((commit1 (find-commit repository "first"))
  523. (commit2 (find-commit repository "second"))
  524. (commit0 (commit-lookup
  525. repository
  526. (reference-target
  527. (branch-lookup repository "alternate-branch"))))
  528. (intro (make-channel-introduction
  529. (commit-id-string commit0)
  530. (openpgp-public-key-fingerprint
  531. (read-openpgp-packet
  532. %ed25519-public-key-file))))
  533. (channel (channel (name 'example)
  534. (url (string-append "file://" directory))
  535. (introduction intro))))
  536. (guard (c ((formatted-message? c)
  537. (and (string-contains (formatted-message-string c)
  538. "not a descendant")
  539. (equal? (formatted-message-arguments c)
  540. (list
  541. (oid->string (commit-id commit2))
  542. (oid->string (commit-id commit0)))))))
  543. (authenticate-channel channel directory
  544. (commit-id-string commit2)
  545. #:keyring-reference-prefix "")
  546. 'failed))))))
  547. (unless (gpg+git-available?) (test-skip 1))
  548. (test-equal "authenticate-channel, .guix-authorizations"
  549. #t
  550. (with-fresh-gnupg-setup (list %ed25519-public-key-file
  551. %ed25519-secret-key-file
  552. %ed25519-2-public-key-file
  553. %ed25519-2-secret-key-file)
  554. (with-temporary-git-repository directory
  555. `((add ".guix-channel"
  556. ,(object->string
  557. '(channel (version 0)
  558. (keyring-reference "channel-keyring"))))
  559. (add ".guix-authorizations"
  560. ,(object->string
  561. `(authorizations (version 0)
  562. ((,(key-fingerprint
  563. %ed25519-public-key-file)
  564. (name "Charlie"))))))
  565. (commit "zeroth commit")
  566. (add "a.txt" "A")
  567. (commit "first commit"
  568. (signer ,(key-fingerprint %ed25519-public-key-file)))
  569. (add "b.txt" "B")
  570. (commit "second commit"
  571. (signer ,(key-fingerprint %ed25519-public-key-file)))
  572. (add "c.txt" "C")
  573. (commit "third commit"
  574. (signer ,(key-fingerprint %ed25519-2-public-key-file)))
  575. (branch "channel-keyring")
  576. (checkout "channel-keyring")
  577. (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
  578. get-string-all))
  579. (add "other.key" ,(call-with-input-file %ed25519-2-public-key-file
  580. get-string-all))
  581. (commit "keyring commit")
  582. (checkout "master"))
  583. (with-repository directory repository
  584. (let* ((commit1 (find-commit repository "first"))
  585. (commit2 (find-commit repository "second"))
  586. (commit3 (find-commit repository "third"))
  587. (intro (make-channel-introduction
  588. (commit-id-string commit1)
  589. (openpgp-public-key-fingerprint
  590. (read-openpgp-packet
  591. %ed25519-public-key-file))))
  592. (channel (channel (name 'example)
  593. (url (string-append "file://" directory))
  594. (introduction intro))))
  595. ;; COMMIT1 and COMMIT2 are fine.
  596. (and (authenticate-channel channel directory
  597. (commit-id-string commit2)
  598. #:keyring-reference-prefix "")
  599. ;; COMMIT3 is signed by an unauthorized key according to its
  600. ;; parent's '.guix-authorizations' file.
  601. (guard (c ((unauthorized-commit-error? c)
  602. (and (oid=? (git-authentication-error-commit c)
  603. (commit-id commit3))
  604. (bytevector=?
  605. (openpgp-public-key-fingerprint
  606. (unauthorized-commit-error-signing-key c))
  607. (openpgp-public-key-fingerprint
  608. (read-openpgp-packet
  609. %ed25519-2-public-key-file))))))
  610. (authenticate-channel channel directory
  611. (commit-id-string commit3)
  612. #:keyring-reference-prefix "")
  613. 'failed)))))))
  614. (unless (gpg+git-available?) (test-skip 1))
  615. (test-equal "latest-channel-instances, authenticate dependency"
  616. #t
  617. ;; Make sure that a channel dependency that has an introduction is
  618. ;; authenticated. This test checks that an authentication error is raised
  619. ;; as it should when authenticating the dependency.
  620. (with-fresh-gnupg-setup (list %ed25519-public-key-file
  621. %ed25519-secret-key-file)
  622. (with-temporary-git-repository dependency-directory
  623. `((add ".guix-channel"
  624. ,(object->string
  625. '(channel (version 0)
  626. (keyring-reference "master"))))
  627. (add ".guix-authorizations"
  628. ,(object->string
  629. `(authorizations (version 0) ())))
  630. (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
  631. get-string-all))
  632. (commit "zeroth commit"
  633. (signer ,(key-fingerprint %ed25519-public-key-file)))
  634. (add "foo.txt" "evil")
  635. (commit "unsigned commit"))
  636. (with-repository dependency-directory dependency
  637. (let* ((commit0 (find-commit dependency "zeroth"))
  638. (commit1 (find-commit dependency "unsigned"))
  639. (intro `(channel-introduction
  640. (version 0)
  641. (commit ,(commit-id-string commit0))
  642. (signer ,(openpgp-format-fingerprint
  643. (openpgp-public-key-fingerprint
  644. (read-openpgp-packet
  645. %ed25519-public-key-file)))))))
  646. (with-temporary-git-repository directory
  647. `((add ".guix-channel"
  648. ,(object->string
  649. `(channel (version 0)
  650. (dependencies
  651. (channel
  652. (name test-channel)
  653. (url ,dependency-directory)
  654. (introduction ,intro))))))
  655. (commit "single commit"))
  656. (let ((channel (channel (name 'test) (url directory))))
  657. (guard (c ((unsigned-commit-error? c)
  658. (oid=? (git-authentication-error-commit c)
  659. (commit-id commit1))))
  660. (with-store store
  661. (latest-channel-instances store (list channel))
  662. 'failed)))))))))
  663. (test-end "channels")