From debbugs-submit-bounces@debbugs.gnu.org Fri Jul 22 04:22:49 2016 Received: (at 22883) by debbugs.gnu.org; 22 Jul 2016 08:22:49 +0000 Received: from localhost ([127.0.0.1]:60782 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) 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 ) 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 ) 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 ) 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 ) id 1bQVir-0000oA-VN; Fri, 22 Jul 2016 04:22:18 -0400 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) 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 , Mike Gerwitz , Leo Famulari X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.3 (------) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi! ludo@gnu.org (Ludovic Court=C3=A8s) skribis: > Sixth, OK, we=E2=80=99ll use libgit2, and write Guile bindings, maybe bas= ed on > the CHICKEN bindings=C2=B2, easy! Well no, it turns out that libgit2=C2= =B3 has no > support for signed commits (the =E2=80=98signature=E2=80=99 abstraction t= here 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=E2=80= =99d > 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--- =E2=80=A6 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 3D9AE= BB5 gpg: Good signature from "Ludovic Court=C3=A8s " [full] gpg: aka "Ludovic Court=C3=A8s " [full] gpg: aka "Ludovic Court=C3=A8s (Inria) " [full] ;;; (((unparsed-line "[GNUPG:] NEWSIG") (signature-id "5U2RqMgQpDFefFuBzsYB= DsrL9xg" "2016-07-21" 1469120007) (good-signature "090B11993D9AEBB5" "Ludov= ic Court=C3=A8s ") (valid-signature "3CE464558A84FDC69DB40CFB= 090B11993D9AEBB5" "2016-07-21" 1469120007) (unparsed-line "[GNUPG:] TRUST_F= ULLY"))) --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=E2=80=99d check whether the fingerp= rint that shows up in =E2=80=98valid-signature=E2=80=99 above is among them (IMO= this is better than using a GnuPG keyring because GnuPG keyrings are opaque binary blobs=E2=80=94we wouldn=E2=80=99t be able to diff subsequent revisio= ns of the keyring=E2=80=94and they contain full OpenPGP keys, including signature pac= kets and all that, which we don=E2=80=99t 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=E2=80=99t be hard= (I=E2=80=99d expect ~500 lines of code), would avoid the dependency, and be more robust (no C!). However, =E2=80=98guix pull=E2=80=99 can make good use of libgit2 to direct= ly 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 =E2=80=9Cexternalize=E2=80=9D it and improve it, that would be mor= e than welcome! Thoughts? Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline; filename=git.scm Content-Transfer-Encoding: quoted-printable Content-Description: quick hack! ;;; Copyright =C2=A9 Ludovic Court=C3=A8s ;;; 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 "#" #,(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!) --=-=-=--