Add a strip function

5 files changed, 183 insertions, 4 deletions

diff --git a/src/jwk/ChangeLog b/src/jwk/ChangeLog
index 10e590f..ebd0873 100644
--- a/src/jwk/ChangeLog
+++ b/src/jwk/ChangeLog
@@ -1,6 +1,13 @@
+2020-11-28  Vivien Kraus  <vivien@planete-kraus.eu>
+
+	* libwebidoidc-jwk.c (webidoidc_kty_g): check that we can load the
+	key before telling its kty, so that if the point is not on the
+	curve it is not an EC point.
+
 2020-11-25  Vivien Kraus  <vivien@planete-kraus.eu>
 
 	* libwebidoidc-jwk.c: new file.
+	Add the strip function.
 
 	* generate-key.c: new file.
 
diff --git a/src/jwk/libwebidoidc-jwk.c b/src/jwk/libwebidoidc-jwk.c
index 85386fb..84da5da 100644
--- a/src/jwk/libwebidoidc-jwk.c
+++ b/src/jwk/libwebidoidc-jwk.c
@@ -109,6 +109,70 @@ SCM_DEFINE (webidoidc_generate_key_g, "generate-key", 0, 0, 1, (SCM rest),
   return ret;
 }
 
+SCM_DEFINE (webidoidc_kty_g, "kty", 1, 0, 0, (SCM key),
+	    "Return the type of @var{key}, @code{'EC} or @code{'RSA}. Return @code{#f} if this is not a JWK.")
+{
+  SCM crv = scm_assq_ref (key, kcrv);
+  const struct ecc_curve *c_crv = NULL;
+  struct ecc_point c_point;
+  struct ecc_scalar c_scalar;
+  struct rsa_public_key c_pub;
+  struct rsa_private_key c_key;
+  SCM ret = SCM_BOOL_F;
+  if (scm_is_true (crv))
+    {
+      c_crv = do_ecc_curve_load (crv, 0);
+    }
+  scm_dynwind_begin (0);
+  if (c_crv)
+    {
+      ecc_point_init (&c_point, c_crv);
+      dynwind_ecc_point_clear (&c_point);
+      ecc_scalar_init (&c_scalar, c_crv);
+      dynwind_ecc_scalar_clear (&c_scalar);
+    }
+  rsa_public_key_init (&c_pub);
+  dynwind_rsa_public_key_clear (&c_pub);
+  rsa_private_key_init (&c_key);
+  dynwind_rsa_private_key_clear (&c_key);
+  if (c_crv
+      && (do_ecc_point_load (&c_point, key)
+	  || do_ecc_scalar_load (&c_scalar, key)))
+    {
+      ret = kty_ec;
+    }
+  else if (do_rsa_public_key_load (&c_pub, key)
+	   || do_rsa_private_key_load (&c_key, key))
+    {
+      ret = kty_rsa;
+    }
+  scm_dynwind_end ();
+  return ret;
+}
+
+SCM_DEFINE (webidoidc_strip_key_g, "strip-key", 1, 0, 0, (SCM key),
+	    "Strip a JWK, keeping only the parts that are required for a public key. The fields are sorted aphabetically.")
+{
+  SCM kty = webidoidc_kty_g (key);
+  SCM crv = scm_assq_ref (key, kcrv);
+  SCM x = scm_assq_ref (key, kx);
+  SCM y = scm_assq_ref (key, ky);
+  SCM n = scm_assq_ref (key, kn);
+  SCM e = scm_assq_ref (key, ke);
+  if (scm_is_eq (kty, kty_ec))
+    {
+      return scm_list_4 (scm_cons (kcrv, crv),
+			 scm_cons (kkty, kty_ec),
+			 scm_cons (kx, x), scm_cons (ky, y));
+    }
+  if (scm_is_eq (kty, kty_rsa))
+    {
+      return scm_list_3 (scm_cons (ke, e),
+			 scm_cons (kkty, kty_rsa), scm_cons (kn, n));
+    }
+  scm_throw (unsupported_kty, scm_list_1 (key));
+}
+
 void
 init_webidoidc_jwk (void)
 {
diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index 9d08ed5..27dc6e2 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -26,7 +26,7 @@
 
 (define-public &not-json
   (make-exception-type
-   'not-json
+   '&not-json
    &external-error
    '(value cause)))
 
@@ -34,6 +34,26 @@
   (raise-exception
    ((record-constructor &not-json) value cause)))
 
+(define-public &unsupported-crv
+  (make-exception-type
+   '&unsupported-crv
+   &external-error
+   '(crv)))
+
+(define-public (raise-unsupported-crv crv)
+  (raise-exception
+   ((record-constructor &unsupported-crv) crv)))
+
+(define-public &not-a-jwk
+  (make-exception-type
+   '&not-a-jwk
+   &external-error
+   '(value cause)))
+
+(define-public (raise-not-a-jwk value cause)
+  (raise-exception
+   ((record-constructor &not-a-jwk) value cause)))
+
 (define*-public (error->str err #:key (max-depth #f))
   (if (record? err)
       (let* ((type (record-type-descriptor err))
@@ -49,9 +69,19 @@
           ((&not-base64)
            (format #f (G_ "the value ~s is not a base64 string (because ~a)")
                    (get 'value) (recurse (get 'cause))))
-          ((not-json)
+          ((&not-json)
            (format #f (G_ "the value ~s is not JSON (because ~a)")
                    (get 'value) (recurse (get 'cause))))
+          ((&unsupported-crv)
+           (format #f (G_ "the value ~s does not identify an elleptic curve")
+                   (get 'crv)))
+          ((&not-a-jwk)
+           (let ((cause (get 'cause)))
+             (if cause
+                 (format #f (G_ "the value ~s does not identify a JWK (because ~a)")
+                         (get 'value) cause)
+                 (format #f (G_ "the value ~s does not identify a JWK")
+                         (get 'value)))))
           ((&compound-exception)
            (let ((components (get 'components)))
              (if (null? components)
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 0ef3fb5..ff94497 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -14,12 +14,31 @@
     (lambda error
       (raise-not-base64 data error))))
 
+(define (fix-generate-key . args)
+  (catch 'unsupported-crv
+    (lambda ()
+      (apply generate-key args))
+    (lambda (error)
+      (raise-unsupported-crv (cadr error)))))
+
+(define (fix-kty key)
+  (catch 'unsupported-crv
+    (lambda ()
+      (let ((ret (kty key)))
+        (unless ret
+          (raise-not-a-jwk key #f))
+        ret))
+    (lambda (error)
+      (raise-unsupported-crv (cadr error)))))
+
 (export
  base64-encode
  (fix-base64-decode . base64-decode)
  random
  random-init!
- generate-key)
+ (fix-generate-key . generate-key)
+ (fix-kty . kty)
+ strip-key)
 
 ;; json reader from guile-json will not behave consistently with
 ;; SRFI-180 with objects: keys will be mapped to strings, not
diff --git a/src/utilities.h b/src/utilities.h
index d17f647..ae5d82c 100644
--- a/src/utilities.h
+++ b/src/utilities.h
@@ -64,6 +64,12 @@ static int do_mpz_t_load (mpz_t x, SCM data, int throw_if_fail);
 static const struct ecc_curve *do_ecc_curve_load (SCM data,
 						  int throw_if_fail);
 
+/* Set up a key, and return whether it was OK */
+static int do_ecc_point_load (struct ecc_point *x, SCM data);
+static int do_ecc_scalar_load (struct ecc_scalar *x, SCM data);
+static int do_rsa_public_key_load (struct rsa_public_key *x, SCM data);
+static int do_rsa_private_key_load (struct rsa_private_key *x, SCM data);
+
 /* Register x to be destroyed at the end of the dynamic wind. */
 static void dynwind_mpz_t_clear (mpz_t x);
 static void dynwind_ecc_point_clear (struct ecc_point *x);
@@ -229,7 +235,7 @@ get_as_bytevector (SCM data, size_t *size, int throw_if_fail)
   char *data_str = NULL;
   struct base64_decode_ctx decoder;
   int ok = 1;
-  if (!scm_is_bytevector (data) && !throw_if_fail)
+  if (!scm_is_string (data) && !throw_if_fail)
     {
       return NULL;
     }
@@ -301,6 +307,59 @@ do_ecc_curve_load (SCM crv, int throw_if_fail)
   return NULL;
 }
 
+static inline int
+do_ecc_point_load (struct ecc_point *point, SCM data)
+{
+  mpz_t x, y;
+  int ret = 1;
+  scm_dynwind_begin (0);
+  mpz_init (x);
+  dynwind_mpz_t_clear (x);
+  mpz_init (y);
+  dynwind_mpz_t_clear (y);
+  ret =
+    (do_mpz_t_load (x, scm_assq_ref (data, kx), 0)
+     && do_mpz_t_load (y, scm_assq_ref (data, ky), 0)
+     && ecc_point_set (point, x, y));
+  scm_dynwind_end ();
+  return ret;
+}
+
+static inline int
+do_ecc_scalar_load (struct ecc_scalar *scalar, SCM data)
+{
+  mpz_t z;
+  int ret = 1;
+  scm_dynwind_begin (0);
+  mpz_init (z);
+  dynwind_mpz_t_clear (z);
+  ret =
+    (do_mpz_t_load (z, scm_assq_ref (data, kd), 0)
+     && ecc_scalar_set (scalar, z));
+  scm_dynwind_end ();
+  return ret;
+}
+
+static inline int
+do_rsa_public_key_load (struct rsa_public_key *x, SCM data)
+{
+  return (do_mpz_t_load (x->n, scm_assq_ref (data, kn), 0)
+	  && do_mpz_t_load (x->e, scm_assq_ref (data, ke), 0)
+	  && rsa_public_key_prepare (x));
+}
+
+static inline int
+do_rsa_private_key_load (struct rsa_private_key *x, SCM data)
+{
+  return (do_mpz_t_load (x->d, scm_assq_ref (data, kd), 0)
+	  && do_mpz_t_load (x->p, scm_assq_ref (data, kp), 0)
+	  && do_mpz_t_load (x->q, scm_assq_ref (data, kq), 0)
+	  && do_mpz_t_load (x->a, scm_assq_ref (data, kdp), 0)
+	  && do_mpz_t_load (x->b, scm_assq_ref (data, kdq), 0)
+	  && do_mpz_t_load (x->c, scm_assq_ref (data, kqi), 0)
+	  && rsa_private_key_prepare (x));
+}
+
 static void
 do_mpz_t_clear (void *ptr)
 {