From patchwork Mon Jun 1 21:41:44 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 22512 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id C922727BBE1; Mon, 1 Jun 2020 22:48:44 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 5127B27BBE3 for ; Mon, 1 Jun 2020 22:48:41 +0100 (BST) Received: from localhost ([::1]:48696 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsIS-0003a2-P0 for patchwork@mira.cbaines.net; Mon, 01 Jun 2020 17:48:40 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:57982) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jfsC2-0008Ln-FS for guix-patches@gnu.org; Mon, 01 Jun 2020 17:42:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53913) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jfsC2-00073F-50 for guix-patches@gnu.org; Mon, 01 Jun 2020 17:42:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jfsC2-0002OV-2N for guix-patches@gnu.org; Mon, 01 Jun 2020 17:42:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41653] [PATCH 1/4] Add (guix git-authenticate). References: <20200601212957.3056-1-ludo@gnu.org> In-Reply-To: <20200601212957.3056-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 01 Jun 2020 21:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41653 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41653@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41653-submit@debbugs.gnu.org id=B41653.15910477219194 (code B ref 41653); Mon, 01 Jun 2020 21:42:02 +0000 Received: (at 41653) by debbugs.gnu.org; 1 Jun 2020 21:42:01 +0000 Received: from localhost ([127.0.0.1]:37224 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsC0-0002OA-IJ for submit@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:01 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50546) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsBz-0002Nu-25 for 41653@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:00 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57935) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsBt-00072v-Po; Mon, 01 Jun 2020 17:41:53 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=51784 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jfsBt-0007Sn-Al; Mon, 01 Jun 2020 17:41:53 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 1 Jun 2020 23:41:44 +0200 Message-Id: <20200601214147.3357-1-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * build-aux/git-authenticate.scm (commit-signing-key) (read-authorizations, commit-authorized-keys, authenticate-commit) (load-keyring-from-blob, load-keyring-from-reference) (authenticate-commits, authenticated-commit-cache-file) (previously-authenticated-commits, cache-authenticated-commit): Remove. * build-aux/git-authenticate.scm (git-authenticate): Pass #:default-authorizations to 'authenticate-commits'. * guix/git-authenticate.scm: New file, with code taken from 'build-aux/git-authenticate.scm'. Remove references to '%historical-authorized-signing-keys' and add #:default-authorizations parameter instead. * Makefile.am (MODULES): Add it. (authenticate): Depend on guix/git-authenticate.go. --- Makefile.am | 3 +- build-aux/git-authenticate.scm | 203 +-------------------------- guix/git-authenticate.scm | 244 +++++++++++++++++++++++++++++++++ 3 files changed, 253 insertions(+), 197 deletions(-) create mode 100644 guix/git-authenticate.scm diff --git a/Makefile.am b/Makefile.am index 5b64386b53..db30004b1b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -104,6 +104,7 @@ MODULES = \ guix/lint.scm \ guix/glob.scm \ guix/git.scm \ + guix/git-authenticate.scm \ guix/graph.scm \ guix/cache.scm \ guix/cve.scm \ @@ -632,7 +633,7 @@ commit_v1_0_1 = d68de958b60426798ed62797ff7c96c327a672ac # Authenticate the current Git checkout by checking signatures on every commit # starting from $(commit_v1_0_1). -authenticate: guix/openpgp.go guix/git.go +authenticate: guix/openpgp.go guix/git-authenticate.go guix/git.go $(AM_V_at)echo "Authenticating Git checkout..." ; \ "$(top_builddir)/pre-inst-env" $(GUILE) \ --no-auto-compile -e git-authenticate \ diff --git a/build-aux/git-authenticate.scm b/build-aux/git-authenticate.scm index 8e679fd5e5..5e1fdaaa24 100644 --- a/build-aux/git-authenticate.scm +++ b/build-aux/git-authenticate.scm @@ -22,21 +22,16 @@ ;;; (use-modules (git) - (guix git) - (guix openpgp) (guix base16) - ((guix utils) - #:select (cache-directory with-atomic-file-output)) - ((guix build utils) #:select (mkdir-p)) + (guix git) + (guix git-authenticate) (guix i18n) + ((guix openpgp) + #:select (openpgp-public-key-fingerprint + openpgp-format-fingerprint)) (guix progress) (srfi srfi-1) - (srfi srfi-11) (srfi srfi-26) - (srfi srfi-34) - (srfi srfi-35) - (rnrs bytevectors) - (rnrs io ports) (ice-9 match) (ice-9 format) (ice-9 pretty-print)) @@ -231,195 +226,9 @@ ;; Commits lacking a signature. '()) -(define (commit-signing-key repo commit-id keyring) - "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception -if the commit is unsigned, has an invalid signature, or if its signing key is -not in KEYRING." - (let-values (((signature signed-data) - (catch 'git-error - (lambda () - (commit-extract-signature repo commit-id)) - (lambda _ - (values #f #f))))) - (unless signature - (raise (condition - (&message - (message (format #f (G_ "commit ~a lacks a signature") - commit-id)))))) - - (let ((signature (string->openpgp-packet signature))) - (with-fluids ((%default-port-encoding "UTF-8")) - (let-values (((status data) - (verify-openpgp-signature signature keyring - (open-input-string signed-data)))) - (match status - ('bad-signature - ;; There's a signature but it's invalid. - (raise (condition - (&message - (message (format #f (G_ "signature verification failed \ -for commit ~a") - (oid->string commit-id))))))) - ('missing-key - (raise (condition - (&message - (message (format #f (G_ "could not authenticate \ -commit ~a: key ~a is missing") - (oid->string commit-id) - data)))))) - ('good-signature data))))))) - -(define (read-authorizations port) - "Read authorizations in the '.guix-authorizations' format from PORT, and -return a list of authorized fingerprints." - (match (read port) - (('authorizations ('version 0) - (((? string? fingerprints) _ ...) ...) - _ ...) - (map (lambda (fingerprint) - (base16-string->bytevector - (string-downcase (string-filter char-set:graphic fingerprint)))) - fingerprints)))) - -(define* (commit-authorized-keys repository commit - #:optional (default-authorizations '())) - "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on -authorizations listed in its parent commits. If one of the parent commits -does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." - (define (commit-authorizations commit) - (catch 'git-error - (lambda () - (let* ((tree (commit-tree commit)) - (entry (tree-entry-bypath tree ".guix-authorizations")) - (blob (blob-lookup repository (tree-entry-id entry)))) - (read-authorizations - (open-bytevector-input-port (blob-content blob))))) - (lambda (key error) - (if (= (git-error-code error) GIT_ENOTFOUND) - default-authorizations - (throw key error))))) - - (apply lset-intersection bytevector=? - (map commit-authorizations (commit-parents commit)))) - -(define (authenticate-commit repository commit keyring) - "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. -Raise an error when authentication fails." - (define id - (commit-id commit)) - - (define signing-key - (commit-signing-key repository id keyring)) - - (unless (member (openpgp-public-key-fingerprint signing-key) - (commit-authorized-keys repository commit - %historical-authorized-signing-keys)) - (raise (condition - (&message - (message (format #f (G_ "commit ~a not signed by an authorized \ -key: ~a") - (oid->string id) - (openpgp-format-fingerprint - (openpgp-public-key-fingerprint - signing-key)))))))) - - signing-key) - -(define (load-keyring-from-blob repository oid keyring) - "Augment KEYRING with the keyring available in the blob at OID, which may or -may not be ASCII-armored." - (let* ((blob (blob-lookup repository oid)) - (port (open-bytevector-input-port (blob-content blob)))) - (get-openpgp-keyring (if (port-ascii-armored? port) - (open-bytevector-input-port (read-radix-64 port)) - port) - keyring))) - -(define (load-keyring-from-reference repository reference) - "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return -an OpenPGP keyring." - (let* ((reference (branch-lookup repository - (string-append "origin/" reference) - BRANCH-REMOTE)) - (target (reference-target reference)) - (commit (commit-lookup repository target)) - (tree (commit-tree commit))) - (fold (lambda (name keyring) - (if (string-suffix? ".key" name) - (let ((entry (tree-entry-bypath tree name))) - (load-keyring-from-blob repository - (tree-entry-id entry) - keyring)) - keyring)) - %empty-keyring - (tree-list tree)))) - -(define* (authenticate-commits repository commits - #:key - (keyring-reference "keyring") - (report-progress (const #t))) - "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for -each of them. Return an alist showing the number of occurrences of each key. -The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY." - (define keyring - (load-keyring-from-reference repository keyring-reference)) - - (fold (lambda (commit stats) - (report-progress) - (let ((signer (authenticate-commit repository commit keyring))) - (match (assq signer stats) - (#f (cons `(,signer . 1) stats)) - ((_ . count) (cons `(,signer . ,(+ count 1)) - (alist-delete signer stats)))))) - '() - commits)) - (define commit-short-id (compose (cut string-take <> 7) oid->string commit-id)) - -;;; -;;; Caching. -;;; - -(define (authenticated-commit-cache-file) - "Return the name of the file that contains the cache of -previously-authenticated commits." - (string-append (cache-directory) "/authentication/channels/guix")) - -(define (previously-authenticated-commits) - "Return the previously-authenticated commits as a list of commit IDs (hex -strings)." - (catch 'system-error - (lambda () - (call-with-input-file (authenticated-commit-cache-file) - read)) - (lambda args - (if (= ENOENT (system-error-errno args)) - '() - (apply throw args))))) - -(define (cache-authenticated-commit commit-id) - "Record in ~/.cache COMMIT-ID and its closure as authenticated (only -COMMIT-ID is written to cache, though)." - (define %max-cache-length - ;; Maximum number of commits in cache. - 200) - - (let ((lst (delete-duplicates - (cons commit-id (previously-authenticated-commits)))) - (file (authenticated-commit-cache-file))) - (mkdir-p (dirname file)) - (with-atomic-file-output file - (lambda (port) - (let ((lst (if (> (length lst) %max-cache-length) - (take lst %max-cache-length) ;truncate - lst))) - (chmod port #o600) - (display ";; List of previously-authenticated commits.\n\n" - port) - (pretty-print lst port)))))) - ;;; ;;; Entry point. @@ -462,6 +271,8 @@ COMMIT-ID is written to cache, though)." (let ((stats (call-with-progress-reporter reporter (lambda (report) (authenticate-commits repository commits + #:default-authorizations + %historical-authorized-signing-keys #:report-progress report))))) (cache-authenticated-commit (oid->string (commit-id end-commit))) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm new file mode 100644 index 0000000000..4df56fab59 --- /dev/null +++ b/guix/git-authenticate.scm @@ -0,0 +1,244 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019, 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix git-authenticate) + #:use-module (git) + #:use-module (guix base16) + #:use-module (guix i18n) + #:use-module (guix openpgp) + #:use-module ((guix utils) + #:select (cache-directory with-atomic-file-output)) + #:use-module ((guix build utils) + #:select (mkdir-p)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (ice-9 match) + #:autoload (ice-9 pretty-print) (pretty-print) + #:export (read-authorizations + commit-signing-key + commit-authorized-keys + authenticate-commit + authenticate-commits + load-keyring-from-reference + previously-authenticated-commits + cache-authenticated-commit)) + +;;; Commentary: +;;; +;;; This module provides tools to authenticate a range of Git commits. A +;;; commit is considered "authentic" if and only if it is signed by an +;;; authorized party. Parties authorized to sign a commit are listed in the +;;; '.guix-authorizations' file of the parent commit. +;;; +;;; Code: + +(define (commit-signing-key repo commit-id keyring) + "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception +if the commit is unsigned, has an invalid signature, or if its signing key is +not in KEYRING." + (let-values (((signature signed-data) + (catch 'git-error + (lambda () + (commit-extract-signature repo commit-id)) + (lambda _ + (values #f #f))))) + (unless signature + (raise (condition + (&message + (message (format #f (G_ "commit ~a lacks a signature") + commit-id)))))) + + (let ((signature (string->openpgp-packet signature))) + (with-fluids ((%default-port-encoding "UTF-8")) + (let-values (((status data) + (verify-openpgp-signature signature keyring + (open-input-string signed-data)))) + (match status + ('bad-signature + ;; There's a signature but it's invalid. + (raise (condition + (&message + (message (format #f (G_ "signature verification failed \ +for commit ~a") + (oid->string commit-id))))))) + ('missing-key + (raise (condition + (&message + (message (format #f (G_ "could not authenticate \ +commit ~a: key ~a is missing") + (oid->string commit-id) + data)))))) + ('good-signature data))))))) + +(define (read-authorizations port) + "Read authorizations in the '.guix-authorizations' format from PORT, and +return a list of authorized fingerprints." + (match (read port) + (('authorizations ('version 0) + (((? string? fingerprints) _ ...) ...) + _ ...) + (map (lambda (fingerprint) + (base16-string->bytevector + (string-downcase (string-filter char-set:graphic fingerprint)))) + fingerprints)))) + +(define* (commit-authorized-keys repository commit + #:optional (default-authorizations '())) + "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on +authorizations listed in its parent commits. If one of the parent commits +does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." + (define (commit-authorizations commit) + (catch 'git-error + (lambda () + (let* ((tree (commit-tree commit)) + (entry (tree-entry-bypath tree ".guix-authorizations")) + (blob (blob-lookup repository (tree-entry-id entry)))) + (read-authorizations + (open-bytevector-input-port (blob-content blob))))) + (lambda (key error) + (if (= (git-error-code error) GIT_ENOTFOUND) + default-authorizations + (throw key error))))) + + (apply lset-intersection bytevector=? + (map commit-authorizations (commit-parents commit)))) + +(define* (authenticate-commit repository commit keyring + #:key (default-authorizations '())) + "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. +Raise an error when authentication fails. If one of the parent commits does +not specify anything, fall back to DEFAULT-AUTHORIZATIONS." + (define id + (commit-id commit)) + + (define signing-key + (commit-signing-key repository id keyring)) + + (unless (member (openpgp-public-key-fingerprint signing-key) + (commit-authorized-keys repository commit + default-authorizations)) + (raise (condition + (&message + (message (format #f (G_ "commit ~a not signed by an authorized \ +key: ~a") + (oid->string id) + (openpgp-format-fingerprint + (openpgp-public-key-fingerprint + signing-key)))))))) + + signing-key) + +(define (load-keyring-from-blob repository oid keyring) + "Augment KEYRING with the keyring available in the blob at OID, which may or +may not be ASCII-armored." + (let* ((blob (blob-lookup repository oid)) + (port (open-bytevector-input-port (blob-content blob)))) + (get-openpgp-keyring (if (port-ascii-armored? port) + (open-bytevector-input-port (read-radix-64 port)) + port) + keyring))) + +(define (load-keyring-from-reference repository reference) + "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return +an OpenPGP keyring." + (let* ((reference (branch-lookup repository + (string-append "origin/" reference) + BRANCH-REMOTE)) + (target (reference-target reference)) + (commit (commit-lookup repository target)) + (tree (commit-tree commit))) + (fold (lambda (name keyring) + (if (string-suffix? ".key" name) + (let ((entry (tree-entry-bypath tree name))) + (load-keyring-from-blob repository + (tree-entry-id entry) + keyring)) + keyring)) + %empty-keyring + (tree-list tree)))) + +(define* (authenticate-commits repository commits + #:key + (default-authorizations '()) + (keyring-reference "keyring") + (report-progress (const #t))) + "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for +each of them. Return an alist showing the number of occurrences of each key. +The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY." + (define keyring + (load-keyring-from-reference repository keyring-reference)) + + (fold (lambda (commit stats) + (report-progress) + (let ((signer (authenticate-commit repository commit keyring + #:default-authorizations + default-authorizations))) + (match (assq signer stats) + (#f (cons `(,signer . 1) stats)) + ((_ . count) (cons `(,signer . ,(+ count 1)) + (alist-delete signer stats)))))) + '() + commits)) + + +;;; +;;; Caching. +;;; + +(define (authenticated-commit-cache-file) + "Return the name of the file that contains the cache of +previously-authenticated commits." + (string-append (cache-directory) "/authentication/channels/guix")) + +(define (previously-authenticated-commits) + "Return the previously-authenticated commits as a list of commit IDs (hex +strings)." + (catch 'system-error + (lambda () + (call-with-input-file (authenticated-commit-cache-file) + read)) + (lambda args + (if (= ENOENT (system-error-errno args)) + '() + (apply throw args))))) + +(define (cache-authenticated-commit commit-id) + "Record in ~/.cache COMMIT-ID and its closure as authenticated (only +COMMIT-ID is written to cache, though)." + (define %max-cache-length + ;; Maximum number of commits in cache. + 200) + + (let ((lst (delete-duplicates + (cons commit-id (previously-authenticated-commits)))) + (file (authenticated-commit-cache-file))) + (mkdir-p (dirname file)) + (with-atomic-file-output file + (lambda (port) + (let ((lst (if (> (length lst) %max-cache-length) + (take lst %max-cache-length) ;truncate + lst))) + (chmod port #o600) + (display ";; List of previously-authenticated commits.\n\n" + port) + (pretty-print lst port)))))) From patchwork Mon Jun 1 21:41:45 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 22511 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 697E427BBE3; Mon, 1 Jun 2020 22:43:23 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 13C0E27BBE1 for ; Mon, 1 Jun 2020 22:43:23 +0100 (BST) Received: from localhost ([::1]:43172 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsDK-0000lQ-If for patchwork@mira.cbaines.net; Mon, 01 Jun 2020 17:43:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59092) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jfsD0-0000WW-RK for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53922) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jfsD0-0007fa-GH for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jfsD0-0002Qa-Eg for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41653] [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 01 Jun 2020 21:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41653 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41653@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41653-submit@debbugs.gnu.org id=B41653.15910477329262 (code B ref 41653); Mon, 01 Jun 2020 21:43:02 +0000 Received: (at 41653) by debbugs.gnu.org; 1 Jun 2020 21:42:12 +0000 Received: from localhost ([127.0.0.1]:37233 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsCB-0002PK-OJ for submit@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:11 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50550) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsBz-0002Nw-R9 for 41653@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:10 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57936) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsBu-000730-J6; Mon, 01 Jun 2020 17:41:54 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=51784 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jfsBu-0007Sn-3q; Mon, 01 Jun 2020 17:41:54 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 1 Jun 2020 23:41:45 +0200 Message-Id: <20200601214147.3357-2-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200601214147.3357-1-ludo@gnu.org> References: <20200601214147.3357-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/git-authenticate.scm (load-keyring-from-reference): Remove hard-coded "origin/". Use BRANCH-ALL instead of BRANCH-REMOTE. --- guix/git-authenticate.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm index 4df56fab59..4217ab6d27 100644 --- a/guix/git-authenticate.scm +++ b/guix/git-authenticate.scm @@ -161,9 +161,7 @@ may not be ASCII-armored." (define (load-keyring-from-reference repository reference) "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return an OpenPGP keyring." - (let* ((reference (branch-lookup repository - (string-append "origin/" reference) - BRANCH-REMOTE)) + (let* ((reference (branch-lookup repository reference BRANCH-ALL)) (target (reference-target reference)) (commit (commit-lookup repository target)) (tree (commit-tree commit))) From patchwork Mon Jun 1 21:41:46 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 22510 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 237FA27BBE1; Mon, 1 Jun 2020 22:43:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 1DEF827BBE3 for ; Mon, 1 Jun 2020 22:43:10 +0100 (BST) Received: from localhost ([::1]:42654 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsD7-0000XP-J4 for patchwork@mira.cbaines.net; Mon, 01 Jun 2020 17:43:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59080) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jfsD0-0000VP-3S for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53920) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jfsCz-0007fK-OH for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jfsCz-0002QM-MF for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41653] [PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 01 Jun 2020 21:43:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41653 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41653@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41653-submit@debbugs.gnu.org id=B41653.15910477239229 (code B ref 41653); Mon, 01 Jun 2020 21:43:01 +0000 Received: (at 41653) by debbugs.gnu.org; 1 Jun 2020 21:42:03 +0000 Received: from localhost ([127.0.0.1]:37229 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsC2-0002Oc-D3 for submit@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:02 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50554) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsC0-0002Ny-Pp for 41653@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:01 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57939) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsBv-000735-Gq; Mon, 01 Jun 2020 17:41:55 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=51784 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jfsBu-0007Sn-TL; Mon, 01 Jun 2020 17:41:55 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 1 Jun 2020 23:41:46 +0200 Message-Id: <20200601214147.3357-3-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200601214147.3357-1-ludo@gnu.org> References: <20200601214147.3357-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/git-authenticate.scm (&git-authentication-error) (&unsigned-commit-error, &unauthorized-commit-error) (&signature-verification-error, &missing-key-error): New condition types. (commit-signing-key, authenticate-commit): Raise them. --- guix/git-authenticate.scm | 44 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm index 4217ab6d27..b73f957105 100644 --- a/guix/git-authenticate.scm +++ b/guix/git-authenticate.scm @@ -41,7 +41,18 @@ authenticate-commits load-keyring-from-reference previously-authenticated-commits - cache-authenticated-commit)) + cache-authenticated-commit + + git-authentication-error? + git-authentication-error-commit + unsigned-commit-error? + unauthorized-commit-error? + unauthorized-commit-error-signing-key + signature-verification-error? + signature-verification-error-keyring + signature-verification-error-signature + missing-key-error? + missing-key-error-signature)) ;;; Commentary: ;;; @@ -52,6 +63,27 @@ ;;; ;;; Code: +(define-condition-type &git-authentication-error &error + git-authentication-error? + (commit git-authentication-error-commit)) + +(define-condition-type &unsigned-commit-error &git-authentication-error + unsigned-commit-error?) + +(define-condition-type &unauthorized-commit-error &git-authentication-error + unauthorized-commit-error? + (signing-key unauthorized-commit-error-signing-key)) + +(define-condition-type &signature-verification-error &git-authentication-error + signature-verification-error? + (signature signature-verification-error-signature) + (keyring signature-verification-error-keyring)) + +(define-condition-type &missing-key-error &git-authentication-error + missing-key-error? + (signature missing-key-error-signature)) + + (define (commit-signing-key repo commit-id keyring) "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception if the commit is unsigned, has an invalid signature, or if its signing key is @@ -64,9 +96,10 @@ not in KEYRING." (values #f #f))))) (unless signature (raise (condition + (&unsigned-commit-error (commit commit-id)) (&message (message (format #f (G_ "commit ~a lacks a signature") - commit-id)))))) + (oid->string commit-id))))))) (let ((signature (string->openpgp-packet signature))) (with-fluids ((%default-port-encoding "UTF-8")) @@ -77,12 +110,17 @@ not in KEYRING." ('bad-signature ;; There's a signature but it's invalid. (raise (condition + (&signature-verification-error (commit commit-id) + (signature signature) + (keyring keyring)) (&message (message (format #f (G_ "signature verification failed \ for commit ~a") (oid->string commit-id))))))) ('missing-key (raise (condition + (&missing-key-error (commit commit-id) + (signature signature)) (&message (message (format #f (G_ "could not authenticate \ commit ~a: key ~a is missing") @@ -138,6 +176,8 @@ not specify anything, fall back to DEFAULT-AUTHORIZATIONS." (commit-authorized-keys repository commit default-authorizations)) (raise (condition + (&unauthorized-commit-error (commit id) + (signing-key signing-key)) (&message (message (format #f (G_ "commit ~a not signed by an authorized \ key: ~a") From patchwork Mon Jun 1 21:41:47 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 22513 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id E4A7927BBE3; Mon, 1 Jun 2020 22:48:48 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 3EE3527BBE1 for ; Mon, 1 Jun 2020 22:48:47 +0100 (BST) Received: from localhost ([::1]:49044 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsIY-0003ic-RY for patchwork@mira.cbaines.net; Mon, 01 Jun 2020 17:48:46 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59088) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jfsD0-0000W2-Ee for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53921) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jfsD0-0007fV-4N for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jfsD0-0002QT-2S for guix-patches@gnu.org; Mon, 01 Jun 2020 17:43:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41653] [PATCH 4/4] git-authenticate: Add tests. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 01 Jun 2020 21:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41653 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41653@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41653-submit@debbugs.gnu.org id=B41653.15910477249243 (code B ref 41653); Mon, 01 Jun 2020 21:43:02 +0000 Received: (at 41653) by debbugs.gnu.org; 1 Jun 2020 21:42:04 +0000 Received: from localhost ([127.0.0.1]:37231 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsC3-0002P0-TN for submit@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:04 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50562) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jfsC1-0002Nz-LB for 41653@debbugs.gnu.org; Mon, 01 Jun 2020 17:42:03 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57940) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jfsBw-00073A-Cm; Mon, 01 Jun 2020 17:41:56 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=51784 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jfsBv-0007Sn-RB; Mon, 01 Jun 2020 17:41:56 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 1 Jun 2020 23:41:47 +0200 Message-Id: <20200601214147.3357-4-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200601214147.3357-1-ludo@gnu.org> References: <20200601214147.3357-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/tests/git.scm (call-with-environment-variables) (with-environment-variables): Remove. * guix/tests/git.scm (populate-git-repository): Add clauses for signed commits and signed merges. * guix/tests/gnupg.scm: New file. * tests/git-authenticate.scm: New file. * tests/ed25519bis.key, tests/ed25519bis.sec: New files. * Makefile.am (dist_noinst_DATA): Add 'guix/tests/gnupg.scm'. (SCM_TESTS): Add 'tests/git-authenticate.scm'. (EXTRA_DIST): Add tests/ed25519bis.{key,sec}. --- .dir-locals.el | 2 + Makefile.am | 6 +- guix/tests/git.scm | 26 ++-- guix/tests/gnupg.scm | 72 ++++++++++ tests/ed25519bis.key | 10 ++ tests/ed25519bis.sec | 10 ++ tests/git-authenticate.scm | 286 +++++++++++++++++++++++++++++++++++++ 7 files changed, 393 insertions(+), 19 deletions(-) create mode 100644 guix/tests/gnupg.scm create mode 100644 tests/ed25519bis.key create mode 100644 tests/ed25519bis.sec create mode 100644 tests/git-authenticate.scm diff --git a/.dir-locals.el b/.dir-locals.el index fcde914e60..e34ddc5a85 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -96,6 +96,8 @@ (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1)) (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2)) + (eval . (put 'with-environment-variables 'scheme-indent-function 1)) + (eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1)) ;; This notably allows '(' in Paredit to not insert a space when the ;; preceding symbol is one of these. diff --git a/Makefile.am b/Makefile.am index db30004b1b..f3985f9572 100644 --- a/Makefile.am +++ b/Makefile.am @@ -319,7 +319,8 @@ MODULES += $(STORE_MODULES) dist_noinst_DATA = \ guix/tests.scm \ guix/tests/http.scm \ - guix/tests/git.scm + guix/tests/git.scm \ + guix/tests/gnupg.scm # Auxiliary files for packages. AUX_FILES = \ @@ -404,6 +405,7 @@ SCM_TESTS = \ tests/gem.scm \ tests/gexp.scm \ tests/git.scm \ + tests/git-authenticate.scm \ tests/glob.scm \ tests/gnu-maintenance.scm \ tests/grafts.scm \ @@ -576,6 +578,8 @@ EXTRA_DIST += \ tests/dsa.key \ tests/ed25519.key \ tests/ed25519.sec \ + tests/ed25519bis.key \ + tests/ed25519bis.sec \ build-aux/config.rpath \ bootstrap \ doc/build.scm \ diff --git a/guix/tests/git.scm b/guix/tests/git.scm index 566660e85e..c77c544e03 100644 --- a/guix/tests/git.scm +++ b/guix/tests/git.scm @@ -21,6 +21,7 @@ #:use-module ((guix git) #:select (with-repository)) #:use-module (guix utils) #:use-module (guix build utils) + #:use-module ((guix tests gnupg) #:select (with-environment-variables)) #:use-module (ice-9 match) #:use-module (ice-9 control) #:export (git-command @@ -30,24 +31,6 @@ (define git-command (make-parameter "git")) -(define (call-with-environment-variables variables thunk) - "Call THUNK with the environment VARIABLES set." - (let ((environment (environ))) - (dynamic-wind - (lambda () - (for-each (match-lambda - ((variable value) - (setenv variable value))) - variables)) - thunk - (lambda () - (environ environment))))) - -(define-syntax-rule (with-environment-variables variables exp ...) - "Evaluate EXP with the given environment VARIABLES set." - (call-with-environment-variables variables - (lambda () exp ...))) - (define (populate-git-repository directory directives) "Initialize a new Git checkout and repository in DIRECTORY and apply DIRECTIVES. Each element of DIRECTIVES is an sexp like: @@ -97,6 +80,9 @@ Return DIRECTORY on success." ((('commit text) rest ...) (git "commit" "-m" text) (loop rest)) + ((('commit text ('signer fingerprint)) rest ...) + (git "commit" "-m" text (string-append "--gpg-sign=" fingerprint)) + (loop rest)) ((('tag name) rest ...) (git "tag" name) (loop rest)) @@ -108,6 +94,10 @@ Return DIRECTORY on success." (loop rest)) ((('merge branch message) rest ...) (git "merge" branch "-m" message) + (loop rest)) + ((('merge branch message ('signer fingerprint)) rest ...) + (git "merge" branch "-m" message + (string-append "--gpg-sign=" fingerprint)) (loop rest))))) (define (call-with-temporary-git-repository directives proc) diff --git a/guix/tests/gnupg.scm b/guix/tests/gnupg.scm new file mode 100644 index 0000000000..6e7fdbcf65 --- /dev/null +++ b/guix/tests/gnupg.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix tests gnupg) + #:use-module (guix utils) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:export (gpg-command + gpgconf-command + with-fresh-gnupg-setup + + with-environment-variables)) + +(define (call-with-environment-variables variables thunk) + "Call THUNK with the environment VARIABLES set." + (let ((environment (environ))) + (dynamic-wind + (lambda () + (for-each (match-lambda + ((variable value) + (setenv variable value))) + variables)) + thunk + (lambda () + (environ environment))))) + +(define-syntax-rule (with-environment-variables variables exp ...) + "Evaluate EXP with the given environment VARIABLES set." + (call-with-environment-variables variables + (lambda () exp ...))) + +(define gpg-command + (make-parameter "gpg")) + +(define gpgconf-command + (make-parameter "gpgconf")) + +(define (call-with-fresh-gnupg-setup imported thunk) + (call-with-temporary-directory + (lambda (home) + (with-environment-variables `(("GNUPGHOME" ,home)) + (dynamic-wind + (lambda () + (for-each (lambda (file) + (invoke (gpg-command) "--import" file)) + imported)) + thunk + (lambda () + ;; Terminate 'gpg-agent' & co. + (invoke (gpgconf-command) "--kill" "all"))))))) + +(define-syntax-rule (with-fresh-gnupg-setup imported exp ...) + "Evaluate EXP in the context of a fresh GnuPG setup where all the files +listed in IMPORTED, and only them, have been imported. This sets 'GNUPGHOME' +such that the user's real GnuPG files are left untouched. The 'gpg-agent' +process is terminated afterwards." + (call-with-fresh-gnupg-setup imported (lambda () exp ...))) diff --git a/tests/ed25519bis.key b/tests/ed25519bis.key new file mode 100644 index 0000000000..f5329105d5 --- /dev/null +++ b/tests/ed25519bis.key @@ -0,0 +1,10 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- + +mDMEXtVsNhYJKwYBBAHaRw8BAQdAnLsYdh3BpeK1xDguJE80XW2/MSmqeeP6pbQw +8jAw0OG0IkNoYXJsaWUgR3VpeCA8Y2hhcmxpZUBleGFtcGxlLm9yZz6IlgQTFggA +PhYhBKBDaY1jer75FlruS4IkDtyrgNqDBQJe1Ww2AhsDBQkDwmcABQsJCAcCBhUK +CQgLAgQWAgMBAh4BAheAAAoJEIIkDtyrgNqDM6cA/idDdoxo9SU+witdTXt24APH +yRzHbX9Iyh4dZNIek9JwAP9E0BwSvDHB4LY9z4RWf2hJp3dm/yZ/jEpK+w4BGN4J +Ag== +=JIU0 +-----END PGP PUBLIC KEY BLOCK----- diff --git a/tests/ed25519bis.sec b/tests/ed25519bis.sec new file mode 100644 index 0000000000..059765f557 --- /dev/null +++ b/tests/ed25519bis.sec @@ -0,0 +1,10 @@ +-----BEGIN PGP PRIVATE KEY BLOCK----- + +lFgEXtVsNhYJKwYBBAHaRw8BAQdAnLsYdh3BpeK1xDguJE80XW2/MSmqeeP6pbQw +8jAw0OEAAP9lsLf3tk0OH1X4By4flYSz4PBFo40EwS4t6xx76poUphCEtCJDaGFy +bGllIEd1aXggPGNoYXJsaWVAZXhhbXBsZS5vcmc+iJYEExYIAD4WIQSgQ2mNY3q+ ++RZa7kuCJA7cq4DagwUCXtVsNgIbAwUJA8JnAAULCQgHAgYVCgkICwIEFgIDAQIe +AQIXgAAKCRCCJA7cq4DagzOnAP4nQ3aMaPUlPsIrXU17duADx8kcx21/SMoeHWTS +HpPScAD/RNAcErwxweC2Pc+EVn9oSad3Zv8mf4xKSvsOARjeCQI= +=gUik +-----END PGP PRIVATE KEY BLOCK----- diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm new file mode 100644 index 0000000000..5937c37ee6 --- /dev/null +++ b/tests/git-authenticate.scm @@ -0,0 +1,286 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-git-authenticate) + #: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 (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports)) + +;; Test the (guix git-authenticate) tools. + +(define %ed25519-public-key-file + (search-path %load-path "tests/ed25519.key")) +(define %ed25519-secret-key-file + (search-path %load-path "tests/ed25519.sec")) +(define %ed25519bis-public-key-file + (search-path %load-path "tests/ed25519bis.key")) +(define %ed25519bis-secret-key-file + (search-path %load-path "tests/ed25519bis.sec")) + +(define (read-openpgp-packet file) + (get-openpgp-packet + (open-bytevector-input-port + (call-with-input-file file read-radix-64)))) + +(define key-fingerprint + (compose openpgp-format-fingerprint + openpgp-public-key-fingerprint + read-openpgp-packet)) + +(define (key-id file) + (define id + (openpgp-public-key-id (read-openpgp-packet))) + + (string-pad (number->string id 16) 16 #\0)) + +(define (gpg+git-available?) + (and (which (git-command)) + (which (gpg-command)) (which (gpgconf-command)))) + + +(test-begin "git-authenticate") + +(unless (which (git-command)) (test-skip 1)) +(test-assert "unsigned commits" + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (add "b.txt" "B") + (commit "second commit")) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second"))) + (guard (c ((unsigned-commit-error? c) + (oid=? (git-authentication-error-commit c) + (commit-id commit1)))) + (authenticate-commits repository (list commit1 commit2) + #:keyring-reference "master") + 'failed))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, default authorizations" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository directory + `((add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (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)))) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second"))) + (authenticate-commits repository (list commit1 commit2) + #:default-authorizations + (list (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file))) + #:keyring-reference "master")))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository directory + `((add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (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 ".guix-authorizations" + ,(object->string `(authorizations (version 0) ()))) ;empty + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "b.txt" "B") + (commit "third commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit3 (find-commit repository "third"))) + ;; COMMIT1 and COMMIT2 are fine. + (and (authenticate-commits repository (list commit1 commit2) + #:keyring-reference "master") + + ;; 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-public-key-file)))))) + (authenticate-commits repository + (list commit1 commit2 commit3) + #:keyring-reference "master") + 'failed))))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations, unauthorized merge" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519bis-public-key-file + %ed25519bis-secret-key-file) + (with-temporary-git-repository directory + `((add "signer1.key" + ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add "signer2.key" + ,(call-with-input-file %ed25519bis-public-key-file + get-string-all)) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Alice")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (branch "devel") + (checkout "devel") + (add "devel/1.txt" "1") + (commit "first devel commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file))) + (checkout "master") + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (merge "devel" "merge" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let ((master1 (find-commit repository "first commit")) + (master2 (find-commit repository "second commit")) + (devel1 (find-commit repository "first devel commit")) + (merge (find-commit repository "merge"))) + (define (correct? c commit) + (and (oid=? (git-authentication-error-commit c) + (commit-id commit)) + (bytevector=? + (openpgp-public-key-fingerprint + (unauthorized-commit-error-signing-key c)) + (openpgp-public-key-fingerprint + (read-openpgp-packet %ed25519bis-public-key-file))))) + + (and (authenticate-commits repository (list master1 master2) + #:keyring-reference "master") + + ;; DEVEL1 is signed by an unauthorized key according to its + ;; parent's '.guix-authorizations' file. + (guard (c ((unauthorized-commit-error? c) + (correct? c devel1))) + (authenticate-commits repository + (list master1 devel1) + #:keyring-reference "master") + #f) + + ;; MERGE is authorized but one of its ancestors is not. + (guard (c ((unauthorized-commit-error? c) + (correct? c devel1))) + (authenticate-commits repository + (list master1 master2 + devel1 merge) + #:keyring-reference "master") + #f))))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations, authorized merge" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519bis-public-key-file + %ed25519bis-secret-key-file) + (with-temporary-git-repository directory + `((add "signer1.key" + ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add "signer2.key" + ,(call-with-input-file %ed25519bis-public-key-file + get-string-all)) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Alice")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (branch "devel") + (checkout "devel") + (add ".guix-authorizations" + ,(object->string ;add the second signer + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Alice")) + (,(key-fingerprint + %ed25519bis-public-key-file)))))) + (commit "first devel commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "devel/2.txt" "2") + (commit "second devel commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file))) + (checkout "master") + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (merge "devel" "merge" + (signer ,(key-fingerprint %ed25519-public-key-file))) + ;; After the merge, the second signer is authorized. + (add "c.txt" "C") + (commit "third commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file)))) + (with-repository directory repository + (let ((master1 (find-commit repository "first commit")) + (master2 (find-commit repository "second commit")) + (devel1 (find-commit repository "first devel commit")) + (devel2 (find-commit repository "second devel commit")) + (merge (find-commit repository "merge")) + (master3 (find-commit repository "third commit"))) + (authenticate-commits repository + (list master1 master2 devel1 devel2 + merge master3) + #:keyring-reference "master")))))) + +(test-end "git-authenticate") +