/* -*-c-*-
*
- * $Id: utils.c,v 1.2 2004/04/08 01:36:21 mdw Exp $
+ * $Id$
*
* Utilities for Catacomb/Perl
*
/*----- Header files ------------------------------------------------------*/
#include "catacomb-perl.h"
+#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)
{
croak("unknown %s constant `%s'", pkg, name);
}
+void ptrtosv(SV **sv, void *p, const char *type)
+{
+ if (p)
+ sv_setref_pv(*sv, type, (void *)p);
+ else
+ *sv = &PL_sv_undef;
+}
+
+void *ptrfromsv(SV *sv, const char *type, const char *what, ...)
+{
+ if (!sv_derived_from(sv, type)) {
+ va_list ap;
+ SV *t = sv_newmortal();
+ va_start(ap, what);
+ sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0);
+ croak("%s is not of type %s", SvPVX(t), type);
+ }
+ 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)
+ f = field_prime(f->m);
+ else if (strcmp(F_NAME(f), "niceprime") == 0)
+ f = field_niceprime(f->m);
+ else if (strcmp(F_NAME(f), "binpoly") == 0)
+ f = field_binpoly(f->m);
+ else if (strcmp(F_NAME(f), "binnorm") == 0) {
+ fctx_binnorm *fc = (fctx_binnorm *)f;
+ f = field_binnorm(f->m, fc->ntop.r[fc->ntop.n - 1]);
+ } else
+ f = 0;
+ 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;
+ mp *a, *b;
+
+ if ((f = copy_field(c->f)) == 0)
+ return (0);
+ a = F_OUT(f, MP_NEW, c->a);
+ b = F_OUT(f, MP_NEW, c->b);
+ if (strcmp(EC_NAME(c), "prime") == 0)
+ c = ec_prime(f, a, b);
+ else if (strcmp(EC_NAME(c), "primeproj") == 0)
+ c = ec_primeproj(f, a, b);
+ 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);
+ else
+ c = 0;
+ MP_DROP(a);
+ MP_DROP(b);
+ if (!c) F_DESTROY(f);
+ 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) {
+ gctx_prime *gc = (gctx_prime *)g;
+ gprime_param gp;
+ gp.g = G_TOINT(g, MP_NEW, g->g);
+ gp.p = gc->mm.m;
+ 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;
+ if ((ei.c = copy_curve(gc->ei.c)) == 0)
+ return (0);
+ EC_CREATE(&ei.g);
+ EC_COPY(&ei.g, &gc->ei.g);
+ ei.r = MP_COPY(gc->ei.r);
+ ei.h = MP_COPY(gc->ei.h);
+ g = group_ec(&ei);
+ } else
+ g = 0;
+ return (g);
+}
+
/*----- That's all, folks -------------------------------------------------*/