GNU bug report logs

#22883 Trustable "guix pull"

PackageSource(s)Maintainer(s)
guix PTS Buildd Popcon
Full log

Message #103 received at 22883@debbugs.gnu.org (full text, mbox, reply):

Received: (at 22883) by debbugs.gnu.org; 22 Jul 2016 08:22:49 +0000
From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 22 04:22:49 2016
Received: from localhost ([127.0.0.1]:60782 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces@debbugs.gnu.org>)
	id 1bQVjN-0002vu-Cr
	for submit@debbugs.gnu.org; Fri, 22 Jul 2016 04:22:49 -0400
Received: from eggs.gnu.org ([208.118.235.92]:37832)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@gnu.org>) id 1bQVjK-0002vg-47
 for 22883@debbugs.gnu.org; Fri, 22 Jul 2016 04:22:47 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@gnu.org>) id 1bQVjD-0002vh-CQ
 for 22883@debbugs.gnu.org; Fri, 22 Jul 2016 04:22:40 -0400
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_40,RP_MATCHES_RCVD
 autolearn=disabled version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35753)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@gnu.org>)
 id 1bQViu-0002sq-BN; Fri, 22 Jul 2016 04:22:20 -0400
Received: from pluto.bordeaux.inria.fr ([193.50.110.57]:45552 helo=pluto)
 by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_128_CBC_SHA1:128)
 (Exim 4.82) (envelope-from <ludo@gnu.org>)
 id 1bQVir-0000oA-VN; Fri, 22 Jul 2016 04:22:18 -0400
From: ludo@gnu.org (Ludovic Courtès)
To: 22883@debbugs.gnu.org
Subject: Re: bug#22883: Authenticating a Git checkout
References: <87io14sqoa.fsf@dustycloud.org> <87h9ep8gxk.fsf@gnu.org>
 <20160426001359.GA23088@jasmine> <874majg0z8.fsf@gnu.org>
 <87bn3iz1xc.fsf_-_@gnu.org>
Date: Fri, 22 Jul 2016 10:22:15 +0200
In-Reply-To: <87bn3iz1xc.fsf_-_@gnu.org> ("Ludovic
 \=\?utf-8\?Q\?Court\=C3\=A8s\?\=
 \=\?utf-8\?Q\?\=22's\?\= message of "Fri,
 03 Jun 2016 18:12:47 +0200")
Message-ID: <87wpket748.fsf@gnu.org>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -6.3 (------)
X-Debbugs-Envelope-To: 22883
Cc: Christopher Allan Webber <cwebber@dustycloud.org>,
 Mike Gerwitz <mtg@gnu.org>, Leo Famulari <leo@famulari.name>
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit@debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request@debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces@debbugs.gnu.org>
X-Spam-Score: -6.3 (------)
[Message part 1 (text/plain, inline)]
Hi!

ludo@gnu.org (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 <ludo@gnu.org>" [full]
gpg:                 aka "Ludovic Courtès <ludo@chbouib.org>" [full]
gpg:                 aka "Ludovic Courtès (Inria) <ludovic.courtes@inria.fr>" [full]

;;; (((unparsed-line "[GNUPG:] NEWSIG") (signature-id "5U2RqMgQpDFefFuBzsYBDsrL9xg" "2016-07-21" 1469120007) (good-signature "090B11993D9AEBB5" "Ludovic Courtès <ludo@gnu.org>") (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’.

[git.scm (text/plain, inline)]
;;; Copyright © Ludovic Courtès <ludo@gnu.org>
;;; 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!)

Send a report that this bug log contains spam.


debbugs.gnu.org maintainers <help-debbugs@gnu.org>. Last modified: Tue Mar 11 07:00:52 2025; Machine Name: wallace-server

GNU bug tracking system

Debbugs is free software and licensed under the terms of the GNU Public License version 2. The current version can be obtained from https://bugs.debian.org/debbugs-source/.

Copyright © 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson, 2005-2017 Don Armstrong, and many other contributors.