ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add (guix git-authenticate).

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2020-06-01 17:48:11 +02:00
parent ecab53c320
commit 41f443c90a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 253 additions and 197 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -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 \

203
build-aux/git-authenticate.scm
View file

@ -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 @@ (define %unsigned-commits
;; 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 @@ (define reporter
(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)))

244
guix/git-authenticate.scm Normal file
View file

@ -0,0 +1,244 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(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))))))