From a1a90aaf554eb974e39e34b513747eb666180776 Mon Sep 17 00:00:00 2001 From: mdw Date: Thu, 7 Oct 2004 15:49:06 +0000 Subject: [PATCH] Key mangling, and elliptic curves. --- Makefile.PL | 7 +- algorithms.xs | 56 ++---- algs.PL | 41 +--- catacomb-perl.h | 53 ++++- catacomb.xs | 22 ++- ec.xs | 401 +++++++++++++++++++++++++++++++++++++ field.xs | 314 +++++++++++++++++++++++++++++ gf.xs | 323 ++++++++++++++++++++++++++++++ key.xs | 600 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- keystuff.c | 10 +- mp.xs | 114 ++++++++--- mpstuff.c | 15 +- test.pl | 41 +--- typemap | 57 ++---- utils.c | 22 ++- 15 files changed, 1867 insertions(+), 209 deletions(-) create mode 100644 ec.xs create mode 100644 field.xs create mode 100644 gf.xs diff --git a/Makefile.PL b/Makefile.PL index 311a9f7..88318e2 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: Makefile.PL,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Makefile for Catacomb/Perl # @@ -35,13 +35,14 @@ WriteMakefile(NAME => "Catacomb", XS => { "catacomb.xs" => "catacomb.c" }, OBJECT => join(" ", grep { s/$/$Config{_o}/ } @{[qw(algs mpstuff catacomb algstuff - pgproc utils)]}), + keystuff pgproc utils)]}), CONFIGURE => \&configure, PL_FILES => { 'algs.PL' => 'algs.c' }, depend => { '$(MAKEFILE)' => '$(VERSION_FROM)', 'catacomb.c' => join(" ", grep { s/$/.xs/ } - @{[qw(catacomb algorithms mp misc pgen)]}) + @{[qw(catacomb algorithms mp field ec + gf misc pgen key)]}) }, VERSION_FROM => "Catacomb.pm"); diff --git a/algorithms.xs b/algorithms.xs index 95e77b1..6001d9d 100644 --- a/algorithms.xs +++ b/algorithms.xs @@ -1,6 +1,6 @@ # ---?--- # -# $Id: algorithms.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Interface to crypto algorithms # @@ -33,16 +33,8 @@ gccipher * find(me, name) SV *me char *name - PREINIT: - const gccipher **cc; - CODE: - RETVAL = 0; - for (cc = ciphertab; *cc; cc++) { - if (strcmp((*cc)->name, name) == 0) { - RETVAL = (gccipher *)*cc; - break; - } - } + CODE: + RETVAL = (gccipher *)gcipher_byname(name); OUTPUT: RETVAL @@ -50,11 +42,11 @@ SV * list(me) SV *me PREINIT: - const gccipher **cc; + const gccipher *const *cc; SV *sv; PPCODE: - for (cc = ciphertab; *cc; cc++) - XPUSHs(RET(*cc, "Catacomb::CipherClass")); + for (cc = gciphertab; *cc; cc++) + XPUSHs(RET((gccipher *)*cc, "Catacomb::CipherClass")); keysize * keysz(cc) @@ -175,16 +167,8 @@ gchash * find(me, name) SV *me char *name - PREINIT: - const gchash **hc; - CODE: - RETVAL = 0; - for (hc = hashtab; *hc; hc++) { - if (strcmp((*hc)->name, name) == 0) { - RETVAL = (gchash *)*hc; - break; - } - } + CODE: + RETVAL = (gchash *)ghash_byname(name); OUTPUT: RETVAL @@ -192,11 +176,11 @@ SV * list(me) SV *me PREINIT: - const gchash **hc; + const gchash *const *hc; SV *sv; PPCODE: - for (hc = hashtab; *hc; hc++) - XPUSHs(RET(*hc, "Catacomb::HashClass")); + for (hc = ghashtab; *hc; hc++) + XPUSHs(RET((gchash *)*hc, "Catacomb::HashClass")); size_t hashsz(hc) @@ -276,16 +260,8 @@ gcMAC * find(me, name) SV *me char *name - PREINIT: - const gcMAC **mc; - CODE: - RETVAL = 0; - for (mc = mactab; *mc; mc++) { - if (strcmp((*mc)->name, name) == 0) { - RETVAL = (gcMAC *)*mc; - break; - } - } + CODE: + RETVAL = (gcMAC *)gmac_byname(name); OUTPUT: RETVAL @@ -293,11 +269,11 @@ SV * list(me) SV *me PREINIT: - const gcMAC **mc; + const gcMAC *const *mc; SV *sv; PPCODE: - for (mc = mactab; *mc; mc++) - XPUSHs(RET(*mc, "Catacomb::MACClass")); + for (mc = gmactab; *mc; mc++) + XPUSHs(RET((gcMAC *)*mc, "Catacomb::MACClass")); size_t hashsz(mc) diff --git a/algs.PL b/algs.PL index ce7d504..26c1fe3 100644 --- a/algs.PL +++ b/algs.PL @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: algs.PL,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Create tables of algorithms # @@ -31,13 +31,13 @@ idea safer safersk rc2 rc5 square rijndael rijndael192 rijndael256 - serpent + serpent noekeon skipjack mars tea xtea); @stream = qw(rc4 seal); -@hash = qw(md5 md4 md2 tiger - sha sha256 sha384 sha512 +@hash = qw(md5 md4 md2 tiger has160 + sha sha224 sha256 sha384 sha512 rmd128 rmd160 rmd256 rmd320); sub enum { @@ -72,41 +72,12 @@ print OUT < - EOF print OUT cross("#include \n"), "\n"; -print OUT cross("#include \n"), "\n"; -print OUT cross("#include \n"), "\n"; -print OUT cross("#include \n"), "\n"; - -print OUT <\n"), "\n"; +print OUT cross("#include \n"), "\n"; -const gccipher *ciphertab[] = { -EOF -print OUT cross(" &", \@cipher, "_", [qw(ecb cbc cfb counter ofb)], ",\n"); -print OUT cross(" &", \@hash, "_", [qw(mgf)], ",\n"); -print OUT cross(" &", \@stream, ",\n"); print OUT < +#include +#include + #include #include #include #include #include -#include -#include -#include - #include #include #include @@ -56,15 +56,21 @@ #include #include +#include #include #include +#include +#include +#include #include #include #include #include #include #include +#include +#include #include #include @@ -78,7 +84,8 @@ struct consttab { const char *name; UV val; }; extern U32 findconst(const struct consttab *cc, const char *pkg, const char *name); - +extern void ptrtosv(SV **sv, void *p, const char *type); +extern void *ptrfromsv(SV *sv, const char *type, const char *what, ...); #define SET(sv, ob, ty) sv_setref_pv((sv), (char *)(ty), (void *)(ob)) #define MAKE(ob, ty) SET(NEWSV(0, 0), ob, ty) #define RET(ob, ty) SET(sv_newmortal(), ob, ty) @@ -93,32 +100,58 @@ typedef gcmac gcMAC; typedef grand Rand_True, Rand_DSA; -extern const gccipher *ciphertab[]; -extern const gchash *hashtab[]; -extern const gcmac *mactab[]; extern const struct randtab mgftab[], ctrtab[], ofbtab[]; extern SV *findrand(const struct randtab *rt, const char *cls, const char *name, SV *k); extern void listrand(const struct randtab *rt); +/*------ Key mangling -----------------------------------------------------*/ + +typedef struct Key { + key_file *kf; + key *k; +} Key; + +typedef int KeyErr; +typedef key_data Key_Data; +typedef key_file Key_File; + +extern void warn_keyreporter(const char *file, int line, + const char *err, void *p); +extern SV *keyerr(int rc); + /*------ Multiprecision maths ---------------------------------------------*/ +typedef mp gf; typedef mpmont MP_Mont; typedef mpbarrett MP_Barrett; typedef mpcrt MP_CRT; +typedef mpreduce MP_Reduce; +typedef gfreduce GF_Reduce; + +typedef ec EC_Point; +typedef ec_curve EC_Curve; +typedef field Field; + #define XSINTERFACE_FUNC_SETMP(cv, f) \ CvXSUBANY(cv).any_dptr = (void (*) _((void *)))(mp_##f) +#define XSINTERFACE_FUNC_SETGF(cv, f) \ + CvXSUBANY(cv).any_dptr = (void (*) _((void *)))(gf_##f) #define SET_MP(sv, x) SET(sv, x, "Catacomb::MP") #define RET_MP(x) RET(x, "Catacomb::MP") +#define SET_GF(sv, x) SET(sv, x, "Catacomb::GF") +#define RET_GF(x) RET(x, "Catacomb::GF") + extern mp *mp_fromiv(mp *d, IV iv); extern IV mp_toiv(mp *x); extern mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix); extern int mp_writesv(mp *m, SV *sv, int radix); -extern mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...); +extern mp *mp_fromsv(SV *sv, const char *what, const char *ty, + int radix, int keep, ...); /*----- Prime generation --------------------------------------------------*/ diff --git a/catacomb.xs b/catacomb.xs index ceeb484..0f010b4 100644 --- a/catacomb.xs +++ b/catacomb.xs @@ -1,6 +1,6 @@ /* ---?--- * - * $Id: catacomb.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ + * $Id$ * * Main interface to Catacomb functionality * @@ -38,7 +38,21 @@ const(name) #define C(x) { #x, x } C(GRAND_CRYPTO), C(PGEN_BEGIN), C(PGEN_TRY), C(PGEN_FAIL), C(PGEN_PASS), - C(PGEN_DONE), C(PGEN_ABORT), + C(PGEN_DONE), C(PGEN_ABORT), + C(KF_ENCMASK), C(KENC_BINARY), C(KENC_MP), C(KENC_STRUCT), + C(KENC_ENCRYPT), C(KENC_STRING), C(KENC_EC), + C(KF_CATMASK), C(KCAT_SYMM), C(KCAT_PRIV), C(KCAT_PUB), + C(KCAT_SHARE), C(KF_NONSECRET), + C(KF_BURN), C(KF_TEMP), C(KF_OPT), + C(KOPEN_READ), C(KOPEN_WRITE), C(KOPEN_MASK), C(KOPEN_NOFILE), + C(KEXP_FOREVER), C(KEXP_EXPIRE), + C(KERR_OK), C(KERR_BADTAG), C(KERR_BADTYPE), C(KERR_BADCOMMENT), + C(KERR_DUPID), C(KERR_DUPTAG), C(KERR_READONLY), + C(KERR_WILLEXPIRE), C(KERR_EXPIRED), C(KERR_BADFLAGS), + C(KERR_BADPASS), C(KERR_WRONGTYPE), C(KERR_NOTFOUND), + C(KERR_NOTFOUND), C(KERR_BADATTR), + C(KWRITE_OK), C(KWRITE_FAIL), C(KWRITE_BROKEN), + C(FTY_PRIME), C(FTY_BINARY), #undef C { 0, 0 }, }; @@ -51,5 +65,9 @@ PROTOTYPES: DISABLE INCLUDE: algorithms.xs INCLUDE: mp.xs +INCLUDE: gf.xs +INCLUDE: field.xs +INCLUDE: ec.xs INCLUDE: misc.xs INCLUDE: pgen.xs +INCLUDE: key.xs diff --git a/ec.xs b/ec.xs new file mode 100644 index 0000000..66314ce --- /dev/null +++ b/ec.xs @@ -0,0 +1,401 @@ +# ---?--- +# +# $Id$ +# +# Elliptic curves +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +MODULE = Catacomb PACKAGE = Catacomb::EC::Point PREFIX = ec_ + +EC_Point * +new(x = 0, y = 0, z = 0) + mp *x + mp *y + mp *z + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + if (x && y) { + RETVAL->x = MP_COPY(x); + RETVAL->y = MP_COPY(y); + if (z) + RETVAL->z = MP_COPY(z); + } + OUTPUT: + RETVAL + +bool +atinfp(p) + EC_Point *p + CODE: + RETVAL = EC_ATINF(p); + OUTPUT: + RETVAL + +mp * +x(p) + EC_Point *p + CODE: + RETVAL = p->x ? MP_COPY(p->x) : 0; + OUTPUT: + RETVAL + +mp * +y(p) + EC_Point *p + CODE: + RETVAL = p->y ? MP_COPY(p->y) : 0; + OUTPUT: + RETVAL + +mp * +z(p) + EC_Point *p + CODE: + RETVAL = p->z ? MP_COPY(p->z) : 0; + OUTPUT: + RETVAL + +SV * +DESTROY(p) + EC_Point *p + CODE: + EC_DESTROY(p); + DESTROY(p); + XSRETURN_YES; + +MODULE = Catacomb PACKAGE = Catacomb::EC::Curve PREFIX = ec_ + +EC_Curve * +ec_prime(me, f, a, b) + SV *me + Field *f + mp *a + mp *b + C_ARGS: + f, a, b + +EC_Curve * +ec_primeproj(me, f, a, b) + SV *me + Field *f + mp *a + mp *b + C_ARGS: + f, a, b + +EC_Curve * +ec_bin(me, f, a, b) + SV *me + Field *f + gf *a + gf *b + C_ARGS: + f, a, b + +EC_Curve * +ec_binproj(me, f, a, b) + SV *me + Field *f + gf *a + gf *b + C_ARGS: + f, a, b + +char * +name(c) + EC_Curve *c + CODE: + RETVAL = (char *)EC_NAME(c); + OUTPUT: + RETVAL + +bool +ec_samep(me, c) + EC_Curve *me + EC_Curve *c + +EC_Point * +find(c, x) + EC_Curve *c + mp *x + CODE: + RETVAL = CREATE(EC_Point); + if (!ec_find(c, RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +EC_Point * +rand(c, r = &rand_global) + EC_Curve *c + grand *r + CODE: + RETVAL = CREATE(EC_Point); + ec_rand(c, RETVAL, r); + OUTPUT: + RETVAL + +EC_Point * +neg(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + ec_neg(c, RETVAL, p); + OUTPUT: + RETVAL + +EC_Point * +add(c, p, q) + EC_Curve *c + EC_Point *p + EC_Point *q + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + ec_add(c, RETVAL, p, q); + OUTPUT: + RETVAL + +EC_Point * +sub(c, p, q) + EC_Curve *c + EC_Point *p + EC_Point *q + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + ec_sub(c, RETVAL, p, q); + OUTPUT: + RETVAL + +EC_Point * +dbl(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + ec_dbl(c, RETVAL, p); + OUTPUT: + RETVAL + +bool +ec_check(c, p) + EC_Curve *c + EC_Point *p + +EC_Point * +mul(c, p, x) + EC_Curve *c + EC_Point *p + mp *x + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + ec_mul(c, RETVAL, p, x); + OUTPUT: + RETVAL + +EC_Point * +mmul(c, ...) + EC_Curve *c + PREINIT: + ec_mulfactor *v; + size_t i, j, n; + CODE: + if (items < 3 || !(items & 1)) { + croak("Usage: Catacomb::EC::Curve::mmul" + "(c, p_0, x_0, p_1, x_1, ..."); + } + n = (items - 1)/2; + v = xmalloc(n * sizeof(mp_expfactor)); + for (i = 1, j = 0; i < items; i += 2, j++) { + v[j].base = *(ec *)ptrfromsv(ST(i), "Catacomb::EC::Point", "p_i"); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0); + } + RETVAL = CREATE(RETVAL); + EC_CREATE(RETVAL); + ec_mmul(c, RETVAL, v, n); + xfree(v); + OUTPUT: + RETVAL + +EC_Point * +in(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_IN(c, RETVAL, p); + OUTPUT: + RETVAL + +EC_Point * +out(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_OUT(c, RETVAL, p); + OUTPUT: + RETVAL + +EC_Point * +fix(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_FIX(c, RETVAL, p); + OUTPUT: + RETVAL + +EC_Point * +ifind(c, x) + EC_Curve *c + mp *x + CODE: + RETVAL = CREATE(EC_Point); + if (!EC_FIND(c, RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +EC_Point * +ineg(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_NEG(c, RETVAL, p); + OUTPUT: + RETVAL + +EC_Point * +iadd(c, p, q) + EC_Curve *c + EC_Point *p + EC_Point *q + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_ADD(c, RETVAL, p, q); + OUTPUT: + RETVAL + +EC_Point * +isub(c, p, q) + EC_Curve *c + EC_Point *p + EC_Point *q + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_SUB(c, RETVAL, p, q); + OUTPUT: + RETVAL + +EC_Point * +idbl(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + EC_DBL(c, RETVAL, p); + OUTPUT: + RETVAL + +bool +icheck(c, p) + EC_Curve *c + EC_Point *p + CODE: + RETVAL = EC_CHECK(c, p); + OUTPUT: + RETVAL + +EC_Point * +imul(c, p, x) + EC_Curve *c + EC_Point *p + mp *x + CODE: + RETVAL = CREATE(EC_Point); + EC_CREATE(RETVAL); + ec_imul(c, RETVAL, p, x); + OUTPUT: + RETVAL + +EC_Point * +immul(c, ...) + EC_Curve *c + PREINIT: + ec_mulfactor *v; + size_t i, j, n; + CODE: + if (items < 3 || !(items & 1)) { + croak("Usage: Catacomb::EC::Curve::immul" + "(c, p_0, x_0, p_1, x_1, ..."); + } + n = (items - 1)/2; + v = xmalloc(n * sizeof(mp_expfactor)); + for (i = 1, j = 0; i < items; i += 2, j++) { + v[j].base = *(ec *)ptrfromsv(ST(i), "Catacomb::EC::Point", "p_i"); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0); + } + RETVAL = CREATE(RETVAL); + EC_CREATE(RETVAL); + ec_mmul(c, RETVAL, v, n); + xfree(v); + OUTPUT: + RETVAL + +void +getinfo(me, p) + char *p + PREINIT: + ec_info i; + const char *e; + EC_Point *pt; + PPCODE: + if ((e = ec_getinfo(&i, p)) != 0) + croak("bad curve spec: %s", e); + pt = CREATE(EC_Point); + *pt = i.g; + XPUSHs(RET(i.c, "Catacomb::EC::Curve")); + XPUSHs(RET(pt, "Catacomb::EC::Point")); + XPUSHs(RET(i.r, "Catacomb::MP")); + XPUSHs(RET(i.h, "Catacomb::MP")); + diff --git a/field.xs b/field.xs new file mode 100644 index 0000000..5121979 --- /dev/null +++ b/field.xs @@ -0,0 +1,314 @@ +# ---?--- +# +# $Id$ +# +# Field abstraction +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +MODULE = Catacomb PACKAGE = Catacomb::Field PREFIX = field_ + +Field * +field_prime(me, p) + SV *me + mp *p + C_ARGS: + p + +Field * +field_niceprime(me, p) + SV *me + mp *p + C_ARGS: + p + +Field * +field_binpoly(me, p) + SV *me + gf *p + C_ARGS: + p + +Field * +field_binnorm(me, p, beta) + SV *me + gf *p + gf *beta + C_ARGS: + p, beta + +Field * +byname(me, str) + SV *me + char *str + PREINIT: + qd_parse qd; + CODE: + qd.e = 0; + qd.p = str; + if ((RETVAL = field_parse(&qd)) == 0) + croak("bad field spec: %s", qd.e); + else if (!qd_eofp(&qd)) { + F_DESTROY(RETVAL); + croak("junk at end of field spec"); + } + OUTPUT: + RETVAL + +SV * +DESTROY(f) + Field *f + CODE: + F_DESTROY(f); + XSRETURN_YES; + +char * +name(f) + Field *f + CODE: + RETVAL = (char *)F_NAME(f); + OUTPUT: + RETVAL + +UV +type(f) + Field *f + CODE: + RETVAL = F_TYPE(f); + OUTPUT: + RETVAL + +mp * +zero(f) + Field *f + CODE: + RETVAL = MP_COPY(f->zero); + OUTPUT: + RETVAL + +mp * +one(f) + Field *f + CODE: + RETVAL = MP_COPY(f->one); + OUTPUT: + RETVAL + +mp * +m(f) + Field *f + CODE: + RETVAL = MP_COPY(f->m); + OUTPUT: + RETVAL + +UV +nbits(f) + Field *f + CODE: + RETVAL = f->nbits; + OUTPUT: + RETVAL + +UV +noctets(f) + Field *f + CODE: + RETVAL = f->noctets; + OUTPUT: + RETVAL + +mp * +rand(f, r = &rand_global) + Field *f + grand *r + CODE: + RETVAL = F_RAND(f, MP_NEW, r); + OUTPUT: + RETVAL + +bool +samep(f, ff) + Field *f + Field *ff + CODE: + RETVAL = F_SAMEP(f, ff); + OUTPUT: + RETVAL + +mp * +in(f, x) + Field *f + mp *x + CODE: + RETVAL = F_IN(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +out(f, x) + Field *f + mp *x + CODE: + RETVAL = F_OUT(f, MP_NEW, x); + OUTPUT: + RETVAL + +bool +zerop(f, x) + Field *f + mp *x + CODE: + RETVAL = F_ZEROP(f, x); + OUTPUT: + RETVAL + +mp * +neg(f, x) + Field *f + mp *x + CODE: + RETVAL = F_NEG(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +add(f, x, y) + Field *f + mp *x + mp *y + CODE: + RETVAL = F_ADD(f, MP_NEW, x, y); + OUTPUT: + RETVAL + +mp * +sub(f, x, y) + Field *f + mp *x + mp *y + CODE: + RETVAL = F_SUB(f, MP_NEW, x, y); + OUTPUT: + RETVAL + +mp * +mul(f, x, y) + Field *f + mp *x + mp *y + CODE: + RETVAL = F_MUL(f, MP_NEW, x, y); + OUTPUT: + RETVAL + +mp * +sqr(f, x) + Field *f + mp *x + CODE: + RETVAL = F_SQR(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +inv(f, x) + Field *f + mp *x + CODE: + RETVAL = F_INV(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +reduce(f, x) + Field *f + mp *x + CODE: + RETVAL = F_REDUCE(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +sqrt(f, x) + Field *f + mp *x + CODE: + RETVAL = F_SQRT(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +quadsolve(f, x) + Field *f + mp *x + CODE: + if (F_TYPE(f) != FTY_BINARY) + croak("quadsolve only works on binary fields"); + RETVAL = F_QUADSOLVE(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +dbl(f, x) + Field *f + mp *x + CODE: + if (F_TYPE(f) != FTY_PRIME) + croak("dbl only works on prime fields"); + RETVAL = F_DBL(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +tpl(f, x) + Field *f + mp *x + CODE: + if (F_TYPE(f) != FTY_PRIME) + croak("tpl only works on prime fields"); + RETVAL = F_TPL(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +qdl(f, x) + Field *f + mp *x + CODE: + if (F_TYPE(f) != FTY_PRIME) + croak("qdl only works on prime fields"); + RETVAL = F_QDL(f, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +hlv(f, x) + Field *f + mp *x + CODE: + if (F_TYPE(f) != FTY_PRIME) + croak("hlv only works on prime fields"); + RETVAL = F_HLV(f, MP_NEW, x); + OUTPUT: + RETVAL + diff --git a/gf.xs b/gf.xs new file mode 100644 index 0000000..3ea6464 --- /dev/null +++ b/gf.xs @@ -0,0 +1,323 @@ +# ---?--- +# +# $Id$ +# +# Multiprecision interface +# +# (c) 2000 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# + +MODULE = Catacomb PACKAGE = Catacomb::GF PREFIX = gf_ + +gf * +new(me, sv = 0, radix = 0) + SV *me + SV *sv + int radix + CODE: + RETVAL = sv ? mp_fromsv(sv, "sv", "Catacomb::GF", radix, 1) : MP_ZERO; + OUTPUT: + RETVAL + +gf * +copy(x) + gf *x + CODE: + RETVAL = MP_COPY(x); + OUTPUT: + RETVAL + +gf * +loadb(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = mp_loadb(MP_NEW, p, len); + OUTPUT: + RETVAL + +gf * +loadl(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = mp_loadl(MP_NEW, p, len); + OUTPUT: + RETVAL + +int +metrics(m) + gf *m + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + octets bits + +SV * +storeb(m, i = -1) + gf *m + int i + PREINIT: + size_t sz; + CODE: + sz = (i < 0) ? mp_octets(m) : i; + RETVAL = NEWSV(0, sz ? sz : 1); + mp_storeb(m, SvPVX(RETVAL), sz); + SvCUR_set(RETVAL, sz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +storel(m, i = -1) + gf *m + int i + PREINIT: + size_t sz; + CODE: + sz = (i < 0) ? mp_octets(m) : i; + RETVAL = NEWSV(0, sz ? sz : 1); + mp_storel(m, SvPVX(RETVAL), sz); + SvCUR_set(RETVAL, sz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +tostring(m, radix = 16) + gf *m + int radix + CODE: + RETVAL = NEWSV(0, 0); + mp_writesv(m, RETVAL, radix); + OUTPUT: + RETVAL + +SV * +toint(m) + gf *m + CODE: + RETVAL = newSViv(mp_toiv(m)); + OUTPUT: + RETVAL + +SV * +DESTROY(m) + gf *m + CODE: + mp_drop(m); + XSRETURN_UNDEF; + +mp * +gf_sqr(a) + gf *a + C_ARGS: + MP_NEW, a + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETGF + INTERFACE: + sqr + +mp * +binop(a, b) + gf *a + gf *b + C_ARGS: + MP_NEW, a, b + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETGF + INTERFACE: + add sub mul + +gf * +shiftop(a, n) + mp *a + int n + C_ARGS: + MP_NEW, a, n + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + lsl lsr + +int +gf_eq(a, b) + gf *a + gf *b + CODE: + RETVAL = mp_eq(a, b); + OUTPUT: + RETVAL + +int +gf_irreduciblep(a) + gf *a + +void +div(a, b) + mp *a + mp *b + PREINIT: + mp *q = MP_NEW, *r = MP_NEW; + PPCODE: + if (MP_EQ(b, MP_ZERO)) + croak("Divide by zero in Catacomb::GF::div"); + q = MP_NEW; + switch (GIMME_V) { + case G_ARRAY: + r = MP_NEW; + mp_div(&q, &r, a, b); + EXTEND(SP, 2); + PUSHs(RET_GF(q)); + PUSHs(RET_GF(r)); + break; + case G_VOID: + break; + default: + mp_div(&q, &r, a, b); + EXTEND(SP, 1); + PUSHs(RET_GF(q)); + break; + } + +void +gcd(a, b) + gf *a + gf *b + PREINIT: + gf *g = MP_NEW, *x = MP_NEW, *y = MP_NEW; + PPCODE: + switch (GIMME_V) { + case G_ARRAY: + gf_gcd(&g, &x, &y, a, b); + EXTEND(SP, 3); + PUSHs(RET_GF(g)); + PUSHs(RET_GF(x)); + PUSHs(RET_GF(y)); + break; + case G_VOID: + break; + default: + gf_gcd(&g, 0, 0, a, b); + EXTEND(SP, 1); + PUSHs(RET_GF(g)); + break; + } + +GF_Reduce * +makereduce(x) + gf *x + CODE: + RETVAL = CREATE(GF_Reduce); + gfreduce_create(RETVAL, x); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::GF::Reduce PREFIX = gfreduce_ + +GF_Reduce * +new(me, x) + gf *x + CODE: + RETVAL = CREATE(GF_Reduce); + gfreduce_create(RETVAL, x); + OUTPUT: + RETVAL + +SV * +DESTROY(r) + GF_Reduce *r + CODE: + gfreduce_destroy(r); + DESTROY(r); + XSRETURN_UNDEF; + +gf * +reduce(r, x) + GF_Reduce *r + gf *x + CODE: + RETVAL = gfreduce_do(r, MP_NEW, x); + OUTPUT: + RETVAL + +gf * +sqrt(r, x) + GF_Reduce *r + gf *x + CODE: + if ((RETVAL = gfreduce_sqrt(r, MP_NEW, x)) == 0) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +int +gfreduce_trace(r, x) + GF_Reduce *r + gf *x + +gf * +gfreduce_halftrace(r, x) + GF_Reduce *r + gf *x + C_ARGS: + r, MP_NEW, x + +gf * +quadsolve(r, x) + GF_Reduce *r + gf *x + CODE: + if ((RETVAL = gfreduce_quadsolve(r, MP_NEW, x)) == 0) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +gf * +m(r) + GF_Reduce *r + CODE: + RETVAL = MP_COPY(r->p); + OUTPUT: + RETVAL + +gf * +gfreduce_exp(r, x, y) + GF_Reduce *r + gf *x + gf *y + C_ARGS: + r, MP_NEW, x, y + +#----- That's all, folks ---------------------------------------------------- diff --git a/key.xs b/key.xs index 7f0f21d..d4162e9 100644 --- a/key.xs +++ b/key.xs @@ -1,6 +1,6 @@ # ---?--- # -# $Id: key.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Key-management interface # @@ -25,14 +25,496 @@ # along with Catacomb/Perl; if not, write to the Free Software Foundation, # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -MODULE = Catacomb PACKAGE = Catacomb::Key +MODULE = Catacomb PACKAGE = Catacomb::Key PREFIX = key_ -MODULE = Catacomb PACKAGE = Catacomb::Key::Data +bool +key_chkident(me, p) + SV *me + char *p + C_ARGS: + p + +bool +key_chkcomment(me, p) + SV *me + char *p + C_ARGS: + p + +time_t +exp(k) + Key *k + CODE: + RETVAL = k->k->exp; + OUTPUT: + RETVAL + +time_t +del(k) + Key *k + CODE: + RETVAL = k->k->del; + OUTPUT: + RETVAL + +Key_Data * +data(k) + Key *k + CODE: + RETVAL = &k->k->k; + OUTPUT: + RETVAL + +char * +comment(k) + Key *k + CODE: + RETVAL = k->k->c; + OUTPUT: + RETVAL + +U32 +id(k) + Key *k + CODE: + RETVAL = k->k->id; + OUTPUT: + RETVAL + +char * +tag(k) + Key *k + CODE: + RETVAL = k->k->tag; + OUTPUT: + RETVAL + +char * +type(k) + Key *k + CODE: + RETVAL = k->k->type; + OUTPUT: + RETVAL + +KeyErr +key_setcomment(k, p) + Key *k + char *p + C_ARGS: + k->kf, k->k, p + +KeyErr +key_settag(k, p) + Key *k + char *p + C_ARGS: + k->kf, k->k, p + +KeyErr +key_delete(k) + Key *k + C_ARGS: + k->kf, k->k + +SV * +fulltag(k) + Key *k + PREINIT: + dstr d = DSTR_INIT; + CODE: + key_fulltag(k->k, &d); + RETVAL = newSVpv(d.buf, d.len); + dstr_destroy(&d); + OUTPUT: + RETVAL + +const char * +key_getattr(k, a) + Key *k + char *a + C_ARGS: + k->kf, k->k, a + +KeyErr +key_putattr(k, a, v) + Key *k + char *a + char *v + C_ARGS: + k->kf, k->k, a, v + +void +attrlist(k) + Key *k + PREINIT: + key_attriter i; + const char *a, *v; + PPCODE: + for (key_mkattriter(&i, k->k); key_nextattr(&i, &a, &v); ) + XPUSHs(sv_2mortal(newSVpv((char *)a, strlen(a)))); + +bool +expiredp(k) + Key *k + CODE: + RETVAL = key_expired(k->k); + OUTPUT: + RETVAL + +KeyErr +key_expire(k) + Key *k + C_ARGS: + k->kf, k->k + +KeyErr +key_used(k, t) + Key *k + time_t t + C_ARGS: + k->kf, k->k, t + +bool +fingerprint(k, h, kfiltstr) + Key *k + ghash *h + char *kfiltstr + PREINIT: + key_filter kfilt; + dstr d = DSTR_INIT; + CODE: + if (!kfiltstr) + kfilt.f = kfilt.m = 0; + else if (key_readflags(kfiltstr, 0, &kfilt.f, &kfilt.m)) + croak("bad filter string `%s'", kfiltstr); + RETVAL = key_fingerprint(k->k, h, &kfilt); + OUTPUT: + RETVAL + +const char * +key_strerror(me, err) + SV *me + int err + C_ARGS: + err + +MODULE = Catacomb PACKAGE = Catacomb::Key::Data PREFIX = key_ + +Key_Data * +_new(me) + SV *me + CODE: + RETVAL = CREATE(key_data); + RETVAL->e = 0; + RETVAL->u.k.k = 0; + RETVAL->u.k.sz = 0; + OUTPUT: + RETVAL + +SV * +destroy(kd) + Key_Data *kd + CODE: + key_destroy(kd); + XSRETURN_YES; + +SV * +setbinary(kd, sv) + Key_Data *kd + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + key_binary(kd, p, len); + XSRETURN_YES; + +SV * +setencrypted(kd, sv) + Key_Data *kd + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + key_encrypted(kd, p, len); + XSRETURN_YES; + +SV * +setmp(kd, x) + Key_Data *kd + mp *x + CODE: + key_mp(kd, x); + XSRETURN_YES; + +SV * +setstring(kd, p) + Key_Data *kd + char *p + CODE: + key_string(kd, p); + XSRETURN_YES; + +SV * +setec(kd, p) + Key_Data *kd + EC_Point *p + CODE: + key_ec(kd, p); + XSRETURN_YES; + +U32 +flags(kd) + Key_Data *kd + CODE: + RETVAL = kd->e; + OUTPUT: + RETVAL + +SV * +getbinary(kd) + Key_Data *kd + CODE: + if ((kd->e & KF_ENCMASK) != KENC_BINARY) + croak("key is not binary"); + RETVAL = newSVpv(kd->u.k.k, kd->u.k.sz); + OUTPUT: + RETVAL + +SV * +getencrypted(kd) + Key_Data *kd + CODE: + if ((kd->e & KF_ENCMASK) != KENC_ENCRYPT) + croak("key is not encrypted"); + RETVAL = newSVpv(kd->u.k.k, kd->u.k.sz); + OUTPUT: + RETVAL + +mp * +getmp(kd) + Key_Data *kd + CODE: + if ((kd->e & KF_ENCMASK) != KENC_MP) + croak("key is not bignum"); + RETVAL = kd->u.m; + OUTPUT: + RETVAL + +EC_Point * +getec(kd) + Key_Data *kd + CODE: + if ((kd->e & KF_ENCMASK) != KENC_EC) + croak("key is not a curve point"); + RETVAL = CREATE(ec); + EC_CREATE(RETVAL); + EC_COPY(RETVAL, &kd->u.e); + OUTPUT: + RETVAL + +char * +getstring(kd) + Key_Data *kd + CODE: + if ((kd->e & KF_ENCMASK) != KENC_STRING) + croak("key is not string"); + RETVAL = kd->u.p; + OUTPUT: + RETVAL + +SV * +setstruct(kd) + Key_Data *kd + CODE: + key_structure(kd); + XSRETURN_YES; + +Key_Data * +key_structfind(kd, tag) + Key_Data *kd + char *tag + +Key_Data * +key_structcreate(kd, tag) + Key_Data *kd + char *tag + +void +getstruct(kd) + Key_Data *kd + PREINIT: + sym_iter i; + key_struct *ks; + PPCODE: + if ((kd->e & KF_ENCMASK) != KENC_STRUCT) + croak("key is not structured"); + for (sym_mkiter(&i, &kd->u.s); ks = sym_next(&i); ) + XPUSHs(RET(&ks->k, "Catacomb::Key::Data")); + +SV * +structdel(kd, tag) + Key_Data *kd + char *tag + PREINIT: + key_struct *ks; + CODE: + if ((kd->e & KF_ENCMASK) != KENC_STRUCT) + croak("key is not structured"); + if ((ks = sym_find(&kd->u.s, tag, -1, 0, 0)) == 0) + XSRETURN_UNDEF; + sym_remove(&kd->u.s, ks); + XSRETURN_YES; + +void +readflags(me, p) + SV *me + char *p + PREINIT: + unsigned f, m; + PPCODE: + if (key_readflags(p, &p, &f, &m) || *p) + croak("bad flags string"); + XPUSHs(sv_2mortal(newSVuv(m))); + XPUSHs(sv_2mortal(newSVuv(f))); + +SV * +getflags(me, f) + SV *me + U32 f + PREINIT: + dstr d = DSTR_INIT; + CODE: + key_writeflags(f, &d); + RETVAL = newSVpv(d.buf, d.len); + dstr_destroy(&d); + OUTPUT: + RETVAL + +Key_Data * +copy(kd, kfiltstr = 0) + Key_Data *kd + char *kfiltstr + PREINIT: + key_filter kfilt; + CODE: + if (!kfiltstr) + kfilt.f = kfilt.m = 0; + else if (key_readflags(kfiltstr, 0, &kfilt.f, &kfilt.m)) + croak("bad filter string `%s'", kfiltstr); + RETVAL = CREATE(key_data); + if (!key_copy(RETVAL, kd, &kfilt)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +Key_Data * +plock(kd, tag) + Key_Data *kd + char *tag + CODE: + RETVAL = CREATE(Key_Data); + if (key_plock(tag, kd, RETVAL)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +Key_Data * +punlock(kd, tag) + Key_Data *kd + char *tag + CODE: + RETVAL = CREATE(Key_Data); + if (key_punlock(tag, kd, RETVAL)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +Key_Data * +read(me, p) + SV *me + char *p + CODE: + RETVAL = CREATE(key_data); + if (key_read(p, RETVAL, 0)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +SV * +write(kd, kfiltstr = 0) + Key_Data *kd + char *kfiltstr + PREINIT: + key_filter kfilt; + dstr d = DSTR_INIT; + CODE: + if (!kfiltstr) + kfilt.f = kfilt.m = 0; + else if (key_readflags(kfiltstr, 0, &kfilt.f, &kfilt.m)) + croak("bad filter string `%s'", kfiltstr); + if (key_write(kd, &d, &kfilt)) + RETVAL = newSVpv(d.buf, d.len); + else + RETVAL = &PL_sv_undef; + dstr_destroy(&d); + OUTPUT: + RETVAL + +Key_Data * +decode(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = CREATE(key_data); + if (key_decode(p, len, RETVAL)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +SV * +encode(kd, kfiltstr = 0) + Key_Data *kd + char *kfiltstr + PREINIT: + key_filter kfilt; + dstr d = DSTR_INIT; + CODE: + if (!kfiltstr) + kfilt.f = kfilt.m = 0; + else if (key_readflags(kfiltstr, 0, &kfilt.f, &kfilt.m)) + croak("bad filter string `%s'", kfiltstr); + if (key_encode(kd, &d, &kfilt)) + RETVAL = newSVpv(d.buf, d.len); + else + RETVAL = &PL_sv_undef; + dstr_destroy(&d); + OUTPUT: + RETVAL MODULE = Catacomb PACKAGE = Catacomb::Key::File PREFIX = key_ Key_File * -new(file, how) +new(me, file, how) + SV *me char *file unsigned how CODE: @@ -49,9 +531,10 @@ DESTROY(kf) Key_File *kf CODE: key_close(kf); + DESTROY(kf); XSRETURN_UNDEF; -KEYERR +KeyErr merge(kf, name, fp) Key_File *kf char *name @@ -61,7 +544,110 @@ merge(kf, name, fp) OUTPUT: RETVAL -SV * -extract +bool +extract(kf, k, fp, kfiltstr = 0) + Key_File *kf + Key *k + FILE *fp + char *kfiltstr + PREINIT: + key_filter kfilt; + CODE: + if (!kfiltstr) + kfilt.f = kfilt.m = 0; + else if (key_readflags(kfiltstr, 0, &kfilt.f, &kfilt.m)) + croak("bad filter string `%s'", kfiltstr); + RETVAL = key_extract(kf, k->k, fp, &kfilt); + OUTPUT: + RETVAL + +int +key_save(kf) + Key_File *kf + +void +qtag(kf, tag) + Key_File *kf + char *tag + PREINIT: + dstr d = DSTR_INIT; + Key *k; + key_data *kd; + PPCODE: + k = CREATE(Key); + kd = CREATE(key_data); + if (key_qtag(kf, tag, &d, &k->k, &kd)) { + DESTROY(k); + DESTROY(kd); + XPUSHs(&PL_sv_undef); + XPUSHs(&PL_sv_undef); + XPUSHs(&PL_sv_undef); + } else { + k->kf = kf; + XPUSHs(sv_2mortal(newSVpv(d.buf, d.len))); + XPUSHs(RET(k, "Catacomb::Key")); + XPUSHs(RET(k, "Catacomb::Key::Data")); + } + dstr_destroy(&d); + +Key * +bytype(kf, type) + Key_File *kf + char *type + CODE: + RETVAL = CREATE(Key); + if ((RETVAL->k = key_bytype(kf, type)) != 0) + RETVAL->kf = kf; + else { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +Key * +byid(kf, id) + Key_File *kf + U32 id + CODE: + RETVAL = CREATE(Key); + if ((RETVAL->k = key_byid(kf, id)) != 0) + RETVAL->kf = kf; + else { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +Key * +bytag(kf, tag) + Key_File *kf + char *tag + CODE: + RETVAL = CREATE(Key); + if ((RETVAL->k = key_bytag(kf, tag)) != 0) + RETVAL->kf = kf; + else { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +void +list(kf) + Key_File *kf + PREINIT: + key_iter i; + key *k; + Key *kk; + PPCODE: + for (key_mkiter(&i, kf); k = key_next(&i); ) { + kk = CREATE(Key); + kk->kf = kf; + kk->k = k; + XPUSHs(RET(kk, "Catacomb::Key")); + } #----- That's all, folks ---------------------------------------------------- diff --git a/keystuff.c b/keystuff.c index 6df6cec..b8c9519 100644 --- a/keystuff.c +++ b/keystuff.c @@ -1,6 +1,6 @@ /* -*-c-*- * - * $Id: keystuff.c,v 1.2 2004/04/08 01:36:21 mdw Exp $ + * $Id$ * * Useful key-management functions * @@ -28,15 +28,13 @@ /*----- Header files ------------------------------------------------------*/ -/*----- Data structures ---------------------------------------------------*/ - -/*----- Static variables --------------------------------------------------*/ +#include "catacomb-perl.h" /*----- Main code ---------------------------------------------------------*/ -void warn_keyreporter(const char *file, int line, char *err, void *p) +void warn_keyreporter(const char *file, int line, const char *err, void *p) { - warn("%s:%i: keyfile error: %s", file, line, msg); + warn("%s:%i: keyfile error: %s", file, line, err); } SV *keyerr(int rc) diff --git a/mp.xs b/mp.xs index 56c8756..5d78908 100644 --- a/mp.xs +++ b/mp.xs @@ -1,6 +1,6 @@ # ---?--- # -# $Id: mp.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Multiprecision interface # @@ -34,13 +34,18 @@ new(me, sv = 0, radix = 0) SV *sv int radix CODE: - RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO; + RETVAL = sv ? mp_fromsv(sv, "sv", + "Catacomb::MP", radix, 1) : MP_ZERO; OUTPUT: RETVAL mp * -mp_copy(x) +copy(x) mp *x + CODE: + RETVAL = MP_COPY(x); + OUTPUT: + RETVAL mp * loadb(me, sv) @@ -147,7 +152,7 @@ mp * neg(a) mp *a CODE: - mp_copy(a); + MP_COPY(a); RETVAL = mp_split(a); if (RETVAL->v < RETVAL->vl) RETVAL->f ^= MP_NEG; @@ -284,13 +289,24 @@ smallfactor(x) OUTPUT: RETVAL +MP_Reduce * +makereduce(x) + mp *x + CODE: + if (!MP_POSP(x)) + croak("Argument to Catacomb::MP::makereduce must be positive"); + RETVAL = CREATE(MP_Reduce); + mpreduce_create(RETVAL, x); + OUTPUT: + RETVAL + MP_Mont * mont(x) mp *x CODE: - if (x->f & MP_NEG) + if (!MP_POSP(x)) croak("Argument to Catacomb::MP::mont must be positive"); - if (x->v == x->vl || !(x->v[0] & 1u)) + if (!MP_ODDP(x)) croak("Argument to Catacomb::MP::mont must be odd"); RETVAL = CREATE(MP_Mont); mpmont_create(RETVAL, x); @@ -301,7 +317,7 @@ MP_Barrett * barrett(x) mp *x CODE: - if (x->f & MP_NEG) + if (!MP_POSP(x)) croak("Argument to Catacomb::MP::barrett must be positive"); RETVAL = CREATE(mpbarrett); mpbarrett_create(RETVAL, x); @@ -312,9 +328,9 @@ MP_Prime_Rabin * rabin(x) mp *x CODE: - if (x->f & MP_NEG) + if (!MP_POSP(x)) croak("Argument to Catacomb::MP::rabin must be positive"); - if (x->v == x->vl || !(x->v[0] & 1u)) + if (!MP_ODDP(x)) croak("Argument to Catacomb::MP::rabin must be odd"); RETVAL = CREATE(MP_Prime_Rabin); rabin_create(RETVAL, x); @@ -328,9 +344,9 @@ new(me, x) SV *me mp *x CODE: - if (x->f & MP_NEG) + if (!MP_POSP(x)) croak("Argument to Catacomb::MP::Mont::new must be positive"); - if (x->v == x->vl || !(x->v[0] & 1u)) + if (!MP_ODDP(x)) croak("Argument to Catacomb::MP::Mont::new must be odd"); RETVAL = CREATE(MP_Mont); mpmont_create(RETVAL, x); @@ -390,8 +406,8 @@ mpmont_mexpr(mm, ...) n = (items - 1)/2; v = xmalloc(n * sizeof(mp_expfactor)); for (i = 1, j = 0; i < items; i += 2, j++) { - v[j].base = mp_fromsv(ST(i), "g_i", 0, 0); - v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0); + v[j].base = mp_fromsv(ST(i), "g_i", "Catacomb::MP", 0, 0); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0); } RETVAL = mpmont_mexpr(mm, MP_NEW, v, n); xfree(v); @@ -412,8 +428,10 @@ mpmont_mexp(mm, ...) n = (items - 1)/2; v = xmalloc(n * sizeof(mp_expfactor)); for (i = 1, j = 0; i < items; i += 2, j++) { - v[j].base = mp_fromsv(ST(i), "g_%lu", 0, 0, (unsigned long)i); - v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", 0, 0, (unsigned long)i); + v[j].base = mp_fromsv(ST(i), "g_%lu", + "Catacomb::MP", 0, 0, (unsigned long)i); + v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", + "Catacomb::MP", 0, 0, (unsigned long)i); } RETVAL = mpmont_mexp(mm, MP_NEW, v, n); xfree(v); @@ -424,7 +442,7 @@ mp * r(mm) MP_Mont *mm CODE: - RETVAL = mp_copy(mm->r); + RETVAL = MP_COPY(mm->r); OUTPUT: RETVAL @@ -432,7 +450,7 @@ mp * r2(mm) MP_Mont *mm CODE: - RETVAL = mp_copy(mm->r2); + RETVAL = MP_COPY(mm->r2); OUTPUT: RETVAL @@ -440,7 +458,7 @@ mp * m(mm) MP_Mont *mm CODE: - RETVAL = mp_copy(mm->m); + RETVAL = MP_COPY(mm->m); OUTPUT: RETVAL @@ -451,7 +469,7 @@ new(me, x) SV *me mp *x CODE: - if (x->f & MP_NEG) + if (!MP_POSP(x)) croak("Argument to Catacomb::MP::Barrett::new must be positive"); RETVAL = CREATE(mpbarrett); mpbarrett_create(RETVAL, x); @@ -485,7 +503,54 @@ mp * m(mb) MP_Barrett *mb CODE: - RETVAL = mp_copy(mb->m); + RETVAL = MP_COPY(mb->m); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::Reduce PREFIX = mpreduce_ + +MP_Reduce * +new(me, x) + SV *me + mp *x + CODE: + if (!MP_POSP(x)) + croak("Argument to Catacomb::MP::Reduce::new must be positive"); + RETVAL = CREATE(mpreduce); + mpreduce_create(RETVAL, x); + OUTPUT: + RETVAL + +SV * +DESTROY(r) + MP_Reduce *r + CODE: + mpreduce_destroy(r); + DESTROY(r); + XSRETURN_UNDEF; + +mp * +reduce(r, x) + MP_Reduce *r + mp *x + CODE: + RETVAL = mpreduce_do(r, MP_NEW, x); + OUTPUT: + RETVAL + +mp * +mpreduce_exp(r, x, y) + MP_Reduce *r + mp *x + mp *y + C_ARGS: + r, MP_NEW, x, y + +mp * +m(r) + MP_Reduce *r + CODE: + RETVAL = MP_COPY(r->p); OUTPUT: RETVAL @@ -503,7 +568,8 @@ new(me, ...) n = items - 1; v = xmalloc(n * sizeof(mpcrt_mod)); for (i = 0; i < n; i++) { - v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 0, 0, + v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", + "Catacomb::MP", 0, 0, (unsigned long)i)); } RETVAL = CREATE(MP_CRT); @@ -530,8 +596,10 @@ solve(mc, ...) n = mc->k; if (items - 1 != n) croak("Wrong number of residues for this CRT context"); - for (i = 0; i < n; i++) - v[i] = mp_fromsv(ST(i + 1), "r_%lu", 0, 0, (unsigned long)i); + for (i = 0; i < n; i++) { + v[i] = mp_fromsv(ST(i + 1), "r_%lu", "Catacomb::MP", + 0, 0, (unsigned long)i); + } RETVAL = mpcrt_solve(mc, MP_NEW, v); xfree(v); OUTPUT: diff --git a/mpstuff.c b/mpstuff.c index 34a5b54..c891a76 100644 --- a/mpstuff.c +++ b/mpstuff.c @@ -1,6 +1,6 @@ /* -*-c-*- * - * $Id: mpstuff.c,v 1.2 2004/04/08 01:36:21 mdw Exp $ + * $Id$ * * MP manipulation stuff * @@ -107,19 +107,20 @@ int mp_writesv(mp *m, SV *sv, int radix) /* --- Conversion to and from SVs --- */ -mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...) +mp *mp_fromsv(SV *sv, const char *what, const char *ty, + int radix, int keep, ...) { mp *m; if (SvROK(sv)) { - if (sv_derived_from(sv, "Catacomb::MP")) + if (sv_derived_from(sv, "Catacomb::MP") || + sv_derived_from(sv, "Catacomb::GF")) m = (mp *)SvIV((SV *)SvRV(sv)); else { va_list ap; - SV *t = NEWSV(0, 0); + SV *t = sv_newmortal(); va_start(ap, keep); sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); - croak("%s is not of type Catacomb::MP", SvPVX(t)); - SvREFCNT_dec(t); + croak("%s is not of type %s", SvPVX(t), ty); } } else { if (SvIOK(sv)) @@ -127,7 +128,7 @@ mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...) else m = mp_readsv(MP_NEW, sv, 0, radix); if (m && !keep) - RET_MP(m); /* Kill temporary later */ + RET(m, ty); /* Kill temporary later */ } return (m); } diff --git a/test.pl b/test.pl index 01b9f63..8d7e82c 100644 --- a/test.pl +++ b/test.pl @@ -1,39 +1,6 @@ use Catacomb qw(:const); -package EV; -@ISA = qw(Catacomb::MP::Prime::Gen::Proc); -sub pgen_begin { my ($me, $ev) = @_; print $ev->name(), ": "; } -sub pgen_pass { print "*"; } -sub pgen_fail { print "."; } -sub pgen_done { print "*\n"; } -sub new { my $me = bless { FLUSH => $| }, $_[0]; $| = 1; return $me; } -sub DESTROY { my $me = shift; $| = $me->{FLUSH}; } - -package main; - -$mm = Catacomb::MP->factorial(16); -$mm2 = $mm; -$mm++; -print join(", ", $mm2->gcd(19)), "\n"; - -$md5 = Catacomb::HashClass->find("md5"); -$h = $md5->init(); -$h->hash("abc"); -$hh = $h->done(); -print length($hh), "\n"; -print unpack("H*", $hh), "\n"; - -foreach $i (Catacomb::CipherClass->list()) { - print $i->name(), "\n"; -} - -$p = Catacomb::MP::Prime::gen("p", $Catacomb::random->mp(512, 3), - 0, Catacomb::MP::Prime::Filter->stepper(4), - 5, Catacomb::MP::Prime::Rabin->tester(), - EV->new()); -$q = Catacomb::MP::Prime::gen("q", $Catacomb::random->mp(512, 3), - 0, Catacomb::MP::Prime::Filter->stepper(4), - 5, Catacomb::MP::Prime::Rabin->tester(), - EV->new()); - -print "p = $p\nq = $q\n"; +($c, $g, $r, $h) = Catacomb::EC::Curve->getinfo("secp160r1"); +print $g->atinfp(), ": ", $g->x, ", ", $g->y, "\n"; +$p = $c->mul($g, $r); +print $p->atinfp(), "\n"; diff --git a/typemap b/typemap index 0ffd393..e28ed73 100644 --- a/typemap +++ b/typemap @@ -1,5 +1,12 @@ TYPEMAP mp * T_MP +gf * T_MP +GE * T_CATSTRUCT +EC_Point * T_CATSTRUCT +EC_Curve * T_CATSTRUCT +EC_Info * T_CATSTRUCT +Field * T_CATSTRUCT +Group * T_CATSTRUCT gccipher * T_GCALG gchash * T_GCALG gcMAC * T_GCALG @@ -16,6 +23,8 @@ MP_Mont * T_CATSTRUCT MP_Barrett * T_CATSTRUCT MP_Mul * T_CATSTRUCT MP_CRT * T_CATSTRUCT +MP_Reduce * T_CATSTRUCT +GF_Reduce * T_CATSTRUCT MP_Prime_Filter * T_CATSTRUCT MP_Prime_Rabin * T_CATSTRUCT MP_Prime_Gen_Event * T_CATSTRUCT @@ -34,27 +43,15 @@ KeyErr T_KEYERR INPUT T_MP - $var = mp_fromsv($arg, \"$var\", 0, 0) + $var = mp_fromsv($arg, \"$var\", \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::\U$1/; $ntt =~ s/_/::/g; \$ntt}\", 0, 0) T_CATSTRUCT - if (sv_derived_from($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\")) - $var = ($type)SvIV((SV *)SvRV($arg)); - else - croak(\"$var is not of type ${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\") + $var = ptrfromsv($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\", \"$var\"); T_GALG - if (sv_derived_from($arg, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\")) - $var = ($type)SvIV((SV *)SvRV($arg)); - else - croak(\"$var is not of type ${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\") + $var = ptrfromsv($arg, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\", \"$var\"); T_GCALG - if (sv_derived_from($arg, \"${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\")) - $var = ($type)SvIV((SV *)SvRV($arg)); - else - croak(\"$var is not of type ${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\") + $var = ptrfromsv($arg, \"${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\", \"$var\"); T_KEYSZ - if (sv_derived_from($arg, \"Catacomb::KeySize\")) - $var = (keysize *)SvIV((SV *)SvRV($arg)); - else - croak(\"$var is not of type Catacomb::KeySize\") + $var = ptrfromsv($arg, \"Catacomb::KeySize\", \"$var\"); T_PGENPROC if (sv_derived_from($arg, \"Catacomb::MP::Prime::Gen::Proc\")) $var = $arg; @@ -69,32 +66,16 @@ T_NULLPGENPROC OUTPUT T_MP - if ($var) - sv_setref_pv($arg, \"Catacomb::MP\", (void*)$var); - else - $arg = &PL_sv_undef; + ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::\U$1/; $ntt =~ s/_/::/g; \$ntt}\"); T_CATSTRUCT - if ($var) - sv_setref_pv($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\", (void *)$var); - else - $arg = &PL_sv_undef; + ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\"); T_GALG - if ($var) - sv_setref_pv($arg, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\", (void *)$var); - else - $arg = &PL_sv_undef; + ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\"); T_GCALG - if ($var) - sv_setref_pv($arg, \"${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\", (void *)$var); - else - $arg = &PL_sv_undef; + ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\"); T_KEYSZ - if ($var) - sv_setref_pv($arg, \"Catacomb::KeySize\", (void *)$var); - else - $arg = &PL_sv_undef; + ptrtosv(&$arg, (octet *)$var, \"Catacomb::KeySize\"); T_PGENPROC $arg = $var; - T_KEYERR $arg = keyerr($var); diff --git a/utils.c b/utils.c index 1e72294..e23e7ab 100644 --- a/utils.c +++ b/utils.c @@ -1,6 +1,6 @@ /* -*-c-*- * - * $Id: utils.c,v 1.2 2004/04/08 01:36:21 mdw Exp $ + * $Id$ * * Utilities for Catacomb/Perl * @@ -45,4 +45,24 @@ 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)); +} + /*----- That's all, folks -------------------------------------------------*/ -- 2.11.0