bug#22883: Authenticating a Git checkout

[Ludovic Courtès]

Hi!

address@hidden (Ludovic Courtès) skribis:

> Sixth, OK, we’ll use libgit2, and write Guile bindings, maybe based on
> the CHICKEN bindings², easy!  Well no, it turns out that libgit2³ has no
> support for signed commits (the ‘signature’ abstraction there has
> nothing to do with OpenPGP signatures.)
>
> Seventh, even if it did, what would we do with the raw ASCII-armored
> OpenPGP signature?  GPG and GPGME are waaaay too high-level, so we’d
> need to implement OpenPGP (in Guile, maybe based on the OpenPGP library
> in Bigloo?)?!

This bit was too pessimistic it seems.  :-)

With the quick-hack libgit2 bindings attached, I can run this program,
which authenticates HEAD:

--8<---------------cut here---------------start------------->8---
(use-modules (guix git)
             (guix gnupg)
             (srfi srfi-11)
             (srfi srfi-26))

(let* ((repo      (open-repository "."))
       (head      (repository-head repo))
       (commit-id (reference-target head)))
  (let-values (((signature signed-data)
                (commit-signature repo commit-id)))
    (with-fluids ((%default-port-encoding "UTF-8"))
      (call-with-output-file "/tmp/s"
        (cut display signature <>))
      (call-with-output-file "/tmp/d"
        (cut display signed-data <>)))
    (pk (gnupg-verify "/tmp/s" "/tmp/d"))))
--8<---------------cut here---------------end--------------->8---

… which gives:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guile t.scm
gpg: Signature made Thu 21 Jul 2016 06:53:27 PM CEST using RSA key ID 3D9AEBB5
gpg: Good signature from "Ludovic Courtès <address@hidden>" [full]
gpg:                 aka "Ludovic Courtès <address@hidden>" [full]
gpg:                 aka "Ludovic Courtès (Inria) <address@hidden>" [full]

;;; (((unparsed-line "[GNUPG:] NEWSIG") (signature-id 
"5U2RqMgQpDFefFuBzsYBDsrL9xg" "2016-07-21" 1469120007) (good-signature 
"090B11993D9AEBB5" "Ludovic Courtès <address@hidden>") (valid-signature 
"3CE464558A84FDC69DB40CFB090B11993D9AEBB5" "2016-07-21" 1469120007) 
(unparsed-line "[GNUPG:] TRUST_FULLY")))
--8<---------------cut here---------------end--------------->8---

So I think we can go from here.  Our repo would contain a Scheme list of
authorized OpenPGP fingerprints, and we’d check whether the fingerprint
that shows up in ‘valid-signature’ above is among them (IMO this is
better than using a GnuPG keyring because GnuPG keyrings are opaque
binary blobs—we wouldn’t be able to diff subsequent revisions of the
keyring—and they contain full OpenPGP keys, including signature packets
and all that, which we don’t need/want for authorization purposes; we
may still want to store a keyring though, but simply for the purposes of
allowing gpg to check signatures.)

Since we just need to read Git objects, after all, another option would
be to avoid libgit2 and read them ourselves, which wouldn’t be hard (I’d
expect ~500 lines of code), would avoid the dependency, and be more
robust (no C!).

However, ‘guix pull’ can make good use of libgit2 to directly clone/pull
in the future, so it makes sense to have libgit2 bindings.

It Would Be Nice if the libgit2 bindings were maintained separately.  We
can start with just the features we need as (guix git), but if anyone
wants to “externalize” it and improve it, that would be more than
welcome!

Thoughts?

Thanks,
Ludo’.

;;; Copyright © Ludovic Courtès <address@hidden>
;;; Released under the GNU GPL version 3 or later.

(define-module (guix git)
  #:use-module (rnrs bytevectors)
  #:use-module (system foreign)
  #:use-module (ice-9 match)
  #:export (repository?
            open-repository
            reference?
            repository-head
            reference-target
            oid?
            commit-signature))

;; DRAFT!

(define libgit2
  (dynamic-link 
"/gnu/store/g8r0qwnzf2j17hd84cchc6cmr51sflz8-libgit2-0.24.1/lib/libgit2"))

(define (libgit2->procedure return name params)
  (pointer->procedure return (dynamic-func name libgit2) params))

(define-inlinable (libgit2->procedure* name params)
  (let ((proc (libgit2->procedure int name params)))
    (lambda args
      (let ((ret (apply proc args)))
        (unless (zero? ret)
          (throw 'git-error ret))))))

(define initialize!
  (libgit2->procedure int "git_libgit2_init" '()))

(define-syntax define-libgit2-type
  (lambda (s)
    "Define a wrapped pointer type for an opaque type of libgit2."
    (syntax-case s ()
      ((_ name)
       (let ((symbol     (syntax->datum #'name))
             (identifier (lambda (symbol)
                           (datum->syntax #'name symbol))))
         (with-syntax ((rtd    (identifier (symbol-append '< symbol '>)))
                       (pred   (identifier (symbol-append symbol '?)))
                       (wrap   (identifier (symbol-append 'pointer-> symbol)))
                       (unwrap (identifier (symbol-append symbol '->pointer))))
           #`(define-wrapped-pointer-type rtd
               pred
               wrap unwrap
               (lambda (obj port)
                 (format port "#<git-~a ~a>"
                         #,(symbol->string symbol)
                         (number->string (pointer-address (unwrap obj))
                                         16))))))))))

(define-libgit2-type repository)

(define open-repository
  (let ((proc (libgit2->procedure* "git_repository_open" '(* *))))
    (lambda (file)
      (let ((result (bytevector->pointer (make-bytevector (sizeof '*)))))
        (proc result (string->pointer file))
        (pointer->repository (dereference-pointer result))))))

(define-libgit2-type reference)

(define repository-head
  (let ((proc (libgit2->procedure* "git_repository_head" '(* *))))
    (lambda (repository)
      (let ((result (bytevector->pointer (make-bytevector (sizeof '*)))))
        (proc result (repository->pointer repository))
        (pointer->reference (dereference-pointer result))))))

(define-libgit2-type oid)

(define reference-target
  (let ((proc (libgit2->procedure '* "git_reference_target" '(*))))
    (lambda (reference)
      (pointer->oid (proc (reference->pointer reference))))))

(define-libgit2-type commit)

(define lookup-commit
  (let ((proc (libgit2->procedure* "git_commit_lookup" `(* * *))))
    (lambda (repository oid)
      (let ((result (bytevector->pointer (make-bytevector (sizeof '*)))))
        (proc result (repository->pointer repository) (oid->pointer oid))
        (pointer->commit (dereference-pointer result))))))

(define commit-raw-header
  (let ((proc (libgit2->procedure '* "git_commit_raw_header" '(*))))
    (lambda (commit)
      (pointer->string (proc (commit->pointer commit))))))

(define %buffer-struct                            ;git_buf
  (list '* size_t size_t))

(define free-buffer
  (libgit2->procedure void "git_buf_free" '(*)))

(define (buffer-content buf)
  (match (parse-c-struct buf %buffer-struct)
    ((pointer asize size)
     (pointer->bytevector pointer size))))

(define (buffer-content/string buf)
  (match (parse-c-struct buf %buffer-struct)
    ((pointer asize size)
     (pointer->string pointer size "UTF-8"))))

(define commit-signature
  (let ((proc (libgit2->procedure* "git_commit_extract_signature"
                                   '(* * * * *))))
    (lambda* (repository oid #:optional (field "gpgsig"))
      (let ((signature (make-c-struct %buffer-struct
                                      `(,%null-pointer 0 0)))
            (data      (make-c-struct %buffer-struct
                                      `(,%null-pointer 0 0))))
        (proc signature data (repository->pointer repository)
              (oid->pointer oid)
              (string->pointer field))
        (let ((signature* (buffer-content/string signature))
              (data*      (buffer-content/string data)))
          (free-buffer signature)
          (free-buffer data)
          (values signature* data*))))))


(define-libgit2-type object)

(define GIT_OBJ_ANY -2)

(define lookup-object
  (let ((proc (libgit2->procedure* "git_object_lookup" `(* * * ,int))))
    (lambda* (repository oid #:optional (type GIT_OBJ_ANY))
      (let ((result (bytevector->pointer (make-bytevector (sizeof '*)))))
        (proc result (repository->pointer repository) (oid->pointer oid)
              type)
        (pointer->object (dereference-pointer result))))))

(initialize!)