1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
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
|