diff options
-rw-r--r-- | NEWS | 1 | ||||
-rw-r--r-- | doc/manual.html | 13 | ||||
-rw-r--r-- | po/fr.po | 90 | ||||
-rw-r--r-- | po/webid-oidc.pot | 53 | ||||
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/Makefile.am | 3 | ||||
-rw-r--r-- | src/base64/Makefile.am | 11 | ||||
-rw-r--r-- | src/base64/libwebidoidc-base64.c | 38 | ||||
-rw-r--r-- | src/libwebidoidc.c | 2 | ||||
-rw-r--r-- | src/scm/webid-oidc/errors.scm | 52 | ||||
-rw-r--r-- | src/scm/webid-oidc/stubs.scm | 11 | ||||
-rw-r--r-- | src/utilities.h | 88 | ||||
-rw-r--r-- | tests/Makefile.am | 11 | ||||
-rw-r--r-- | tests/base64-error.scm | 22 | ||||
-rw-r--r-- | tests/base64-ok.scm | 17 |
15 files changed, 363 insertions, 54 deletions
@@ -4,6 +4,7 @@ #+email: vivien@planete-kraus.eu * Initial features +** Add base64 encoding and decoding # Local Variables: # mode: org diff --git a/doc/manual.html b/doc/manual.html index b643e7b..9a1b75d 100644 --- a/doc/manual.html +++ b/doc/manual.html @@ -113,11 +113,18 @@ </p> <info:deffn type="function" name="error->str" arguments="error [#depth]"> <p> - Return a string explaining the <info:var>error</info:var>. You - can limit the <info:var>depth</info:var> of the explanation as - an integer. + Return a string explaining the <info:var>error</info:var>. You + can limit the <info:var>depth</info:var> of the explanation as + an integer. </p> </info:deffn> + <info:deftp type="exception type" name="&not-base64" arguments="value cause"> + <p> + This exception is raised when the base64 decoding function + failed. <info:var>value</info:var> is the incorrect input, + and <info:var>cause</info:var> is a low-level error. + </p> + </info:deftp> <h1 type="appendix">GNU Free Documentation License</h1> <info:gfdl /> @@ -2,7 +2,7 @@ msgid "" msgstr "" "Project-Id-Version: webid-oidc 0.0.0\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-05-10 14:44+0200\n" +"POT-Creation-Date: 2021-05-10 14:45+0200\n" "PO-Revision-Date: 2021-05-10 14:31+0200\n" "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n" "Language-Team: French <vivien@planete-kraus.eu>\n" @@ -12,14 +12,61 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" -#: src/libwebidoidc.c:6 +#: src/libwebidoidc.c:7 msgid "This is the main function." msgstr "Ceci est la fonction principale." -#: src/scm/webid-oidc/errors.scm:25 +#: src/scm/webid-oidc/errors.scm:35 msgid "that’s how it is" msgstr "c’est comme ça" +#: src/scm/webid-oidc/errors.scm:40 +#, 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:45 +msgid "that’s it" +msgstr "c’est tout" + +#: src/scm/webid-oidc/errors.scm:49 +#, scheme-format +msgid "~a and ~a" +msgstr "~a et ~a" + +#: src/scm/webid-oidc/errors.scm:52 +#, scheme-format +msgid "~a, ~a" +msgstr "~a, ~a" + +#: src/scm/webid-oidc/errors.scm:56 +msgid "there is an undefined variable" +msgstr "il y a une variable non définie" + +#: src/scm/webid-oidc/errors.scm:58 +#, scheme-format +msgid "the origin is ~a" +msgstr "l’origine est ~a" + +#: src/scm/webid-oidc/errors.scm:61 +#, scheme-format +msgid "a message is attached: ~a" +msgstr "un message est attaché : ~a" + +#: src/scm/webid-oidc/errors.scm:64 +#, scheme-format +msgid "the values ~s are problematic" +msgstr "les valeurs ~s sont problématiques" + +#: src/scm/webid-oidc/errors.scm:67 +msgid "there is a kind and args" +msgstr "il y a un type et des arguments" + +#: src/scm/webid-oidc/errors.scm:69 +#, scheme-format +msgid "Unhandled exception type ~a." +msgstr "Type d’exception non pris en charge ~a." + #, c-format #~ msgid "Could not set the global random generator up.\n" #~ msgstr "" @@ -113,10 +160,6 @@ msgstr "c’est comme ça" #~ msgstr "Utilisation : generate-key [NOMBRE DE BITS | COURBE]\n" #, 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)" - -#, scheme-format #~ msgid "the value ~s is not JSON (because ~a)" #~ msgstr "la valeur ~s n’est pas du JSON (parce que ~a)" @@ -541,39 +584,10 @@ msgstr "c’est comme ça" #~ msgid ", " #~ msgstr ", " -#~ msgid "that’s it" -#~ msgstr "c’est tout" - -#, scheme-format -#~ msgid "~a and ~a" -#~ msgstr "~a et ~a" - -#, scheme-format -#~ msgid "~a, ~a" -#~ msgstr "~a, ~a" - #, scheme-format #~ 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 undefined variable" -#~ msgstr "il y a une variable non définie" - -#, scheme-format -#~ msgid "the origin is ~a" -#~ msgstr "l’origine est ~a" - -#, scheme-format -#~ msgid "a message is attached: ~a" -#~ msgstr "un message est attaché : ~a" - -#, scheme-format -#~ msgid "the values ~s are problematic" -#~ msgstr "les valeurs ~s sont problématiques" - -#~ msgid "there is a kind and args" -#~ msgstr "il y a un type et des arguments" - #~ msgid "there is an assertion failure" #~ msgstr "il y a un échec d’assertion" @@ -587,10 +601,6 @@ msgstr "c’est comme ça" #~ msgid "there is an error" #~ msgstr "il y a une erreur" -#, scheme-format -#~ msgid "Unhandled exception type ~a." -#~ msgstr "Type d’exception non pris en charge ~a." - #~ msgid "Warning: generating a new key pair." #~ msgstr "Attention : génération d'une nouvelle paire de clé." diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index 4e24105..148ff7e 100644 --- a/po/webid-oidc.pot +++ b/po/webid-oidc.pot @@ -8,7 +8,7 @@ msgid "" msgstr "" "Project-Id-Version: webid-oidc SNAPSHOT\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-05-10 14:44+0200\n" +"POT-Creation-Date: 2021-05-10 14:45+0200\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Language-Team: LANGUAGE <LL@li.org>\n" @@ -17,10 +17,57 @@ msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/libwebidoidc.c:6 +#: src/libwebidoidc.c:7 msgid "This is the main function." msgstr "" -#: src/scm/webid-oidc/errors.scm:25 +#: src/scm/webid-oidc/errors.scm:35 msgid "that’s how it is" msgstr "" + +#: src/scm/webid-oidc/errors.scm:40 +#, scheme-format +msgid "the value ~s is not a base64 string (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:45 +msgid "that’s it" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:49 +#, scheme-format +msgid "~a and ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:52 +#, scheme-format +msgid "~a, ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:56 +msgid "there is an undefined variable" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:58 +#, scheme-format +msgid "the origin is ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:61 +#, scheme-format +msgid "a message is attached: ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:64 +#, scheme-format +msgid "the values ~s are problematic" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:67 +msgid "there is a kind and args" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:69 +#, scheme-format +msgid "Unhandled exception type ~a." +msgstr "" diff --git a/src/ChangeLog b/src/ChangeLog new file mode 100644 index 0000000..75ed3d1 --- /dev/null +++ b/src/ChangeLog @@ -0,0 +1,5 @@ +2020-11-25 Vivien Kraus <vivien@planete-kraus.eu> + + * Makefile.am (%canon_reldir%_libwebidoidc_la_SOURCES): the common code is considered a source. + + * utilities.h: Put the common code in that header. diff --git a/src/Makefile.am b/src/Makefile.am index a508f40..93fbada 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -23,13 +23,14 @@ webidoidcgo_DATA = install_go_targets = install-webidoidcgoDATA install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA +include %reldir%/base64/Makefile.am include %reldir%/pre-inst/Makefile.am include %reldir%/inst/Makefile.am include %reldir%/scm/Makefile.am CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA) -%canon_reldir%_libwebidoidc_la_SOURCES = %reldir%/gettext.h %reldir%/libwebidoidc.c +%canon_reldir%_libwebidoidc_la_SOURCES = %reldir%/gettext.h %reldir%/libwebidoidc.c %reldir%/utilities.h %canon_reldir%_libwebidoidc_la_LIBADD = $(noinst_LTLIBRARIES) $(GUILE_LIBS) $(NETTLE_LIBS) INDENTED += $(%canon_reldir%_libwebidoidc_la_SOURCES) diff --git a/src/base64/Makefile.am b/src/base64/Makefile.am new file mode 100644 index 0000000..11fdc5a --- /dev/null +++ b/src/base64/Makefile.am @@ -0,0 +1,11 @@ +noinst_LTLIBRARIES += %reldir%/libwebidoidc-base64.la +EXTRA_DIST += %reldir%/libwebidoidc-base64.x +BUILT_SOURCES += %reldir%/libwebidoidc-base64.x + +%canon_reldir%_libwebidoidc_base64_la_LIBADD = $(GUILE_LIBS) $(NETTLE_LIBS) + +AM_CFLAGS += -I %reldir% -I $(srcdir)/%reldir% + +INDENTED += %reldir%/libwebidoidc-base64.c + +%reldir%/libwebidoidc-base64.o: %reldir%/libwebidoidc-base64.x diff --git a/src/base64/libwebidoidc-base64.c b/src/base64/libwebidoidc-base64.c new file mode 100644 index 0000000..8eb29b8 --- /dev/null +++ b/src/base64/libwebidoidc-base64.c @@ -0,0 +1,38 @@ +#include <utilities.h> + +#define _(s) dgettext (PACKAGE, s) + +void init_webidoidc_base64 (void); + +SCM_DEFINE (webidoidc_base64_encode_g, "base64-encode", 1, 0, 0, (SCM data), + "Encode @var{data} as base64. If @var{data} is a string, first encode it to UTF-8.") +{ + size_t c_size; + uint8_t *c_data; + if (scm_is_string (data)) + { + return webidoidc_base64_encode_g (scm_string_to_utf8 (data)); + } + c_size = scm_c_bytevector_length (data); + c_data = scm_gc_malloc_pointerless (c_size, "data"); + memcpy (c_data, SCM_BYTEVECTOR_CONTENTS (data), c_size); + return wrap_bytevector (c_size, c_data); +} + +SCM_DEFINE (webidoidc_base64_decode_g, "base64-decode", 1, 0, 0, (SCM data), + "Decode @var{data} from base64.") +{ + size_t c_size; + uint8_t *c_data = get_as_bytevector (data, &c_size, 1); + SCM ret = scm_c_make_bytevector (c_size); + memcpy (SCM_BYTEVECTOR_CONTENTS (ret), c_data, c_size); + return ret; +} + +void +init_webidoidc_base64 (void) +{ +#ifndef SCM_MAGIC_SNARFER +#include "libwebidoidc-base64.x" +#endif /* not SCM_MAGIC_SNARFER */ +} diff --git a/src/libwebidoidc.c b/src/libwebidoidc.c index 213cbcd..09af3fd 100644 --- a/src/libwebidoidc.c +++ b/src/libwebidoidc.c @@ -1,7 +1,9 @@ #define N_(s) +void init_webidoidc_base64 (void); void init_webidoidc (void) { N_("This is the main function."); + init_webidoidc_base64 (); } diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index 4a28425..98859c9 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -14,18 +14,58 @@ ;; This is a collection of all errors that can happen, and a function ;; to log them. -(define*-public (error->str error #:key (max-depth #f)) - (if (record? error) - (let* ((type (record-type-descriptor error)) +(define-public ¬-base64 + (make-exception-type + '¬-base64 + &external-error + '(value cause))) + +(define-public (raise-not-base64 value cause) + (raise-exception + ((record-constructor ¬-base64) value cause))) + +(define*-public (error->str err #:key (max-depth #f)) + (if (record? err) + (let* ((type (record-type-descriptor err)) (get (lambda (slot) - ((record-accessor type slot) error))) + ((record-accessor type slot) err))) (recurse (if (eqv? max-depth 0) (lambda (err) (G_ "that’s how it is")) (lambda (err) (error->str err #:max-depth (and max-depth (- max-depth 1))))))) (case (record-type-name type) + ((¬-base64) + (format #f (G_ "the value ~s is not a base64 string (because ~a)") + (get 'value) (recurse (get 'cause)))) + ((&compound-exception) + (let ((components (get 'components))) + (if (null? components) + (G_ "that’s it") + (if (null? (cdr components)) + (recurse (car components)) + (if (null? (cddr components)) + (format #f (G_ "~a and ~a") + (recurse (car components)) + (recurse (cadr components))) + (format #f (G_ "~a, ~a") + (recurse (car components)) + (recurse (apply make-exception (cdr components))))))))) + ((&undefined-variable) + (G_ "there is an undefined variable")) + ((&origin) + (format #f (G_ "the origin is ~a") + (exception-origin err))) + ((&message) + (format #f (G_ "a message is attached: ~a") + (exception-message err))) + ((&irritants) + (format #f (G_ "the values ~s are problematic") + (exception-irritants err))) + ((&exception-with-kind-and-args) + (format #f (G_ "there is a kind and args"))) (else - (error (format #f "Unhandled exception type ~a." (record-type-name type)))))) - (format #f "~a" error))) + (error (format #f (G_ "Unhandled exception type ~a.") + (record-type-name type)))))) + (format #f "~a" err))) diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm index 273546c..12006e6 100644 --- a/src/scm/webid-oidc/stubs.scm +++ b/src/scm/webid-oidc/stubs.scm @@ -5,3 +5,14 @@ (load-extension (format #f "~a/libwebidoidc" libdir) "init_webidoidc") + +(define (fix-base64-decode data) + (catch 'base64-decoding-error + (lambda () + (base64-decode data)) + (lambda error + (raise-not-base64 data error)))) + +(export + base64-encode + (fix-base64-decode . base64-decode)) diff --git a/src/utilities.h b/src/utilities.h new file mode 100644 index 0000000..b5b91f9 --- /dev/null +++ b/src/utilities.h @@ -0,0 +1,88 @@ +#ifndef H_UTILITIES_INCLUDED +#define H_UTILITIES_INCLUDED + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif /* HAVE_CONFIG_H */ + +#include <libguile.h> +#include <assert.h> +#include <string.h> +#include <stdlib.h> +#include <nettle/base64.h> +#include <nettle/ecc.h> +#include <nettle/ecdsa.h> +#include <nettle/rsa.h> +#include <nettle/ecc-curve.h> +#include <nettle/yarrow.h> +#include <gettext.h> +#include <stdio.h> +#include <unistd.h> + +/* Return a base64 encoding of some raw data. */ +static SCM wrap_bytevector (size_t length, uint8_t * data); + +/* Decode a base64 of binary data. */ +static uint8_t *get_as_bytevector (SCM data, size_t *size, int throw_if_fail); + +static inline SCM +wrap_bytevector (size_t length, uint8_t * data) +{ + char *head; + char tail[BASE64_ENCODE_FINAL_LENGTH]; + size_t head_size, tail_size; + char *full; + struct base64_encode_ctx encoder; + SCM ret; + base64url_encode_init (&encoder); + scm_dynwind_begin (0); + head = scm_malloc (BASE64_ENCODE_LENGTH (length)); + scm_dynwind_free (head); + head_size = base64_encode_update (&encoder, head, length, data); + tail_size = base64_encode_final (&encoder, tail); + while (tail_size != 0 && tail[tail_size - 1] == '=') + { + tail_size--; + } + full = scm_malloc (head_size + tail_size); + memcpy (full, head, head_size); + memcpy (full + head_size, tail, tail_size); + ret = scm_from_utf8_stringn (full, head_size + tail_size); + scm_dynwind_end (); + return ret; +} + +static inline uint8_t * +get_as_bytevector (SCM data, size_t *size, int throw_if_fail) +{ + uint8_t *ret = NULL; + size_t data_length; + char *data_str = NULL; + struct base64_decode_ctx decoder; + int ok = 1; + if (!scm_is_bytevector (data) && !throw_if_fail) + { + return NULL; + } + base64url_decode_init (&decoder); + scm_dynwind_begin (0); + data_str = scm_to_utf8_stringn (data, &data_length); + scm_dynwind_free (data_str); + ret = scm_malloc (BASE64_DECODE_LENGTH (data_length)); + /* Not protected! Nothing will throw until scm_dynwind_end. */ + ok = base64_decode_update (&decoder, size, ret, data_length, data_str); + scm_dynwind_end (); + if (!ok) + { + ret = NULL; + if (throw_if_fail) + { + SCM base64_decoding_error = + scm_from_utf8_symbol ("base64-decoding-error"); + scm_throw (base64_decoding_error, scm_list_1 (data)); + } + } + return ret; +} + +#endif /* not H_UTILITIES_INCLUDED */ diff --git a/tests/Makefile.am b/tests/Makefile.am index 1e4b2df..12699f9 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -1,4 +1,7 @@ -TESTS = %reldir%/load-library.scm +TESTS = \ + %reldir%/load-library.scm \ + %reldir%/base64-ok.scm \ + %reldir%/base64-error.scm EXTRA_DIST += $(TESTS) @@ -7,3 +10,9 @@ TEST_EXTENSIONS = .scm AM_TESTS_ENVIRONMENT = $(top_builddir)/pre-inst-env SCM_LOG_COMPILER = $(GUILE) AM_SCM_LOG_FLAGS = --no-auto-compile -s + +clean-local: %canon_reldir%-clean-local + +%canon_reldir%-clean-local: + rm -rf %reldir%/*.cache + rm -rf %reldir%/*.home diff --git a/tests/base64-error.scm b/tests/base64-error.scm new file mode 100644 index 0000000..096e1e8 --- /dev/null +++ b/tests/base64-error.scm @@ -0,0 +1,22 @@ +(use-modules + (webid-oidc testing) + ((webid-oidc stubs) #:prefix stubs:) + (webid-oidc errors) + (rnrs bytevectors)) + +(with-test-environment + "base64-error" + (lambda () + (let ((test "hello :)")) + (unless + (with-exception-handler + (lambda (error) + (unless ((record-predicate ¬-base64) error) + (exit 1)) + #t) + (lambda () + (stubs:base64-decode test) + #f) + #:unwind? #t + #:unwind-for-type ¬-base64) + (exit 2))))) diff --git a/tests/base64-ok.scm b/tests/base64-ok.scm new file mode 100644 index 0000000..724f2db --- /dev/null +++ b/tests/base64-ok.scm @@ -0,0 +1,17 @@ +(use-modules + (webid-oidc testing) + ((webid-oidc stubs) #:prefix stubs:) + (rnrs bytevectors)) + +(with-test-environment + "base64-ok" + (lambda () + (let ((test "hello :)")) + (let ((encoded (stubs:base64-encode test))) + (unless (string? encoded) + (exit 1)) + (let ((decoded (stubs:base64-decode encoded))) + (unless (bytevector? decoded) + (exit 2)) + (unless (equal? test (utf8->string decoded)) + (exit 3))))))) |