From 0329c4d71505da1854dd885fe9ae8a61ed7d19c7 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Wed, 1 Jan 2020 00:00:00 +0100 Subject: Add a hash function --- ChangeLog | 1 + NEWS | 2 ++ doc/webid-oidc.texi | 4 +++ po/ChangeLog | 1 + po/POTFILES.in | 1 + po/fr.po | 48 ++++++++++++++++---------------- po/webid-oidc.pot | 41 ++++++++++++++++----------- src/ChangeLog | 4 +++ src/Makefile.am | 1 + src/hash/ChangeLog | 11 ++++++++ src/hash/Makefile.am | 11 ++++++++ src/hash/libwebidoidc-hash.c | 64 +++++++++++++++++++++++++++++++++++++++++++ src/libwebidoidc.c | 2 ++ src/scm/webid-oidc/errors.scm | 15 ++++++++++ src/scm/webid-oidc/stubs.scm | 12 ++++++-- tests/Makefile.am | 4 ++- tests/hash-ok.scm | 11 ++++++++ tests/hash-unsupported.scm | 21 ++++++++++++++ 18 files changed, 212 insertions(+), 42 deletions(-) create mode 100644 src/hash/ChangeLog create mode 100644 src/hash/Makefile.am create mode 100644 src/hash/libwebidoidc-hash.c create mode 100644 tests/hash-ok.scm create mode 100644 tests/hash-unsupported.scm diff --git a/ChangeLog b/ChangeLog index c6aa356..020a65a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -15,6 +15,7 @@ * NEWS (A random number generator): Update NEWS (Generating a key pair): Update NEWS (Strip a public key): Update NEWS + (Hash some data): Update NEWS 2020-11-22 Vivien Kraus diff --git a/NEWS b/NEWS index 5850dcd..63f11c7 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,8 @@ There is a function to generate a RSA or ECC key pair. ** Strip a public key In order to avoid leaking the private components of a key, the =strip-key= function keeps only the required parts. +** Hash some data +The function =hash= takes a string, and hashes its UTF-8 encoding. # Local Variables: # mode: org diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi index 0a368e4..c7bfa5b 100644 --- a/doc/webid-oidc.texi +++ b/doc/webid-oidc.texi @@ -151,6 +151,10 @@ The identifier @var{crv} does not identify an elliptic curve. @var{value} does not identify a JWK. @end deftp +@deftp {exception type} &unsupported-alg @var{value} +@var{value} does not identify a valid hash algorithm. +@end deftp + @node GNU Free Documentation License @appendix GNU Free Documentation License diff --git a/po/ChangeLog b/po/ChangeLog index aaa33ce..6a7ac81 100644 --- a/po/ChangeLog +++ b/po/ChangeLog @@ -2,6 +2,7 @@ * POTFILES.in: Put the random submodule in the list. Put the jwk submodule in the list. + Put the hash submodule in the list. 2020-11-22 Vivien Kraus diff --git a/po/POTFILES.in b/po/POTFILES.in index 844066a..a4f4569 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -5,4 +5,5 @@ src/random/libwebidoidc-random.c src/random/generate-random.c src/jwk/libwebidoidc-jwk.c src/jwk/generate-key.c +src/hash/libwebidoidc-hash.c src/scm/webid-oidc/errors.scm diff --git a/po/fr.po b/po/fr.po index 742edbb..869b9c1 100644 --- a/po/fr.po +++ b/po/fr.po @@ -12,7 +12,7 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" -#: src/libwebidoidc.c:9 +#: src/libwebidoidc.c:10 msgid "This is the main function." msgstr "Ceci est la fonction principale." @@ -126,73 +126,82 @@ msgstr "Utilisation : generate-random [NOMBRE D'OCTETS]\n" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "Utilisation : generate-key [NOMBRE DE BITS | COURBE]\n" -#: src/scm/webid-oidc/errors.scm:65 +#: src/scm/webid-oidc/errors.scm:75 msgid "that’s how it is" msgstr "c’est comme ça" -#: src/scm/webid-oidc/errors.scm:70 +#: src/scm/webid-oidc/errors.scm:80 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "la valeur ~s n’est pas une chaîne base64 (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:73 +#: src/scm/webid-oidc/errors.scm:83 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "la valeur ~s n’est pas du JSON (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:76 +#: src/scm/webid-oidc/errors.scm:86 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "la valeur ~s n’identifie pas une courbe elliptique" -#: src/scm/webid-oidc/errors.scm:81 +#: src/scm/webid-oidc/errors.scm:91 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "la valeur ~s n’identifie pas une JWK (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:83 +#: src/scm/webid-oidc/errors.scm:93 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "la valeur ~s n’identifie pas une JWK" -#: src/scm/webid-oidc/errors.scm:88 +#: src/scm/webid-oidc/errors.scm:96 +#, scheme-format +msgid "the value ~s does not identify a hash algorithm" +msgstr "la valeur ~s n’identifie pas un algorithme de hachage" + +#: src/scm/webid-oidc/errors.scm:101 msgid "that’s it" msgstr "c’est tout" -#: src/scm/webid-oidc/errors.scm:92 +#: src/scm/webid-oidc/errors.scm:105 #, scheme-format msgid "~a and ~a" msgstr "~a et ~a" -#: src/scm/webid-oidc/errors.scm:95 +#: src/scm/webid-oidc/errors.scm:108 #, scheme-format msgid "~a, ~a" msgstr "~a, ~a" -#: src/scm/webid-oidc/errors.scm:99 +#: src/scm/webid-oidc/errors.scm:112 msgid "there is an undefined variable" msgstr "il y a une variable non définie" -#: src/scm/webid-oidc/errors.scm:101 +#: src/scm/webid-oidc/errors.scm:114 #, scheme-format msgid "the origin is ~a" msgstr "l’origine est ~a" -#: src/scm/webid-oidc/errors.scm:104 +#: src/scm/webid-oidc/errors.scm:117 #, scheme-format msgid "a message is attached: ~a" msgstr "un message est attaché : ~a" -#: src/scm/webid-oidc/errors.scm:107 +#: src/scm/webid-oidc/errors.scm:120 #, scheme-format msgid "the values ~s are problematic" msgstr "les valeurs ~s sont problématiques" -#: src/scm/webid-oidc/errors.scm:110 +#: src/scm/webid-oidc/errors.scm:123 msgid "there is a kind and args" msgstr "il y a un type et des arguments" -#: src/scm/webid-oidc/errors.scm:112 +#: src/scm/webid-oidc/errors.scm:125 +msgid "there is an assertion failure" +msgstr "il y a un échec d’assertion" + +#: src/scm/webid-oidc/errors.scm:127 #, scheme-format msgid "Unhandled exception type ~a." msgstr "Type d’exception non pris en charge ~a." @@ -225,10 +234,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgid "the value ~s does not identify a JWKS" #~ msgstr "la valeur ~s n’identifie pas un JWKS" -#, scheme-format -#~ msgid "the value ~s does not identify a hash algorithm" -#~ msgstr "la valeur ~s n’identifie pas un algorithme de hachage" - #, scheme-format #~ msgid "the value ~s is not an alist or misses key ~s" #~ msgstr "la valeur ~s n’est pas une alist ou il manque la clé ~s" @@ -671,9 +676,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgid "the signature ~a does not match key ~s with payload ~a" #~ msgstr "la signature ~a ne correspond pas à la clé ~s avec le contenu ~a" -#~ msgid "there is an assertion failure" -#~ msgstr "il y a un échec d’assertion" - #, scheme-format #~ msgid "the program quits with code ~a" #~ msgstr "le programme quitte avec le code ~a" diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index 21b0d57..f1fa6a0 100644 --- a/po/webid-oidc.pot +++ b/po/webid-oidc.pot @@ -17,7 +17,7 @@ msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/libwebidoidc.c:9 +#: src/libwebidoidc.c:10 msgid "This is the main function." msgstr "" @@ -122,73 +122,82 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:65 +#: src/scm/webid-oidc/errors.scm:75 msgid "that’s how it is" msgstr "" -#: src/scm/webid-oidc/errors.scm:70 +#: src/scm/webid-oidc/errors.scm:80 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:73 +#: src/scm/webid-oidc/errors.scm:83 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:76 +#: src/scm/webid-oidc/errors.scm:86 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "" -#: src/scm/webid-oidc/errors.scm:81 +#: src/scm/webid-oidc/errors.scm:91 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:83 +#: src/scm/webid-oidc/errors.scm:93 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:88 +#: src/scm/webid-oidc/errors.scm:96 +#, scheme-format +msgid "the value ~s does not identify a hash algorithm" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:101 msgid "that’s it" msgstr "" -#: src/scm/webid-oidc/errors.scm:92 +#: src/scm/webid-oidc/errors.scm:105 #, scheme-format msgid "~a and ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:95 +#: src/scm/webid-oidc/errors.scm:108 #, scheme-format msgid "~a, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:99 +#: src/scm/webid-oidc/errors.scm:112 msgid "there is an undefined variable" msgstr "" -#: src/scm/webid-oidc/errors.scm:101 +#: src/scm/webid-oidc/errors.scm:114 #, scheme-format msgid "the origin is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:104 +#: src/scm/webid-oidc/errors.scm:117 #, scheme-format msgid "a message is attached: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:107 +#: src/scm/webid-oidc/errors.scm:120 #, scheme-format msgid "the values ~s are problematic" msgstr "" -#: src/scm/webid-oidc/errors.scm:110 +#: src/scm/webid-oidc/errors.scm:123 msgid "there is a kind and args" msgstr "" -#: src/scm/webid-oidc/errors.scm:112 +#: src/scm/webid-oidc/errors.scm:125 +msgid "there is an assertion failure" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:127 #, scheme-format msgid "Unhandled exception type ~a." msgstr "" diff --git a/src/ChangeLog b/src/ChangeLog index 3b99888..d4a8415 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,9 @@ 2020-11-25 Vivien Kraus + * libwebidoidc.c (init_webidoidc): Initialize the hash submodule. + + * Makefile.am: Build the "hash" submodule. + * utilities.h: Add functions for the jwk submodule. * libwebidoidc.c (init_webidoidc): Initialize the jwk submodule. diff --git a/src/Makefile.am b/src/Makefile.am index 1d5f61c..ace4ef9 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -26,6 +26,7 @@ install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA include %reldir%/base64/Makefile.am include %reldir%/random/Makefile.am include %reldir%/jwk/Makefile.am +include %reldir%/hash/Makefile.am include %reldir%/pre-inst/Makefile.am include %reldir%/inst/Makefile.am include %reldir%/scm/Makefile.am diff --git a/src/hash/ChangeLog b/src/hash/ChangeLog new file mode 100644 index 0000000..c609232 --- /dev/null +++ b/src/hash/ChangeLog @@ -0,0 +1,11 @@ +2020-11-27 Vivien Kraus + + * libwebidoidc-hash.c (webidoidc_hash_g): if the argument is a + string, encode it to utf8 first. + +2020-11-25 Vivien Kraus + + * libwebidoidc-hash.c: New file. + + * Makefile.am: New file. + diff --git a/src/hash/Makefile.am b/src/hash/Makefile.am new file mode 100644 index 0000000..5579608 --- /dev/null +++ b/src/hash/Makefile.am @@ -0,0 +1,11 @@ +noinst_LTLIBRARIES += %reldir%/libwebidoidc-hash.la +EXTRA_DIST += %reldir%/libwebidoidc-hash.x +BUILT_SOURCES += %reldir%/libwebidoidc-hash.x + +%canon_reldir%_libwebidoidc_hash_la_LIBADD = $(GUILE_LIBS) $(NETTLE_LIBS) + +AM_CFLAGS += -I %reldir% -I $(srcdir)/%reldir% + +INDENTED += %reldir%/libwebidoidc-hash.c + +%reldir%/libwebidoidc-hash.o: %reldir%/libwebidoidc-hash.x diff --git a/src/hash/libwebidoidc-hash.c b/src/hash/libwebidoidc-hash.c new file mode 100644 index 0000000..75d7da9 --- /dev/null +++ b/src/hash/libwebidoidc-hash.c @@ -0,0 +1,64 @@ +#include +#include + +#define _(s) dgettext (PACKAGE, s) + +SCM_SYMBOL (sha256, "SHA-256"); +SCM_SYMBOL (sha384, "SHA-384"); +SCM_SYMBOL (sha512, "SHA-512"); + +SCM_SYMBOL (unsupported_alg, "unsupported-alg"); + +SCM_DEFINE (webidoidc_hash_g, "hash", 2, 0, 0, (SCM alg, SCM payload), + "Hash something with @var{alg}, which must be @code{'SHA-256}, @code{'SHA-384} or @code{'SHA-512}.") +{ + size_t payload_size; + uint8_t *c_payload; + if (scm_is_string (payload)) + { + return webidoidc_hash_g (alg, scm_string_to_utf8 (payload)); + } + payload_size = scm_c_bytevector_length (payload); + c_payload = scm_gc_malloc_pointerless (payload_size, "To hash"); + memcpy (c_payload, SCM_BYTEVECTOR_CONTENTS (payload), payload_size); + if (scm_is_eq (alg, sha256)) + { + struct sha256_ctx hash; + uint8_t digest[SHA256_DIGEST_SIZE]; + sha256_init (&hash); + sha256_update (&hash, payload_size, c_payload); + sha256_digest (&hash, SHA256_DIGEST_SIZE, digest); + return wrap_bytevector (SHA256_DIGEST_SIZE, digest); + } + else if (scm_is_eq (alg, sha384)) + { + struct sha384_ctx hash; + uint8_t digest[SHA384_DIGEST_SIZE]; + sha384_init (&hash); + sha384_update (&hash, payload_size, c_payload); + sha384_digest (&hash, SHA384_DIGEST_SIZE, digest); + return wrap_bytevector (SHA384_DIGEST_SIZE, digest); + } + else if (scm_is_eq (alg, sha512)) + { + struct sha512_ctx hash; + uint8_t digest[SHA512_DIGEST_SIZE]; + sha512_init (&hash); + sha512_update (&hash, payload_size, c_payload); + sha512_digest (&hash, SHA512_DIGEST_SIZE, digest); + return wrap_bytevector (SHA512_DIGEST_SIZE, digest); + } + else + { + scm_throw (unsupported_alg, scm_list_1 (alg)); + } + return SCM_UNDEFINED; +} + +void +init_webidoidc_hash (void) +{ +#ifndef SCM_MAGIC_SNARFER +#include "libwebidoidc-hash.x" +#endif /* not SCM_MAGIC_SNARFER */ +} diff --git a/src/libwebidoidc.c b/src/libwebidoidc.c index 514a51c..953fea5 100644 --- a/src/libwebidoidc.c +++ b/src/libwebidoidc.c @@ -2,6 +2,7 @@ void init_webidoidc_base64 (void); void init_webidoidc_random (void); void init_webidoidc_jwk (void); +void init_webidoidc_hash (void); void init_webidoidc (void) @@ -10,4 +11,5 @@ init_webidoidc (void) init_webidoidc_base64 (); init_webidoidc_random (); init_webidoidc_jwk (); + init_webidoidc_hash (); } diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index 27dc6e2..b575a77 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -54,6 +54,16 @@ (raise-exception ((record-constructor ¬-a-jwk) value cause))) +(define-public &unsupported-alg + (make-exception-type + '&unsupported-alg + &external-error + '(value))) + +(define-public (raise-unsupported-alg value) + (raise-exception + ((record-constructor &unsupported-alg) value))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -82,6 +92,9 @@ (get 'value) cause) (format #f (G_ "the value ~s does not identify a JWK") (get 'value))))) + ((&unsupported-alg) + (format #f (G_ "the value ~s does not identify a hash algorithm") + (get 'value))) ((&compound-exception) (let ((components (get 'components))) (if (null? components) @@ -108,6 +121,8 @@ (exception-irritants err))) ((&exception-with-kind-and-args) (format #f (G_ "there is a kind and args"))) + ((&assertion-failure) + (format #f (G_ "there is an assertion failure"))) (else (error (format #f (G_ "Unhandled exception type ~a.") (record-type-name type)))))) diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm index ff94497..4f2036b 100644 --- a/src/scm/webid-oidc/stubs.scm +++ b/src/scm/webid-oidc/stubs.scm @@ -28,9 +28,16 @@ (unless ret (raise-not-a-jwk key #f)) ret)) - (lambda (error) + (lambda error (raise-unsupported-crv (cadr error))))) +(define (fix-hash alg payload) + (catch 'unsupported-alg + (lambda () + (hash alg payload)) + (lambda error + (raise-unsupported-alg (cadr error))))) + (export base64-encode (fix-base64-decode . base64-decode) @@ -38,7 +45,8 @@ random-init! (fix-generate-key . generate-key) (fix-kty . kty) - strip-key) + strip-key + (fix-hash . hash)) ;; json reader from guile-json will not behave consistently with ;; SRFI-180 with objects: keys will be mapped to strings, not diff --git a/tests/Makefile.am b/tests/Makefile.am index 8713516..94a8b5b 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -5,7 +5,9 @@ TESTS = %reldir%/load-library.scm \ %reldir%/jwk-kty-ec-correct.scm \ %reldir%/jwk-kty-ec-incorrect.scm \ %reldir%/jwk-kty-rsa-correct.scm \ - %reldir%/jwk-kty-rsa-incorrect.scm + %reldir%/jwk-kty-rsa-incorrect.scm \ + %reldir%/hash-ok.scm \ + %reldir%/hash-unsupported.scm EXTRA_DIST += $(TESTS) diff --git a/tests/hash-ok.scm b/tests/hash-ok.scm new file mode 100644 index 0000000..26384f8 --- /dev/null +++ b/tests/hash-ok.scm @@ -0,0 +1,11 @@ +(use-modules + (webid-oidc testing) + ((webid-oidc stubs) #:prefix stubs:) + (rnrs bytevectors)) + +(with-test-environment + "hash-ok" + (lambda () + (let ((hashed (stubs:hash 'SHA-256 "hello :)"))) + (unless (string? hashed) + (exit 1))))) diff --git a/tests/hash-unsupported.scm b/tests/hash-unsupported.scm new file mode 100644 index 0000000..c52959a --- /dev/null +++ b/tests/hash-unsupported.scm @@ -0,0 +1,21 @@ +(use-modules + (webid-oidc testing) + (webid-oidc errors) + ((webid-oidc stubs) #:prefix stubs:) + (rnrs bytevectors)) + +(with-test-environment + "hash-unsupported" + (lambda () + (with-exception-handler + (lambda (error) + (unless ((record-predicate &unsupported-alg) error) + (exit 1)) + (let ((value ((record-accessor &unsupported-alg 'value) error))) + (unless (eq? value 'SHA-1024) + (exit 2)))) + (lambda () + (stubs:hash 'SHA-1024 "hello :)") + (exit 3)) + #:unwind? #t + #:unwind-for-type &unsupported-alg))) -- cgit v1.2.3