From 4a2a6d3723afc05b93edfe430c7f95abbe6db021 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Batista?= 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 ;;; Copyright © 2022 André Batista +;;; Copyright © 2022 Maxime Devos ;;; ;;; 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 +;;; +;;; 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 . + +(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