Much wider support for Catacomb in all its glory.
[catacomb-perl] / utils.c
diff --git a/utils.c b/utils.c
index e5b49f0..d57bc98 100644 (file)
--- a/utils.c
+++ b/utils.c
 #include <catacomb/ec-guts.h>
 #include <catacomb/group-guts.h>
 #include <catacomb/field-guts.h>
+#include <catacomb/ectab.h>
+#include <catacomb/ptab.h>
+#include <catacomb/bintab.h>
 
-/*----- Main code ---------------------------------------------------------*/
+/*----- Lists of things ---------------------------------------------------*/
+
+#define LISTS(LI)                                                      \
+  LI(list, lists[i].name, lists[i].name)                               \
+  LI(hash, ghashtab[i], ghashtab[i]->name)                             \
+  LI(prp, prptab[i], prptab[i]->name)                                  \
+  LI(cipher, gciphertab[i], gciphertab[i]->name)                       \
+  LI(mac, gmactab[i], gmactab[i]->name)                                        \
+  LI(mgfrand, mgftab[i].name, mgftab[i].name)                          \
+  LI(counterrand, ctrtab[i].name, ctrtab[i].name)                      \
+  LI(ofbrand, ofbtab[i].name, ofbtab[i].name)                          \
+  LI(ec, ectab[i].name, ectab[i].name)                                 \
+  LI(prime, ptab[i].name, ptab[i].name)                                        \
+  LI(bin, bintab[i].name, bintab[i].name)
+
+#define XLISTFN(what, endp, name)                                      \
+  static void list##what(void)                                         \
+  {                                                                    \
+    int i;                                                             \
+    dSP;                                                               \
+    for (i = 0; endp; i++)                                             \
+      XPUSHs(sv_2mortal(newSVpv(name, 0)));                            \
+    PUTBACK;                                                           \
+  }
+
+#define ENTRY(what, endp, name) { #what, list##what },
+
+struct listent {
+  const char *name;
+  void (*list)(void);
+};
+
+static const struct listent lists[];
+
+LISTS(XLISTFN)
+
+static const struct listent lists[] = {
+  LISTS(ENTRY)
+  { 0, 0 }
+};
+
+void names(const char *name)
+{
+  int i;
+
+  for (i = 0; lists[i].name; i++) {
+    if (strcmp(name, lists[i].name) == 0) {
+      lists[i].list();
+      return;
+    }
+  }
+  croak("unknown list `%s'", name);
+}
+
+/*----- Miscellaneous things ----------------------------------------------*/
 
 U32 findconst(const struct consttab *cc, const char *pkg, const char *name)
 {
@@ -68,10 +125,221 @@ void *ptrfromsv(SV *sv, const char *type, const char *what, ...)
   return (void *)SvIV((SV *)SvRV(sv));
 }
 
+void *ptrfromsvdflt(SV *sv, const char *type, void *dflt, const char *what)
+{
+  if (!SvOK(sv))
+    return (dflt);
+  else
+    return (ptrfromsv(sv, type, "%s", what));
+}
+
+/*----- Cursor reading stuff ----------------------------------------------*/
+
+void c_init(cursor *c, SV *sv)
+{
+  if (!SvROK(sv))
+    croak("not a reference");
+  sv = SvRV(sv);
+  switch (SvTYPE(sv)) {
+    case SVt_PVAV:
+      c->f = CF_ARRAY;
+      c->u.a.av = (AV *)sv;
+      c->u.a.i = 0;
+      break;
+    case SVt_PVHV:
+      c->f = CF_HASH;
+      c->u.hv = (HV *)sv;
+      break;
+    default:
+      croak("must be hash ref or array ref");
+  }
+}
+
+void c_skip(cursor *c)
+{
+  if (!(c->f & CF_HASH))
+    c->u.a.i++;
+}
+
+SV *c_get(cursor *c, const char *tag, unsigned f)
+{
+  SV **sv;
+
+  if (c->f & CF_HASH)
+    sv = hv_fetch(c->u.hv, tag, strlen(tag), 0);
+  else {
+    sv = av_fetch(c->u.a.av, c->u.a.i, 0);
+    if (sv) c->u.a.i++;
+  }
+  if ((f & CF_MUST) && !sv)
+    croak("missing entry `%s'", tag);
+  return (sv ? *sv : &PL_sv_undef);
+}
+
+void hvput(HV *hv, const char *k, SV *val)
+{
+  SV **sv = hv_fetch(hv, k, strlen(k), 1);
+  if (!sv)
+    croak("couldn't set hash key %s", k);
+  *sv = val;
+}
+
+/*----- Wrapped objects ---------------------------------------------------*/
+
+static SV *firstelt(SV *sv, const char *what)
+{
+  AV *av;
+  SV **svp;
+
+  if (!SvROK(sv))
+    croak("%s is not a reference", what);
+  sv = SvRV(sv);
+  if (SvTYPE(sv) != SVt_PVAV)
+    croak("%s is not an array reference", what);
+  av = (AV *)sv;
+  svp = av_fetch(av, 0, 0);
+  if (!svp)
+    croak("%s is empty", what);
+  return (*svp);
+}
+
+ge *groupelt(SV *sv, const char *what)
+{
+  if (sv_derived_from(sv, "Catacomb::Group::Elt"))
+    sv = firstelt(sv, what);
+  return (ptrfromsv(sv, "Catacomb::Group::Element", what));
+}
+
+mp *fieldelt(SV *sv, const char *what)
+{
+  if (sv_derived_from(sv, "Catacomb::Field::Elt"))
+    sv = firstelt(sv, what);
+  return (mp_fromsv(sv, what, 0, 0));
+}
+
+ec *ecpt(SV *sv, const char *what)
+{
+  if (sv_derived_from(sv, "Catacomb::EC::Pt"))
+    sv = firstelt(sv, what);
+  return (ptrfromsv(sv, "Catacomb::EC::Point", what));
+}
+
+/*----- DSA contexts ------------------------------------------------------*/
+
+void gdsa_privfromsv(gdsa *g, SV *sv)
+{
+  cursor c;
+
+  c_init(&c, sv);
+  g->g = C_PTR(&c, "G", "Catacomb::Group");
+  g->p = C_GE(&c, "p");
+  g->u = C_MP(&c, "u");
+  g->h = C_PTR(&c, "h", "Catacomb::HashClass");
+  g->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global);
+}
+
+void gdsa_pubfromsv(gdsa *g, SV *sv)
+{
+  cursor c;
+
+  c_init(&c, sv);
+  g->g = C_PTR(&c, "G", "Catacomb::Group");
+  g->p = C_GE(&c, "p");
+  c_skip(&c);
+  g->h = C_PTR(&c, "h", "Catacomb::HashClass");
+  g->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global);
+}
+
+/*----- RSA padding contexts ----------------------------------------------*/
+
+void pkcs1_fromsv(pkcs1 *p, SV *sv)
+{
+  cursor c;
+  STRLEN len;
+  SV *t;
+
+  c_init(&c, sv);
+  t = c_get(&c, "ep", 0);
+  if (SvOK(t)) {
+    p->ep = SvPV(t, len);
+    p->epsz = len;
+  } else {
+    p->ep = 0;
+    p->epsz = 0;
+  }
+  p->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global);
+}
+
+void oaep_fromsv(oaep *p, SV *sv)
+{
+  cursor c;
+  STRLEN len;
+  SV *t;
+
+  c_init(&c, sv);
+  p->cc = C_PTR(&c, "c", "Catacomb::CipherClass");
+  p->ch = C_PTR(&c, "h", "Catacomb::HashClass");
+  t = c_get(&c, "ep", 0);
+  if (SvOK(t)) {
+    p->ep = SvPV(t, len);
+    p->epsz = len;
+  } else {
+    p->ep = 0;
+    p->epsz = 0;
+  }
+  p->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global);
+}
+
+void pss_fromsv(pss *p, SV *sv)
+{
+  cursor c;
+  STRLEN len;
+  SV *t;
+
+  c_init(&c, sv);
+  p->cc = C_PTR(&c, "c", "Catacomb::CipherClass");
+  p->ch = C_PTR(&c, "h", "Catacomb::HashClass");
+  t = c_get(&c, "ssz", 0);
+  p->ssz = SvOK(t) ? SvUV(t) : p->ch->hashsz;
+  p->r = C_PTRDFLT(&c, "rng", "Catacomb::Rand", &rand_global);
+}
+
 /*----- Reconstructing various objects ------------------------------------*/
 
+static SV *collect(SV *thing, ...)
+{
+  va_list ap;
+  AV *av;
+
+  va_start(ap, thing);
+  av = newAV();
+  while (thing) {
+    av_push(av, thing);
+    thing = va_arg(ap, SV *);
+  }
+  va_end(ap);
+  return (newRV_noinc((SV *)av));
+}
+
 /* --- Somewhat unpleasant, really --- */
 
+SV *info_field(field *f)
+{
+  const char *n = F_NAME(f);
+
+  if (strcmp(n, "prime") == 0 || strcmp(n, "niceprime") == 0 ||
+      strcmp(n, "binpoly") == 0)
+    return (collect(newSVpv(n, 0), MAKE_MP(MP_COPY(f->m)), (SV *)0));
+  else if (strcmp(n, "binnorm") == 0) {
+    fctx_binnorm *fc = (fctx_binnorm *)f;
+    return (collect(newSVpv(n, 0),
+                   MAKE_MP(MP_COPY(f->m)),
+                   MAKE_MP(MP_COPY(fc->ntop.r[fc->ntop.n - 1])),
+                   (SV *)0));
+  } else
+    return (&PL_sv_undef);
+}
+
 field *copy_field(field *f)
 {
   if (strcmp(F_NAME(f), "prime") == 0)
@@ -88,6 +356,29 @@ field *copy_field(field *f)
   return (f);
 }
 
+SV *info_curve(ec_curve *c)
+{
+  field *f = c->f;
+  const char *n = EC_NAME(c);
+  SV *fsv;
+  mp *a, *b;
+
+  fsv = info_field(f);
+  if (!SvOK(fsv))
+    return (&PL_sv_undef);
+  a = F_OUT(f, MP_NEW, c->a);
+  b = F_OUT(f, MP_NEW, c->b);
+  if (strcmp(n, "prime") == 0 || strcmp(n, "primeproj") == 0 ||
+      strcmp(n, "bin") == 0 || strcmp(n, "binproj") == 0)
+    return (collect(newSVpv(n, 0), fsv, MAKE_MP(a), MAKE_MP(b), (SV *)0));
+  else {
+    MP_DROP(a);
+    MP_DROP(b);
+    SvREFCNT_dec(fsv);
+    return (&PL_sv_undef);
+  }
+}
+
 ec_curve *copy_curve(ec_curve *c)
 {
   field *f;
@@ -101,7 +392,7 @@ ec_curve *copy_curve(ec_curve *c)
     c = ec_prime(f, a, b);
   else if (strcmp(EC_NAME(c), "primeproj") == 0)
     c = ec_primeproj(f, a, b);
-  if (strcmp(EC_NAME(c), "bin") == 0)
+  else if (strcmp(EC_NAME(c), "bin") == 0)
     c = ec_bin(f, a, b);
   else if (strcmp(EC_NAME(c), "binproj") == 0)
     c = ec_binproj(f, a, b);
@@ -113,6 +404,43 @@ ec_curve *copy_curve(ec_curve *c)
   return (c);
 }
 
+SV *info_group(group *g)
+{
+  const char *n = G_NAME(g);
+
+  if (strcmp(n, "prime") == 0) {
+    gctx_prime *gc = (gctx_prime *)g;
+    return (collect(newSVpv(n, 0),
+                   MAKE_MP(MP_COPY(gc->mm.m)),
+                   MAKE_MP(G_TOINT(g, MP_NEW, g->g)),
+                   MAKE_MP(MP_COPY(gc->g.r)),
+                   (SV *)0));
+  } else if (strcmp(n, "bin") == 0) {
+    gctx_bin *gc = (gctx_bin *)g;
+    return (collect(newSVpv(n, 0),
+                   MAKE_MP(MP_COPY(gc->r.p)),
+                   MAKE_GF(G_TOINT(g, MP_NEW, g->g)),
+                   MAKE_MP(MP_COPY(gc->g.r)),
+                   (SV *)0));
+  } else if (strcmp(n, "ec") == 0) {
+    gctx_ec *gc = (gctx_ec *)g;
+    SV *csv = info_curve(gc->ei.c);
+    ec *gen;
+    if (!SvOK(csv))
+      return (&PL_sv_undef);
+    gen = CREATE(ec);
+    EC_CREATE(gen);
+    EC_COPY(gen, &gc->ei.g);
+    return (collect(newSVpv(n, 0),
+                   csv,
+                   MAKE(gen, "Catacomb::EC::Point"),
+                   MAKE_MP(MP_COPY(gc->ei.r)),
+                   MAKE_MP(MP_COPY(gc->ei.h)),
+                   (SV *)0));
+  } else
+    return (&PL_sv_undef);  
+}
+
 group *copy_group(group *g)
 {
   if (strcmp(G_NAME(g), "prime") == 0) {
@@ -123,6 +451,14 @@ group *copy_group(group *g)
     gp.q = gc->g.r;
     g = group_prime(&gp);
     MP_DROP(gp.g);
+  } else if (strcmp(G_NAME(g), "bin") == 0) {
+    gctx_bin *gc = (gctx_bin *)g;
+    gbin_param gb;
+    gb.g = G_TOINT(g, MP_NEW, g->g);
+    gb.p = gc->r.p;
+    gb.q = gc->g.r;
+    g = group_binary(&gb);
+    MP_DROP(gb.g);    
   } else if (strcmp(G_NAME(g), "ec") == 0) {
     gctx_ec *gc = (gctx_ec *)g;
     ec_info ei;