Add a base64 encoder and decoder

8 files changed, 203 insertions, 7 deletions

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 &not-base64
+  (make-exception-type
+   '&not-base64
+   &external-error
+   '(value cause)))
+
+(define-public (raise-not-base64 value cause)
+  (raise-exception
+   ((record-constructor &not-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)
+          ((&not-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 */