summaryrefslogtreecommitdiff
path: root/guile
diff options
context:
space:
mode:
authorSimon South <simon@simonsouth.net>2021-08-22 08:40:14 +0200
committerDaiki Ueno <ueno@gnu.org>2021-08-22 08:40:14 +0200
commit82dfd81edc5004970bf3a0056ef6e5bc1864ad21 (patch)
tree7c79c803a17d8350c6c6583176c16c16553a366d /guile
parentd31b89de00b12373573cd730b0fba3675f6f157b (diff)
downloadgnutls-82dfd81edc5004970bf3a0056ef6e5bc1864ad21.tar.gz
guile: Add binding for 'gnutls_x509_crt_get_fingerprint'.
* guile/src/core.c (MAX_HASH_SIZE): New constant. (scm_gnutls_x509_certificate_fingerprint): New function. * guile/modules/gnutls.in: Export 'x509-certificate-fingerprint'. * guile/tests/x509-certificates.scm: Test 'x509-certificate-fingerprint'. (%sha1-fingerprint): New constant. (u8vector->hex-string): New procedure. Signed-off-by: Simon South <simon@simonsouth.net>
Diffstat (limited to 'guile')
-rw-r--r--guile/modules/gnutls.in6
-rw-r--r--guile/src/core.c37
-rw-r--r--guile/tests/x509-certificates.scm19
3 files changed, 57 insertions, 5 deletions
diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in
index 6461c404a2..56b4068e07 100644
--- a/guile/modules/gnutls.in
+++ b/guile/modules/gnutls.in
@@ -1,5 +1,6 @@
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007-2012, 2014, 2015, 2016, 2019 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012, 2014, 2015, 2016, 2019, 2021 Free Software
+;;; Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -89,7 +90,8 @@
x509-certificate-subject-key-id
x509-certificate-subject-alternative-name
x509-certificate-public-key-algorithm x509-certificate-key-usage
- import-x509-private-key pkcs8-import-x509-private-key
+ x509-certificate-fingerprint import-x509-private-key
+ pkcs8-import-x509-private-key
;; record layer
record-send record-receive!
diff --git a/guile/src/core.c b/guile/src/core.c
index 0926dc8a97..b1dad0777f 100644
--- a/guile/src/core.c
+++ b/guile/src/core.c
@@ -50,6 +50,9 @@
? alloca (size) \
: scm_gc_malloc_pointerless ((size), "gnutls-alloc"))
+/* Maximum size, in bytes, of the hash data returned by a digest algorithm. */
+#define MAX_HASH_SIZE 64
+
/* SMOB and enums type definitions. */
#include "enum-map.i.c"
#include "smob-types.i.c"
@@ -2891,6 +2894,40 @@ SCM_DEFINE (scm_gnutls_x509_certificate_subject_alternative_name,
}
#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_fingerprint,
+ "x509-certificate-fingerprint",
+ 2, 0, 0,
+ (SCM cert, SCM algo),
+ "Return the fingerprint (a u8vector) of the certificate "
+ "@var{cert}, computed using the digest algorithm @var{algo}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_fingerprint
+{
+ int err;
+ SCM result;
+ gnutls_x509_crt_t c_cert;
+ gnutls_digest_algorithm_t c_algo;
+ uint8_t c_fpr[MAX_HASH_SIZE];
+ size_t c_fpr_len = MAX_HASH_SIZE;
+ scm_t_array_handle c_handle;
+
+ c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+ c_algo = scm_to_gnutls_digest (algo, 1, FUNC_NAME);
+
+ err = gnutls_x509_crt_get_fingerprint (c_cert, c_algo, &c_fpr, &c_fpr_len);
+ if (EXPECT_FALSE (err))
+ scm_gnutls_error (err, FUNC_NAME);
+
+ result = scm_make_u8vector (scm_from_uint(c_fpr_len), SCM_INUM0);
+ scm_array_get_handle (result, &c_handle);
+ memcpy (scm_array_handle_u8_writable_elements (&c_handle), &c_fpr,
+ c_fpr_len);
+ scm_array_handle_release (&c_handle);
+
+ return result;
+}
+
+#undef FUNC_NAME
/* OpenPGP keys. */
diff --git a/guile/tests/x509-certificates.scm b/guile/tests/x509-certificates.scm
index ccf871bd43..984ec6fe3b 100644
--- a/guile/tests/x509-certificates.scm
+++ b/guile/tests/x509-certificates.scm
@@ -1,5 +1,5 @@
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012, 2021 Free Software Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -25,7 +25,8 @@
(use-modules (gnutls)
(gnutls build tests)
(srfi srfi-4)
- (srfi srfi-11))
+ (srfi srfi-11)
+ (ice-9 format))
(define %certificate-file
(search-path %load-path "x509-certificate.pem"))
@@ -41,10 +42,19 @@
;; The certificate's signature algorithm.
sign-algorithm/rsa-sha1)
+(define %sha1-fingerprint
+ ;; The certificate's SHA-1 fingerprint.
+ "7c55df47de718869d55998ee1e9301331ccd0601")
+
(define (file-size file)
(stat:size (stat file)))
+(define (u8vector->hex-string u8vector)
+ (string-join (map (lambda (u8) (format #f "~2,'0x" u8))
+ (u8vector->list u8vector))
+ ""))
+
(run-test
(lambda ()
@@ -74,6 +84,9 @@
cert 0)))
(and (string? name)
(string?
- (x509-subject-alternative-name->string type)))))))))
+ (x509-subject-alternative-name->string type))))
+ (equal? (u8vector->hex-string
+ (x509-certificate-fingerprint cert digest/sha1))
+ %sha1-fingerprint))))))
;;; arch-tag: eef09b52-30e8-472a-8b93-cb636434f6eb