From 82dfd81edc5004970bf3a0056ef6e5bc1864ad21 Mon Sep 17 00:00:00 2001 From: Simon South Date: Sun, 22 Aug 2021 08:40:14 +0200 Subject: 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 --- guile/modules/gnutls.in | 6 ++++-- guile/src/core.c | 37 +++++++++++++++++++++++++++++++++++++ guile/tests/x509-certificates.scm | 19 ++++++++++++++++--- 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 -- cgit v1.2.1 From bc7ebc5b69253e3c33f4f5d2aeab3ff751ea296b Mon Sep 17 00:00:00 2001 From: Simon South Date: Sun, 22 Aug 2021 08:41:36 +0200 Subject: guile: Add 'GNUTLS_DIG_SHA256' enum value. * guile/modules/gnutls/build/enums.scm (%digest-enum): Add 'sha256'. * guile/modules/gnutls.in: Export 'digest/sha256'. * guile/tests/x509-certificates.scm: Test 'digest/sha256' with 'x509-certificate-fingerprint'. (%sha256-fingerprint): New constant. Signed-off-by: Simon South --- guile/modules/gnutls.in | 1 + guile/modules/gnutls/build/enums.scm | 2 +- guile/tests/x509-certificates.scm | 9 ++++++++- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in index 56b4068e07..0395196273 100644 --- a/guile/modules/gnutls.in +++ b/guile/modules/gnutls.in @@ -153,6 +153,7 @@ digest/sha1 digest/rmd160 digest/md2 + digest/sha256 compression-method/null compression-method/deflate compression-method/lzo diff --git a/guile/modules/gnutls/build/enums.scm b/guile/modules/gnutls/build/enums.scm index 117059b0e3..4bfbb45549 100644 --- a/guile/modules/gnutls/build/enums.scm +++ b/guile/modules/gnutls/build/enums.scm @@ -325,7 +325,7 @@ (define %digest-enum (make-enum-type 'digest "gnutls_digest_algorithm_t" - '(null md5 sha1 rmd160 md2) + '(null md5 sha1 rmd160 md2 sha256) #f "GNUTLS_DIG_")) diff --git a/guile/tests/x509-certificates.scm b/guile/tests/x509-certificates.scm index 984ec6fe3b..874c8ac5ea 100644 --- a/guile/tests/x509-certificates.scm +++ b/guile/tests/x509-certificates.scm @@ -46,6 +46,10 @@ ;; The certificate's SHA-1 fingerprint. "7c55df47de718869d55998ee1e9301331ccd0601") +(define %sha256-fingerprint + ;; The certificate's SHA-256 fingerprint. + "0db40a5ee20169d25f090e4d165d87266b1a04722cddec4da36692c81c3096f6") + (define (file-size file) (stat:size (stat file))) @@ -87,6 +91,9 @@ (x509-subject-alternative-name->string type)))) (equal? (u8vector->hex-string (x509-certificate-fingerprint cert digest/sha1)) - %sha1-fingerprint)))))) + %sha1-fingerprint) + (equal? (u8vector->hex-string + (x509-certificate-fingerprint cert digest/sha256)) + %sha256-fingerprint)))))) ;;; arch-tag: eef09b52-30e8-472a-8b93-cb636434f6eb -- cgit v1.2.1