channels.scm 31 KB

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