X-Git-Url: http://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/d1f3b333e6176a7879ab3742bbebb2a99f61a528..b6bc4c109b807c646e99ec40360e681122d85b2c:/tests/channels.scm diff --git a/tests/channels.scm b/tests/channels.scm index f5a7955483..0fe870dbaf 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2019, 2020, 2022 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,19 +27,37 @@ #:use-module (guix derivations) #:use-module (guix sets) #:use-module (guix gexp) - #:use-module ((guix utils) - #:select (error-location? error-location location-line)) + #:use-module ((guix diagnostics) + #:select (error-location? + error-location location-line + formatted-message? + formatted-message-string + formatted-message-arguments)) #:use-module ((guix build utils) #:select (which)) #:use-module (git) #:use-module (guix git) + #:use-module (guix git-authenticate) + #:use-module (guix openpgp) #:use-module (guix tests git) + #:use-module (guix tests gnupg) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (ice-9 control) #:use-module (ice-9 match)) +(define (gpg+git-available?) + (and (which (git-command)) + (which (gpg-command)) (which (gpgconf-command)))) + +(define commit-id-string + (compose oid->string commit-id)) + + (test-begin "channels") (define* (make-instance #:key @@ -135,44 +154,82 @@ (name 'test) (url "test"))) (test-dir (channel-instance-checkout instance--simple))) - (mock ((guix git) latest-repository-commit - (lambda* (store url #:key ref) + (mock ((guix git) update-cached-checkout + (lambda* (url #:key ref starting-commit) (match url - ("test" (values test-dir 'whatever)) - (_ (values "/not-important" 'not-important))))) - (let ((instances (latest-channel-instances #f (list channel)))) - (and (eq? 2 (length instances)) - (lset= eq? - '(test test-channel) - (map (compose channel-name channel-instance-channel) - instances))))))) + ("test" (values test-dir "caf3cabba9e" #f)) + (_ (values (channel-instance-checkout instance--no-deps) + "abcde1234" #f))))) + (with-store store + (let ((instances (latest-channel-instances store (list channel)))) + (and (eq? 2 (length instances)) + (lset= eq? + '(test test-channel) + (map (compose channel-name channel-instance-channel) + instances)))))))) (test-assert "latest-channel-instances excludes duplicate channel dependencies" (let* ((channel (channel (name 'test) (url "test"))) (test-dir (channel-instance-checkout instance--with-dupes))) - (mock ((guix git) latest-repository-commit - (lambda* (store url #:key ref) + (mock ((guix git) update-cached-checkout + (lambda* (url #:key ref starting-commit) (match url - ("test" (values test-dir 'whatever)) - (_ (values "/not-important" 'not-important))))) - (let ((instances (latest-channel-instances #f (list channel)))) - (and (= 2 (length instances)) - (lset= eq? - '(test test-channel) - (map (compose channel-name channel-instance-channel) - instances)) - ;; only the most specific channel dependency should remain, - ;; i.e. the one with a specified commit. - (find (lambda (instance) - (and (eq? (channel-name - (channel-instance-channel instance)) - 'test-channel) - (string=? (channel-commit - (channel-instance-channel instance)) - "abc1234"))) - instances)))))) + ("test" (values test-dir "caf3cabba9e" #f)) + (_ (values (channel-instance-checkout instance--no-deps) + "abcde1234" #f))))) + (with-store store + (let ((instances (latest-channel-instances store (list channel)))) + (and (= 2 (length instances)) + (lset= eq? + '(test test-channel) + (map (compose channel-name channel-instance-channel) + instances)) + ;; only the most specific channel dependency should remain, + ;; i.e. the one with a specified commit. + (find (lambda (instance) + (and (eq? (channel-name + (channel-instance-channel instance)) + 'test-channel) + (string=? (channel-commit + (channel-instance-channel instance)) + "abc1234"))) + instances))))))) + +(unless (which (git-command)) (test-skip 1)) +(test-equal "latest-channel-instances #:validate-pull" + 'descendant + + ;; Make sure the #:validate-pull procedure receives the right values. + (let/ec return + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (add "b.scm" "#t") + (commit "second commit")) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (spec (channel (url (string-append "file://" directory)) + (name 'foo))) + (new (channel (inherit spec) + (commit (oid->string (commit-id commit2))))) + (old (channel (inherit spec) + (commit (oid->string (commit-id commit1)))))) + (define (validate-pull channel current commit relation) + (return (and (eq? channel old) + (string=? (oid->string (commit-id commit2)) + current) + (string=? (oid->string (commit-id commit1)) + commit) + relation))) + + (with-store store + ;; Attempt a downgrade from NEW to OLD. + (latest-channel-instances store (list old) + #:current-channels (list new) + #:validate-pull validate-pull))))))) (test-assert "channel-instances->manifest" ;; Compute the manifest for a graph of instances and make sure we get a @@ -350,4 +407,299 @@ (channel-news-for-commit channel commit5 commit1)) '(#f "tag-for-first-news-entry"))))))) +(unless (which (git-command)) (test-skip 1)) +(test-assert "channel-news, annotated tag" + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (news-file "news.scm")))) + (add "src/a.txt" "A") + (commit "first commit") + (tag "tag-for-first-news-entry" + "This is an annotated tag.") + (add "news.scm" + ,(lambda (repository) + (let ((previous + (reference-name->oid repository "HEAD"))) + (object->string + `(channel-news + (version 0) + (entry (tag "tag-for-first-news-entry") + (title (en "New file!")) + (body (en "Yeah, a.txt.")))))))) + (commit "second commit")) + (with-repository directory repository + (define (find-commit* message) + (oid->string (commit-id (find-commit repository message)))) + + (let ((channel (channel (url (string-append "file://" directory)) + (name 'foo))) + (commit1 (find-commit* "first commit")) + (commit2 (find-commit* "second commit"))) + (and (null? (channel-news-for-commit channel commit1)) + (lset= equal? + (map channel-news-entry-title + (channel-news-for-commit channel commit2)) + '((("en" . "New file!")))) + (lset= string=? + (map channel-news-entry-tag + (channel-news-for-commit channel commit2)) + (list "tag-for-first-news-entry")) + ;; This is an annotated tag, but 'channel-news-entry-commit' + ;; should give us the commit ID, not the ID of the annotated tag + ;; object. + (lset= string=? + (map channel-news-entry-commit + (channel-news-for-commit channel commit2)) + (list commit1))))))) + +(unless (which (git-command)) (test-skip 1)) +(test-assert "latest-channel-instances, missing introduction for 'guix'" + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (add "b.scm" "#t") + (commit "second commit")) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (channel (channel (url (string-append "file://" directory)) + (name 'guix)))) + + (guard (c ((formatted-message? c) + (->bool (string-contains (formatted-message-string c) + "introduction")))) + (with-store store + ;; Attempt a downgrade from NEW to OLD. + (latest-channel-instances store (list channel)) + #f)))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "authenticate-channel, wrong first commit signer" + #t + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519-2-public-key-file + %ed25519-2-secret-key-file) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "master")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "random" ,(random-text)) + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (intro (make-channel-introduction + (commit-id-string commit1) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-2-public-key-file)))) ;different key + (channel (channel (name 'example) + (url (string-append "file://" directory)) + (introduction intro)))) + (guard (c ((formatted-message? c) + (and (string-contains (formatted-message-string c) + "initial commit") + (equal? (formatted-message-arguments c) + (list + (oid->string (commit-id commit1)) + (key-fingerprint %ed25519-public-key-file) + (key-fingerprint + %ed25519-2-public-key-file)))))) + (authenticate-channel channel directory + (commit-id-string commit2) + #:keyring-reference-prefix "") + 'failed)))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "authenticate-channel, not a descendant of introductory commit" + #t + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519-2-public-key-file + %ed25519-2-secret-key-file) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "master")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (branch "alternate-branch") + (checkout "alternate-branch") + (add "something.txt" ,(random-text)) + (commit "intro commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (checkout "master") + (add "random" ,(random-text)) + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit0 (commit-lookup + repository + (reference-target + (branch-lookup repository "alternate-branch")))) + (intro (make-channel-introduction + (commit-id-string commit0) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file)))) + (channel (channel (name 'example) + (url (string-append "file://" directory)) + (introduction intro)))) + (guard (c ((formatted-message? c) + (and (string-contains (formatted-message-string c) + "not a descendant") + (equal? (formatted-message-arguments c) + (list + (oid->string (commit-id commit2)) + (oid->string (commit-id commit0))))))) + (authenticate-channel channel directory + (commit-id-string commit2) + #:keyring-reference-prefix "") + 'failed)))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "authenticate-channel, .guix-authorizations" + #t + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519-2-public-key-file + %ed25519-2-secret-key-file) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "channel-keyring")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "c.txt" "C") + (commit "third commit" + (signer ,(key-fingerprint %ed25519-2-public-key-file))) + (branch "channel-keyring") + (checkout "channel-keyring") + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add "other.key" ,(call-with-input-file %ed25519-2-public-key-file + get-string-all)) + (commit "keyring commit") + (checkout "master")) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit3 (find-commit repository "third")) + (intro (make-channel-introduction + (commit-id-string commit1) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file)))) + (channel (channel (name 'example) + (url (string-append "file://" directory)) + (introduction intro)))) + ;; COMMIT1 and COMMIT2 are fine. + (and (authenticate-channel channel directory + (commit-id-string commit2) + #:keyring-reference-prefix "") + + ;; COMMIT3 is signed by an unauthorized key according to its + ;; parent's '.guix-authorizations' file. + (guard (c ((unauthorized-commit-error? c) + (and (oid=? (git-authentication-error-commit c) + (commit-id commit3)) + (bytevector=? + (openpgp-public-key-fingerprint + (unauthorized-commit-error-signing-key c)) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-2-public-key-file)))))) + (authenticate-channel channel directory + (commit-id-string commit3) + #:keyring-reference-prefix "") + 'failed))))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "latest-channel-instances, authenticate dependency" + #t + ;; Make sure that a channel dependency that has an introduction is + ;; authenticated. This test checks that an authentication error is raised + ;; as it should when authenticating the dependency. + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository dependency-directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "master")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) ()))) + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "zeroth commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "foo.txt" "evil") + (commit "unsigned commit")) + (with-repository dependency-directory dependency + (let* ((commit0 (find-commit dependency "zeroth")) + (commit1 (find-commit dependency "unsigned")) + (intro `(channel-introduction + (version 0) + (commit ,(commit-id-string commit0)) + (signer ,(openpgp-format-fingerprint + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file))))))) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + `(channel (version 0) + (dependencies + (channel + (name test-channel) + (url ,dependency-directory) + (introduction ,intro)))))) + (commit "single commit")) + (let ((channel (channel (name 'test) (url directory)))) + (guard (c ((unsigned-commit-error? c) + (oid=? (git-authentication-error-commit c) + (commit-id commit1)))) + (with-store store + (latest-channel-instances store (list channel)) + 'failed))))))))) + (test-end "channels")