From: mdw Date: Wed, 27 Oct 2004 00:00:46 +0000 (+0000) Subject: Various changes. Kinda in the middle of it here, but it seems to work. X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/commitdiff_plain/f9952aec1cf6c64a5681308eea817b6113a37433 Various changes. Kinda in the middle of it here, but it seems to work. --- diff --git a/Catacomb.pm b/Catacomb.pm index 35812e8..fd0e455 100644 --- a/Catacomb.pm +++ b/Catacomb.pm @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: Catacomb.pm,v 1.3 2004/04/18 15:05:08 mdw Exp $ +# $Id$ # # Perl interface to Catacomb crypto library # @@ -58,13 +58,13 @@ use overload '*' => sub { _binop(\&mul, @_); }, '/' => sub { _binop(\&div, @_); }, '%' => sub { _binop(\&mod, @_); }, - '&' => sub { _binop(\&and, @_); }, - '|' => sub { _binop(\&or, @_); }, - '^' => sub { _binop(\&xor, @_); }, + '&' => sub { _binop(\&and2c, @_); }, + '|' => sub { _binop(\&or2c, @_); }, + '^' => sub { _binop(\&xor2c, @_); }, '**' => sub { _binop(\&pow, @_); }, - '>>' => sub { &lsr(@_[0, 1]); }, - '<<' => sub { &lsl(@_[0, 1]); }, - '~' => sub { ¬($_[0]) }, + '>>' => sub { &lsr2c(@_[0, 1]); }, + '<<' => sub { &lsl2c(@_[0, 1]); }, + '~' => sub { ¬2c($_[0]) }, '==' => sub { _binop(\&eq, @_); }, '<=>' => sub { _binop(\&cmp, @_); }, '""' => sub { &tostring($_[0]); }, @@ -112,6 +112,38 @@ sub modinv { return $i; } +#----- Binary polynomials --------------------------------------------------- + +package Catacomb::GF; +use Carp; + +@ISA = qw(Catacomb::MP); + +use overload + '+' => sub { _binop(\&add, @_); }, + '-' => sub { _binop(\&add, @_); }, + '*' => sub { _binop(\&mul, @_); }, + '/' => sub { _binop(\&div, @_); }, + '%' => sub { _binop(\&mod, @_); }, + '&' => sub { _binop(\&Catacomb::MP::and, @_); }, + '|' => sub { _binop(\&Catacomb::MP::or, @_); }, + '^' => sub { _binop(\&Catacomb::MP::xor, @_); }, + '>>' => sub { &Catacomb::MP::lsr(@_[0, 1]); }, + '<<' => sub { &Catacomb::MP::lsl(@_[0, 1]); }, + '~' => sub { &Catacomb::MP::not($_[0]) }, + '==' => sub { _binop(\&Catacomb::MP::eq, @_); }, + '<=>' => sub { _binop(\&Catacomb::MP::cmp, @_); }, + '""' => sub { "0x" . &Catacomb::MP::tostring($_[0], 16); }, + 'neg' => sub { $_[0]; }, + '0+' => sub { &Catacomb::MP::toint($_[0]); }; + +sub mod { (&div($_[0], $_[1]))[1]; } + +sub _binop { + my ($func, $a, $b, $flag) = @_; + return $flag ? &$func($b, $a) : &$func($a, $b); +} + #----- Prime testing -------------------------------------------------------- { diff --git a/catacomb-perl.h b/catacomb-perl.h index a67c616..ec6d8af 100644 --- a/catacomb-perl.h +++ b/catacomb-perl.h @@ -63,6 +63,7 @@ #include #include #include +#include #include #include #include @@ -167,6 +168,12 @@ typedef struct pgen_event MP_Prime_Gen_Event; extern void pgproc_get(SV *sv, pgen_proc **p, void **ctx); +/*----- Other gear --------------------------------------------------------*/ + +extern field *copy_field(field *f); +extern ec_curve *copy_curve(ec_curve *c); +extern group *copy_group(group *g); + /*----- That's all, folks -------------------------------------------------*/ #ifdef __cplusplus diff --git a/ec.xs b/ec.xs index 66314ce..f546ab3 100644 --- a/ec.xs +++ b/ec.xs @@ -76,6 +76,11 @@ z(p) OUTPUT: RETVAL +bool +ec_eq(p, q) + EC_Point *p + EC_Point *q + SV * DESTROY(p) EC_Point *p diff --git a/mp.xs b/mp.xs index 5d78908..28c22f9 100644 --- a/mp.xs +++ b/mp.xs @@ -176,7 +176,7 @@ binop(a, b) XSINTERFACE_FUNC XSINTERFACE_FUNC_SETMP INTERFACE: - add sub mul and or xor + add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor mp * shiftop(a, n) @@ -188,7 +188,29 @@ shiftop(a, n) XSINTERFACE_FUNC XSINTERFACE_FUNC_SETMP INTERFACE: - lsl lsr + lsl lsr lsl2c lsr2c + +bool +testbitop(a, n) + mp *a + unsigned long n + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + testbit testbit2c + +mp * +flipbits(a, n) + mp *a + unsigned long n + C_ARGS: + MP_NEW, a, n + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + setbit clearbit setbit2c clearbit2c int mp_cmp(a, b) diff --git a/mpstuff.c b/mpstuff.c index c891a76..e048ff1 100644 --- a/mpstuff.c +++ b/mpstuff.c @@ -112,8 +112,7 @@ mp *mp_fromsv(SV *sv, const char *what, const char *ty, { mp *m; if (SvROK(sv)) { - if (sv_derived_from(sv, "Catacomb::MP") || - sv_derived_from(sv, "Catacomb::GF")) + if (sv_derived_from(sv, "Catacomb::MP")) m = (mp *)SvIV((SV *)SvRV(sv)); else { va_list ap; @@ -122,6 +121,8 @@ mp *mp_fromsv(SV *sv, const char *what, const char *ty, sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); croak("%s is not of type %s", SvPVX(t), ty); } + if (m && keep) + MP_COPY(m); } else { if (SvIOK(sv)) m = mp_fromiv(MP_NEW, SvIV(sv)); diff --git a/utils.c b/utils.c index e23e7ab..e5b49f0 100644 --- a/utils.c +++ b/utils.c @@ -29,6 +29,9 @@ /*----- Header files ------------------------------------------------------*/ #include "catacomb-perl.h" +#include +#include +#include /*----- Main code ---------------------------------------------------------*/ @@ -65,4 +68,74 @@ void *ptrfromsv(SV *sv, const char *type, const char *what, ...) return (void *)SvIV((SV *)SvRV(sv)); } +/*----- Reconstructing various objects ------------------------------------*/ + +/* --- Somewhat unpleasant, really --- */ + +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); +} + +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); + 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); +} + +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), "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 -------------------------------------------------*/