bug#55399: [PATCH 2/2] gnu: guile-git: Add patches to support owner validation, and use libgit2@1.4.3.

[Maxime Devos <maximedevos@telenet.be>]

These two changes have to be done at the same time -- if the libgit2
dependency is updated first, then we would have a commit during which
"guix pull" is broken when using local channels (see:
<https://issues.guix.gnu.org/55399>).  And if the patches are added first,
then the build of guile-git breaks because the tests assume a new libgit2.

Together with the previous commit, this fixes
<https://issues.guix.gnu.org/55399>.

Tested with (first step):

$ ./pre-inst-env guix pull --url=$PWD
--commit=b22ddb51d8dfa4ab7f683c99ffc1fa6f44e0dc6b
--profile=../guix-with-libgit2 --disable-authentication
--channels=../channels.scm

where b22ddb51d8dfa4ab7f683c99ffc1fa6f44e0dc6b is the commit after applying
these two patches. Make sure to only put the Guix channel in ../channels.scm,
because of --disable-authentication.  This builds a Guix that uses the new
libgit2 and patched guile-git.  Then, it is tested that pulling still works
from a local checkout:

$ ../guix-with-libgit2/bin/guix pull --url=$PWD
--commit=c3d9ddbf3d34b58261ab9e03c794f5fbad34142d --channels=../channels.scm
--disable-authentication -p../another-guix

where c3d9ddbf3d34b58261ab9e03c794f5fbad34142d is a commit that hasn't been
seen before by the "guix pull" machinery.

* gnu/packages/patches/guile-git-fix-git-opt.patch: New patch.
* gnu/packages/patches/guile-git-set-owner-validation.patch: New patch.
* gnu/packages/patches/guile-git-test-owner-validation.patch: New patch.
* gnu/packages/guile.scm (guile-git)[source]{patches}: Add new patches.
* gnu/local.mk (dist_patch_DATA): Register new patches.
---
 gnu/local.mk                                  |   3 +
 gnu/packages/guile.scm                        |  15 +-
 .../patches/guile-git-fix-git-opt.patch       |  57 +++++++
 .../guile-git-set-owner-validation.patch      |  41 +++++
 .../guile-git-test-owner-validation.patch     | 153 ++++++++++++++++++
 5 files changed, 264 insertions(+), 5 deletions(-)
 create mode 100644 gnu/packages/patches/guile-git-fix-git-opt.patch
 create mode 100644 gnu/packages/patches/guile-git-set-owner-validation.patch
 create mode 100644 gnu/packages/patches/guile-git-test-owner-validation.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 412d512775..081f240157 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1244,6 +1244,9 @@ dist_patch_DATA =						\
   %D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
   %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch	\
   %D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
+  %D%/packages/patches/guile-git-fix-git-opt.patch		\
+  %D%/packages/patches/guile-git-set-owner-validation.patch	\
+  %D%/packages/patches/guile-git-test-owner-validation.patch	\
   %D%/packages/patches/guile-present-coding.patch		\
   %D%/packages/patches/guile-rsvg-pkgconfig.patch		\
   %D%/packages/patches/guile-emacs-fix-configure.patch		\
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index d320763a61..87b35e2db2 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -16,7 +16,7 @@
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2019 Taylan Kammer <taylan.kammer@gmail.com>
 ;;; Copyright © 2020, 2021, 2022 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -817,7 +817,14 @@ (define-public guile-git
                (base32
                 "11a51acibwi2hpaygmrpn6nwbr4lqalc87ihrgj3mhz6swbsk9n7"))
               (patches (search-patches
-                        "guile-git-adjust-for-libgit2-1.2.0.patch"))))
+                        "guile-git-adjust-for-libgit2-1.2.0.patch"
+                        ;; These three patches from
+                        ;; <https://gitlab.com/guile-git/guile-git/-/issues/26>
+                        ;; together add procedures to disable/enable owner validation,
+                        ;; which is required for fixing <https://issues.guix.gnu.org/55399>.
+                        "guile-git-fix-git-opt.patch"
+                        "guile-git-set-owner-validation.patch"
+                        "guile-git-test-owner-validation.patch"))))
     (build-system gnu-build-system)
     (arguments
      `(#:make-flags '("GUILE_AUTO_COMPILE=0")       ; to prevent guild warnings
@@ -833,9 +840,7 @@ (define-public guile-git
     (native-inputs
      (list pkg-config autoconf automake texinfo guile-3.0 guile-bytestructures))
     (inputs
-     ;; libgit2@1.4.3 ‘fixed’ a git CVE it never shared, breaking Guix.  Use
-     ;; 1.3 for now; see <https://issues.guix.gnu.org/55399> for alternatives.
-     (list guile-3.0 libgit2-1.3))
+     (list guile-3.0 libgit2))
     (propagated-inputs
      (list guile-bytestructures))
     (synopsis "Guile bindings for libgit2")
diff --git a/gnu/packages/patches/guile-git-fix-git-opt.patch b/gnu/packages/patches/guile-git-fix-git-opt.patch
new file mode 100644
index 0000000000..050c72818a
--- /dev/null
+++ b/gnu/packages/patches/guile-git-fix-git-opt.patch
@@ -0,0 +1,57 @@
+From 99054837c6616e06c48c944094114ae8c9b628f3 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Andr=C3=A9=20Batista?= <nandre@riseup.net>
+Date: Thu, 19 May 2022 09:35:25 -0300
+To: incoming+guile-git-guile-git-1792500-1ffl9ys3eg9dz7xscimedvf7n-merge-request@incoming.gitlab.com
+Subject: Update GIT_OPT definitions to match upstream enum
+
+* git/settings.scm: Update definitions to match libgit2 v. 1.4.3.
+
+---
+ git/settings.scm | 25 +++++++++++++++++++++++--
+ 1 file changed, 23 insertions(+), 2 deletions(-)
+
+diff --git a/git/settings.scm b/git/settings.scm
+index 83e2483..4621f43 100644
+--- a/git/settings.scm
++++ b/git/settings.scm
+@@ -1,5 +1,6 @@
+ ;;; Guile-Git --- GNU Guile bindings of libgit2
+ ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
++;;; Copyright © 2022 André Batista <nandre@riseup.net>
+ ;;;
+ ;;; This file is part of Guile-Git.
+ ;;;
+@@ -38,8 +39,28 @@
+ (define GIT_OPT_SET_SSL_CERT_LOCATIONS 12)
+ (define GIT_OPT_SET_USER_AGENT 13)
+ (define GIT_OPT_ENABLE_STRICT_OBJECT_CREATION 14)
+-(define GIT_OPT_SET_SSL_CIPHERS 15)
+-(define GIT_OPT_GET_USER_AGENT 16)
++(define GIT_OPT_ENABLE_STRICT_SYMBOLIC_REF_CREATION 15)
++(define GIT_OPT_SET_SSL_CIPHERS 16)
++(define GIT_OPT_GET_USER_AGENT 17)
++(define GIT_OPT_ENABLE_OFS_DELTA 18)
++(define GIT_OPT_ENABLE_FSYNC_GITDIR 19)
++(define GIT_OPT_GET_WINDOWS_SHAREMODE 20)
++(define GIT_OPT_SET_WINDOWS_SHAREMODE 21)
++(define GIT_OPT_ENABLE_STRICT_HASH_VERIFICATION 22)
++(define GIT_OPT_SET_ALLOCATOR 23)
++(define GIT_OPT_ENABLE_UNSAVED_INDEX_SAFETY 24)
++(define GIT_OPT_GET_PACK_MAX_OBJECTS 25)
++(define GIT_OPT_SET_PACK_MAX_OBJECTS 26)
++(define GIT_OPT_DISABLE_PACK_KEEP_FILE_CHECKS 27)
++(define GIT_OPT_ENABLE_HTTP_EXPECT_CONTINUE 28)
++(define GIT_OPT_GET_MWINDOW_FILE_LIMIT 29)
++(define GIT_OPT_SET_MWINDOW_FILE_LIMIT 30)
++(define GIT_OPT_SET_ODB_PACKED_PRIORITY 31)
++(define GIT_OPT_SET_ODB_LOOSE_PRIORITY 32)
++(define GIT_OPT_GET_EXTENSIONS 33)
++(define GIT_OPT_SET_EXTENSIONS 34)
++(define GIT_OPT_GET_OWNER_VALIDATION 35)
++(define GIT_OPT_SET_OWNER_VALIDATION 36)
+ 
+ (define set-tls-certificate-locations!
+   (let ((proc (libgit2->procedure* "git_libgit2_opts" (list int '* '*))))
+-- 
+2.36.0
+
diff --git a/gnu/packages/patches/guile-git-set-owner-validation.patch b/gnu/packages/patches/guile-git-set-owner-validation.patch
new file mode 100644
index 0000000000..becef644ad
--- /dev/null
+++ b/gnu/packages/patches/guile-git-set-owner-validation.patch
@@ -0,0 +1,41 @@
+From 88091a17f8276b03c95837b422adf5b0b7eda79e Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Andr=C3=A9=20Batista?= <nandre@riseup.net>
+Date: Thu, 19 May 2022 09:47:36 -0300
+Subject: [PATCH] settings: Add 'set-owner-validation!'.
+To: guile-git@gitlab.com
+
+* git/settings.scm: (set-owner-validation!): New procedure.
+---
+ git/settings.scm | 9 ++++++++-
+ 1 file changed, 8 insertions(+), 1 deletion(-)
+
+diff --git a/git/settings.scm b/git/settings.scm
+index 4621f43..f6857d5 100644
+--- a/git/settings.scm
++++ b/git/settings.scm
+@@ -20,7 +20,8 @@
+ (define-module (git settings)
+   #:use-module (system foreign)
+   #:use-module (git bindings)
+-  #:export (set-tls-certificate-locations!
++  #:export (set-owner-validation!
++            set-tls-certificate-locations!
+             set-user-agent!))
+ 
+ ;; 'git_libgit2_opt_t' enum defined in <git2/common.h>.
+@@ -62,6 +63,12 @@
+ (define GIT_OPT_GET_OWNER_VALIDATION 35)
+ (define GIT_OPT_SET_OWNER_VALIDATION 36)
+ 
++(define set-owner-validation!
++  (let ((proc (libgit2->procedure* "git_libgit2_opts" (list int int))))
++    (lambda (owner-validation)
++      "Boolean: enable/disable owner validation checks. See CVE 2022-24765."
++      (proc GIT_OPT_SET_OWNER_VALIDATION (if owner-validation 1 0)))))
++
+ (define set-tls-certificate-locations!
+   (let ((proc (libgit2->procedure* "git_libgit2_opts" (list int '* '*))))
+     (lambda* (directory #:optional file)
+-- 
+2.36.0
+
diff --git a/gnu/packages/patches/guile-git-test-owner-validation.patch b/gnu/packages/patches/guile-git-test-owner-validation.patch
new file mode 100644
index 0000000000..3ef2fa3557
--- /dev/null
+++ b/gnu/packages/patches/guile-git-test-owner-validation.patch
@@ -0,0 +1,153 @@
+From 4a2a6d3723afc05b93edfe430c7f95abbe6db021 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Andr=C3=A9=20Batista?= <nandre@riseup.net>
+Date: Tue, 14 Jun 2022 23:00:07 -0300
+Subject: [PATCH] settings: Add 'owner-validation?'.
+To: guile-git@gitlab.com
+
+* git/settings.scm: (owner-validation?): New procedure.
+* tests/settings.scm: Add owner-validation? tests.
+---
+ Makefile.am        |  1 +
+ git/settings.scm   | 13 ++++++++++++-
+ git/types.scm      | 11 +++++++++++
+ tests/settings.scm | 45 +++++++++++++++++++++++++++++++++++++++++++++
+ 4 files changed, 69 insertions(+), 1 deletion(-)
+ create mode 100644 tests/settings.scm
+
+diff --git a/Makefile.am b/Makefile.am
+index 0f92d4c..033033d 100644
+--- a/Makefile.am
++++ b/Makefile.am
+@@ -95,6 +95,7 @@ TESTS =                                         \
+   tests/remote.scm                              \
+   tests/rev-parse.scm                           \
+   tests/status.scm                              \
++  tests/settings.scm                            \
+   tests/submodule.scm                           \
+   tests/tag.scm                                 \
+   tests/tree.scm
+diff --git a/git/settings.scm b/git/settings.scm
+index 5022945..582f519 100644
+--- a/git/settings.scm
++++ b/git/settings.scm
+@@ -1,6 +1,7 @@
+ ;;; Guile-Git --- GNU Guile bindings of libgit2
+ ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+ ;;; Copyright © 2022 André Batista <nandre@riseup.net>
++;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+ ;;;
+ ;;; This file is part of Guile-Git.
+ ;;;
+@@ -20,7 +21,9 @@
+ (define-module (git settings)
+   #:use-module (system foreign)
+   #:use-module (git bindings)
+-  #:export (set-owner-validation!
++  #:use-module (git types)
++  #:export (owner-validation?
++            set-owner-validation!
+             set-tls-certificate-locations!
+             set-user-agent!))
+ 
+@@ -63,6 +66,14 @@
+ (define GIT_OPT_GET_OWNER_VALIDATION 35)
+ (define GIT_OPT_SET_OWNER_VALIDATION 36)
+ 
++(define owner-validation?
++  (let ((proc (libgit2->procedure* "git_libgit2_opts" (list int '*))))
++      (lambda ()
++        "Boolean: Return owner validation setting."
++        (let ((out (make-int-pointer)))
++          (proc GIT_OPT_GET_OWNER_VALIDATION out)
++          (if (equal? (pointer->int out) 0) #f #t)))))
++
+ (define set-owner-validation!
+   (let ((proc (libgit2->procedure* "git_libgit2_opts" (list int int))))
+     (lambda (owner-validation)
+diff --git a/git/types.scm b/git/types.scm
+index 3503ccf..7609a8a 100644
+--- a/git/types.scm
++++ b/git/types.scm
+@@ -46,7 +46,9 @@
+             tree? pointer->tree tree->pointer
+             tree-entry? pointer->tree-entry tree-entry->pointer
+             submodule? pointer->submodule submodule->pointer
++            pointer->int
+             pointer->size_t
++            make-int-pointer
+             make-size_t-pointer
+             make-double-pointer))
+ 
+@@ -102,9 +104,18 @@
+ (define (make-double-pointer)
+   (bytevector->pointer (make-bytevector (sizeof '*))))
+ 
++(define (make-int-pointer)
++  (bytevector->pointer (make-bytevector (sizeof int))))
++
+ (define (make-size_t-pointer)
+   (bytevector->pointer (make-bytevector (sizeof size_t))))
+ 
++(define (pointer->int ptr)
++  (bytevector-sint-ref (pointer->bytevector ptr (sizeof int))
++                       0
++                       (native-endianness)
++                       (sizeof int)))
++
+ (define (pointer->size_t ptr)
+   (bytevector-uint-ref (pointer->bytevector ptr (sizeof size_t))
+                        0
+diff --git a/tests/settings.scm b/tests/settings.scm
+new file mode 100644
+index 0000000..a82c5ca
+--- /dev/null
++++ b/tests/settings.scm
+@@ -0,0 +1,45 @@
++;;; Guile-Git --- GNU Guile bindings of libgit2
++;;; Copyright © 2022 André Batista <nandre@riseup.net>
++;;;
++;;; This file is part of Guile-Git.
++;;;
++;;; Guile-Git 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.
++;;;
++;;; Guile-Git 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 Guile-Git.  If not, see <http://www.gnu.org/licenses/>.
++
++(define-module (tests settings)
++  #:use-module (srfi srfi-64))
++
++(use-modules (tests helpers))
++(use-modules (git))
++
++(test-begin "settings")
++
++(libgit2-init!)
++
++(with-repository "simple" directory
++
++  (test-equal "disable owner validation"
++    #f
++    ((lambda ()
++      (set-owner-validation! #f)
++      (owner-validation?))))
++
++  (test-equal "enable owner validation"
++    #t
++    ((lambda ()
++      (set-owner-validation! #t)
++      (owner-validation?)))))
++
++(libgit2-shutdown!)
++
++(test-end)
+-- 
+2.36.0
+
-- 
2.37.1