(define-module (guix channels)
#:use-module (git)
#:use-module (guix git)
+ #:use-module (guix git-authenticate)
+ #:use-module ((guix openpgp)
+ #:select (openpgp-public-key-fingerprint
+ openpgp-format-fingerprint))
+ #:use-module (guix base16)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix monads)
#:use-module (guix profiles)
#:use-module (guix packages)
+ #:use-module (guix progress)
#:use-module (guix derivations)
#:use-module (guix combinators)
#:use-module (guix diagnostics)
#:autoload (guix self) (whole-package make-config.scm)
#:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep
#:autoload (guix quirks) (%quirks %patches applicable-patch? apply-patch)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module ((ice-9 rdelim) #:select (read-string))
+ #:use-module ((rnrs bytevectors) #:select (bytevector=?))
#:export (channel
channel?
channel-name
channel-url
channel-branch
channel-commit
+ channel-introduction
channel-location
+ channel-introduction?
+ ;; <channel-introduction> accessors purposefully omitted for now.
+
%default-channels
guix-channel?
channel-instance-commit
channel-instance-checkout
+ authenticate-channel
latest-channel-instances
checkout->channel-instance
latest-channel-derivation
(url channel-url)
(branch channel-branch (default "master"))
(commit channel-commit (default #f))
+ (introduction channel-introduction (default #f))
(location channel-location
(default (current-source-location)) (innate)))
+;; Channel introductions. A "channel introduction" provides a commit/signer
+;; pair that specifies the first commit of the authentication process as well
+;; as its signer's fingerprint. The pair must be signed by the signer of that
+;; commit so that only them may emit this introduction. Introductions are
+;; used to bootstrap trust in a channel.
+(define-record-type <channel-introduction>
+ (make-channel-introduction first-signed-commit first-commit-signer
+ signature)
+ channel-introduction?
+ (first-signed-commit channel-introduction-first-signed-commit) ;hex string
+ (first-commit-signer channel-introduction-first-commit-signer) ;bytevector
+ (signature channel-introduction-signature)) ;string
+
+(define %guix-channel-introduction
+ ;; Introduction of the official 'guix channel. The chosen commit is the
+ ;; first one that introduces '.guix-authorizations' on the 'staging'
+ ;; branch that was eventually merged in 'master'. Any branch starting
+ ;; before that commit cannot be merged or it will be rejected by 'guix pull'
+ ;; & co.
+ (make-channel-introduction
+ "9edb3f66fd807b096b48283debdcddccfea34bad" ;2020-05-26
+ (base16-string->bytevector
+ (string-downcase
+ (string-filter char-set:hex-digit ;mbakke
+ "BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA")))
+ #f)) ;TODO: Add an intro signature so it can be exported.
+
(define %default-channels
;; Default list of channels.
(list (channel
(name 'guix)
(branch "master")
- (url "https://git.savannah.gnu.org/git/guix.git"))))
+ (url "https://git.savannah.gnu.org/git/guix.git")
+ (introduction %guix-channel-introduction))))
(define (guix-channel? channel)
"Return true if CHANNEL is the 'guix' channel."
(checkout channel-instance-checkout))
(define-record-type <channel-metadata>
- (channel-metadata directory dependencies news-file)
+ (channel-metadata directory dependencies news-file keyring-reference)
channel-metadata?
(directory channel-metadata-directory) ;string with leading slash
(dependencies channel-metadata-dependencies) ;list of <channel>
- (news-file channel-metadata-news-file)) ;string | #f
+ (news-file channel-metadata-news-file) ;string | #f
+ (keyring-reference channel-metadata-keyring-reference)) ;string
+
+(define %default-keyring-reference
+ ;; Default value of the 'keyring-reference' field.
+ "keyring")
(define (channel-reference channel)
"Return the \"reference\" for CHANNEL, an sexp suitable for
(('channel ('version 0) properties ...)
(let ((directory (and=> (assoc-ref properties 'directory) first))
(dependencies (or (assoc-ref properties 'dependencies) '()))
- (news-file (and=> (assoc-ref properties 'news-file) first)))
+ (news-file (and=> (assoc-ref properties 'news-file) first))
+ (keyring-reference
+ (or (and=> (assoc-ref properties 'keyring-reference) first)
+ %default-keyring-reference)))
(channel-metadata
(cond ((not directory) "/") ;directory
((string-prefix? "/" directory) directory)
(url url)
(commit (get 'commit))))))
dependencies)
- news-file))) ;news-file
+ news-file
+ keyring-reference)))
((and ('channel ('version version) _ ...) sexp)
(raise (condition
(&message (message "unsupported '.guix-channel' version"))
read-channel-metadata))
(lambda args
(if (= ENOENT (system-error-errno args))
- (channel-metadata "/" '() #f)
+ (channel-metadata "/" '() #f %default-keyring-reference)
(apply throw args)))))
(define (channel-instance-metadata instance)
(apply-patch patch checkout))
(loop rest)))))
+(define commit-short-id
+ (compose (cut string-take <> 7) oid->string commit-id))
+
+(define (verify-introductory-commit repository introduction keyring)
+ "Raise an exception if the first commit described in INTRODUCTION doesn't
+have the expected signer."
+ (define commit-id
+ (channel-introduction-first-signed-commit introduction))
+
+ (define actual-signer
+ (openpgp-public-key-fingerprint
+ (commit-signing-key repository (string->oid commit-id)
+ keyring)))
+
+ (define expected-signer
+ (channel-introduction-first-commit-signer introduction))
+
+ (unless (bytevector=? expected-signer actual-signer)
+ (raise (condition
+ (&message
+ (message (format #f (G_ "initial commit ~a is signed by '~a' \
+instead of '~a'")
+ commit-id
+ (openpgp-format-fingerprint actual-signer)
+ (openpgp-format-fingerprint expected-signer))))))))
+
+(define* (authenticate-channel channel checkout commit
+ #:key (keyring-reference-prefix "origin/"))
+ "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a
+directory containing a CHANNEL checkout. Raise an error if authentication
+fails."
+ ;; XXX: Too bad we need to re-open CHECKOUT.
+ (with-repository checkout repository
+ (define start-commit
+ (commit-lookup repository
+ (string->oid
+ (channel-introduction-first-signed-commit
+ (channel-introduction channel)))))
+
+ (define end-commit
+ (commit-lookup repository (string->oid commit)))
+
+ (define cache-key
+ (string-append "channels/" (symbol->string (channel-name channel))))
+
+ (define keyring-reference
+ (channel-metadata-keyring-reference
+ (read-channel-metadata-from-source checkout)))
+
+ (define keyring
+ (load-keyring-from-reference repository
+ (string-append keyring-reference-prefix
+ keyring-reference)))
+
+ (define authenticated-commits
+ ;; Previously-authenticated commits that don't need to be checked again.
+ (filter-map (lambda (id)
+ (false-if-exception
+ (commit-lookup repository (string->oid id))))
+ (previously-authenticated-commits cache-key)))
+
+ (define commits
+ ;; Commits to authenticate, excluding the closure of
+ ;; AUTHENTICATED-COMMITS.
+ (commit-difference end-commit start-commit
+ authenticated-commits))
+
+ (define reporter
+ (progress-reporter/bar (length commits)))
+
+ ;; When COMMITS is empty, it's either because AUTHENTICATED-COMMITS
+ ;; contains END-COMMIT or because END-COMMIT is not a descendant of
+ ;; START-COMMIT. Check that.
+ (if (null? commits)
+ (match (commit-relation start-commit end-commit)
+ ((or 'self 'ancestor 'descendant) #t) ;nothing to do!
+ ('unrelated
+ (raise
+ (condition
+ (&message
+ (message
+ (format #f (G_ "'~a' is not related to introductory \
+commit of channel '~a'~%")
+ (oid->string (commit-id end-commit))
+ (channel-name channel))))))))
+ (begin
+ (format (current-error-port)
+ (G_ "Authenticating channel '~a', \
+commits ~a to ~a (~h new commits)...~%")
+ (channel-name channel)
+ (commit-short-id start-commit)
+ (commit-short-id end-commit)
+ (length commits))
+
+ ;; If it's our first time, verify CHANNEL's introductory commit.
+ (when (null? authenticated-commits)
+ (verify-introductory-commit repository
+ (channel-introduction channel)
+ keyring))
+
+ (call-with-progress-reporter reporter
+ (lambda (report)
+ (authenticate-commits repository commits
+ #:keyring keyring
+ #:report-progress report)))
+
+ (cache-authenticated-commit cache-key
+ (oid->string
+ (commit-id end-commit)))))))
+
(define* (latest-channel-instance store channel
#:key (patches %patches)
starting-commit)
(update-cached-checkout (channel-url channel)
#:ref (channel-reference channel)
#:starting-commit starting-commit)))
+ (if (channel-introduction channel)
+ (authenticate-channel channel checkout commit)
+ ;; TODO: Warn for all the channels once the authentication interface
+ ;; is public.
+ (when (guix-channel? channel)
+ (warning (G_ "channel '~a' lacks an introduction and \
+cannot be authenticated~%")
+ (channel-name channel))))
+
(when (guix-channel? channel)
;; Apply the relevant subset of PATCHES directly in CHECKOUT. This is
;; safe to do because 'switch-to-ref' eventually does a hard reset.
#: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))
+
+\f
(test-begin "channels")
(define* (make-instance #:key
(channel-news-for-commit channel commit5 commit1))
'(#f "tag-for-first-news-entry")))))))
+(unless (gpg+git-available?) (test-skip 1))
+(test-assert "authenticate-channel, wrong first commit signer"
+ (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 ".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))))
+ (with-repository directory repository
+ (let* ((commit1 (find-commit repository "first"))
+ (intro ((@@ (guix channels) make-channel-introduction)
+ (commit-id-string commit1)
+ (openpgp-public-key-fingerprint
+ (read-openpgp-packet
+ %ed25519bis-public-key-file)) ;different key
+ #f)) ;no signature
+ (channel (channel (name 'example)
+ (url (string-append "file://" directory))
+ (introduction intro))))
+ (guard (c ((message? c)
+ (->bool (string-contains (condition-message c)
+ "initial commit"))))
+ (authenticate-channel channel directory
+ (commit-id-string commit1)
+ #:keyring-reference-prefix "")
+ 'failed))))))
+
+(unless (gpg+git-available?) (test-skip 1))
+(test-assert "authenticate-channel, .guix-authorizations"
+ (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 ".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 %ed25519bis-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 %ed25519bis-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 ((@@ (guix channels) make-channel-introduction)
+ (commit-id-string commit1)
+ (openpgp-public-key-fingerprint
+ (read-openpgp-packet
+ %ed25519-public-key-file))
+ #f)) ;no signature
+ (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
+ %ed25519bis-public-key-file))))))
+ (authenticate-channel channel directory
+ (commit-id-string commit3)
+ #:keyring-reference-prefix "")
+ 'failed)))))))
+
(test-end "channels")