From: mdw Date: Fri, 19 Nov 2004 21:25:02 +0000 (+0000) Subject: Much wider support for Catacomb in all its glory. X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/commitdiff_plain/fcd15e0b7a3d0f0ca2f30953573f8d1f6b8e8bd2 Much wider support for Catacomb in all its glory. --- diff --git a/Catacomb.pm b/Catacomb.pm index fd0e455..8c2fb73 100644 --- a/Catacomb.pm +++ b/Catacomb.pm @@ -28,222 +28,58 @@ #----- Basic stuff ---------------------------------------------------------- package Catacomb; -use DynaLoader; -use Exporter; -@ISA = qw(DynaLoader Exporter); +use Catacomb::Base; $VERSION = "1.0.0"; -bootstrap Catacomb; - -@EXPORT_OK = qw($random); -%EXPORT_TAGS = ("const" => [qw(GRAND_CRYPTO PGEN_TRY PGEN_FAIL PGEN_PASS - PGEN_DONE PGEN_ABORT PGEN_BEGIN)]); -Exporter::export_ok_tags("const"); - -sub AUTOLOAD { - my $val = const($AUTOLOAD); - *$AUTOLOAD = sub { $val }; - goto &$AUTOLOAD; -} - -#----- Multiprecision arithmetic -------------------------------------------- - -package Catacomb::MP; -use Carp; - -use overload - '+' => sub { _binop(\&add, @_); }, - '-' => sub { _binop(\&sub, @_); }, - '*' => sub { _binop(\&mul, @_); }, - '/' => sub { _binop(\&div, @_); }, - '%' => sub { _binop(\&mod, @_); }, - '&' => sub { _binop(\&and2c, @_); }, - '|' => sub { _binop(\&or2c, @_); }, - '^' => sub { _binop(\&xor2c, @_); }, - '**' => sub { _binop(\&pow, @_); }, - '>>' => sub { &lsr2c(@_[0, 1]); }, - '<<' => sub { &lsl2c(@_[0, 1]); }, - '~' => sub { ¬2c($_[0]) }, - '==' => sub { _binop(\&eq, @_); }, - '<=>' => sub { _binop(\&cmp, @_); }, - '""' => sub { &tostring($_[0]); }, - '0+' => sub { &toint($_[0]); }, - 'sqrt' => sub { &sqrt($_[0]); }, - 'neg' => sub { &neg($_[0]); }; - -sub mod { (&div($_[0], $_[1]))[1]; } - -sub pow { - croak("Usage: Catacomb::MP::pow(a, b)") unless @_ == 2; - my ($a, $b) = @_; - my $r = Catacomb::MP->new(1); - while ($b) { - $r *= $a if $b & 1; - $a = sqr($a); - $b >>= 1; - } - return $r; -} - -sub _binop { - my ($func, $a, $b, $flag) = @_; - return $flag ? &$func($b, $a) : &$func($a, $b); -} - -sub modexp { - croak("Usage: Catacomb::MP::modexp(p, g, x)") unless @_ == 3; - my ($p, $g, $x) = @_; - $g = $p - $g if $g < 0; - $g = $g % $p if $g > $p; - if ($p & 1) { - my $mm = Catacomb::MP::Mont->new($p); - return $mm->exp($g, $x); +BEGIN { @EXPORT_OK = (); } + +use Catacomb::MP; +use Catacomb::GF; +use Catacomb::Field; +use Catacomb::EC; +use Catacomb::Group; +use Catacomb::Rand; +use Catacomb::Crypto; +use Catacomb::Key; + +foreach $_ (qw(Catacomb::MP::mp Catacomb::GF::gf + Catacomb::MP::newprime + Catacomb::MP::mp_loadl Catacomb::MP::mp_loadb + Catacomb::MP::mp_loadl2c Catacomb::MP::mp_loadb2c + Catacomb::MP::mp_fromstring + Catacomb::GF::gf_loadl Catacomb::GF::gf_loadb + Catacomb::GF::gf_fromstring + Catacomb::MP::Prime::primegen + Catacomb::MP::Prime::limleegen + Catacomb::MP::Prime::Filter::filterstepper)) { + my $new; + my $proc; + if (m:^(.*)/(.*)$:) { + $proc = $1; + $new = $2; + } elsif (/:(\w+)$/) { + $new = $1; + $proc = $_; } else { - my $mb = Catacomb::MP::Barrett->new($p); - return $mb->exp($g, $x); - } -} - -sub modinv { - croak("Usage: Catacomb::MP::modinv(p, x)") unless @_ == 2; - my ($g, undef, $i) = gcd($_[0], $_[1]); - croak("Arguments aren't coprime in Catacomb::MP::modinv") unless $g == 1; - 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 -------------------------------------------------------- - -{ - my $cmpg = "Catacomb::MP::Prime::Gen"; - foreach my $i (qw(FilterStepper JumpStepper RabinTester)) { - @{"${cmpg}::${i}::ISA"} = ("${cmpg}::MagicProc"); - } - @{"${cmpg}::MagicProc::ISA"} = ("${cmpg}::Proc"); -} - -#----- Crypto algorithms ---------------------------------------------------- - -package Catacomb; - -foreach my $i (qw(Cipher Hash MAC)) { - my $tag = lc($i); - my @v = (); - my $cl = "Catacomb::${i}Class"; - foreach my $c (&{"${cl}::list"}($cl)) { - my $x = $c->name(); $x =~ tr/a-zA-Z0-9/_/cs; - ${"Catacomb::${i}::${x}"} = undef; # SUYB - ${"Catacomb::${i}::${x}"} = $c; - push(@v, "\$Catacomb::${i}::${x}"); + next; } - $EXPORT_TAGS{$tag} = \@v; - Exporter::export_ok_tags($tag); -} - -package Catacomb::CipherClass; -use Carp; - -sub encrypt { - croak("Usage: Catacomb::CipherClass::encrypt(cc, k, [iv], plain)") - if @_ < 3 || @_ > 4; - my ($cc, $k, $iv, $p) = @_; - if (@_ == 3) { - $p = $iv; - $iv = undef; - } - my $c = $cc->init($k); - $c->setiv($iv) if defined($iv); - return $c->encrypt($p); -} - -sub decrypt { - croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)") - if @_ < 3 || @_ > 4; - my ($cc, $k, $iv, $p) = @_; - if (@_ == 3) { - $p = $iv; - $iv = undef; - } - my $c = $cc->init($k); - $c->setiv($iv) if defined($iv); - return $c->decrypt($p); -} - -package Catacomb::HashClass; -use Carp; - -sub hash { - croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2; - my ($hc, $p) = @_; - my $h = $hc->init(); - $h->hash($p); - return $h->done(); -} - -package Catacomb::MACClass; -use Carp; - -sub mac { - croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3; - my ($mc, $k, $p) = @_; - my $m = $mc->key($k); - return $m->hash($p); -} - -package Catacomb::MAC; -use Carp; - -sub hash { - croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2; - my ($m, $p) = @_; - my $h = $m->init(); - $h->hash($p); - return $h->done(); -} - -#----- Random number generators --------------------------------------------- - -package Catacomb; - -foreach my $i (qw(True Fib LC DSA RC4 SEAL MGF Counter OFB Magic)) { - @{"Catacomb::Rand::${i}::ISA"} = qw(Catacomb::Rand); + *{$new} = \&{$proc}; } -$Catacomb::random = Catacomb::Rand::True->_global(); -$Catacomb::random->noisesrc(); -$Catacomb::random->seed(160); +$rabin_tester = Catacomb::MP::Prime::Rabin->tester(); +$pg_events = Catacomb::MP::Prime::Gen::Proc->ev(); +$pg_evspin = Catacomb::MP::Prime::Gen::Proc->evspin(); +$pg_subev = Catacomb::MP::Prime::Gen::Proc->subev(); + +$EXPORT_TAGS{"const"} = [Catacomb::_constants()]; +$EXPORT_TAGS{"random"} = [qw($random)]; +$EXPORT_TAGS{"mp"} = [qw(mp gf mp_loadb mp_loadl mp_loadb2c mp_loadl2c + mp_fromstring gf_loadb gf_loadl gf_fromstring)]; +$EXPORT_TAGS{"pgen"} = [qw(newprime primegen limleegen + filterstepper $rabin_tester + $pg_events $pg_evspin $pg_subev)]; +Exporter::export_ok_tags(keys %EXPORT_TAGS); #----- That's all, folks ---------------------------------------------------- diff --git a/Catacomb.pod b/Catacomb.pod new file mode 100644 index 0000000..d2b328c --- /dev/null +++ b/Catacomb.pod @@ -0,0 +1,629 @@ +=head1 NAME + +Catacomb - cryptographic library + +=head1 SYNOPSIS + + use Catacomb qw(:const :mp :random :pgen); + + $x = Catacomb::MP->new($str, [$radix]); + $x = Catacomb::MP->new($i); + $x = Catacomb::MP->loadb($bytes); + $x = Catacomb::MP->loadl($bytes); + $x = Catacomb::MP->loadb2c($bytes); + $x = Catacomb::MP->loadl2c($bytes); + ($x, $rest) = Catacomb::MP->fromstring($str, [$radix]); + $x = mp($str, [$radix]); + $x = mp($i); + ($x, $rest) = mp_fromstring($str, [$radix]); + $a = $b + $c; + $a = $b - $c; + $a = $b * $c; + $a = $b / $c; + $a = $b % $c; + $a = $b ** $n; + $a = $b << $n; + $a = $b >> $n; + $a = $b & $c; + $a = $b | $c; + $a = $b ^ $c; + $a = ~$b; + $p = $b == $c; + $p = $b != $c; + $p = $b < $c; + $p = $b > $c; + $p = $b <= $c; + $p = $b >= $c; + $a = sqrt($b); + $a = -$b; + $a = $b->add($c); + $a = $b->sub($c); + $a = $b->mul($c); + ($q, $r) = $a->div($b); + $a = $b->exp($c); + $a = $b->sqr(); + $a = $b->sqrt(); + $a = $b->neg(); + $a = $b->not(); + $a = $b->not2c(); + $a = $b->mod($c); + $p = $b->eq($c); + $cmp = $b->cmp($c); + $a = $b->and($c); + $a = $b->and2c($c); + $a = $b->or($c); + $a = $b->or2c($c); + $a = $b->xor($c); + $a = $b->xor2c($c); + $a = $b->nand($c); + $a = $b->nand2c($c); + $a = $b->nor($c); + $a = $b->nor2c($c); + $a = $b->not(); + $a = $b->not2c(); + $a = $b->lsl($n); + $a = $b->lsl2c($n); + $a = $b->lsr($n); + $a = $b->lsr2c($n); + $a = $b->setbit($n); + $a = $b->setbit2c($n); + $a = $b->clearbit($n); + $a = $b->clearbit2c($n); + $p = $b->testbit($n); + $p = $b->testbit2c($n); + $x = $y->copy(); # largely useless + $g = $a->gcd($b); + ($g, $u, $v) = $a->gcd($b); + ($s, $t) = $m->odd(); # m = 2^s t + $a = $p->modexp($x, $e); + $a = $p->modinv($b); + $r = $p->modsqrt($x); + $q = $n->jac($a); + $p = $x->primep([$rng]); + $nbits = $x->bits(); + $nbytes = $x->octets(); + $bytes = $x->storeb([$nbytes]); + $bytes = $x->storel([$nbytes]); + $bytes = $x->storeb2c([$nbytes]); + $bytes = $x->storel2c([$nbytes]); + $str = $x->tostring([$radix]); + $n = $x->toint(); + + $barrett = Catacomb::MP::Barrett->new($p); + $barrett = $p->barrett(); + $p = $barrett->m(); + $x = $barrett->reduce($y); + $a = $barrett->exp($x, $y); + + $mont = Catacomb::MP::Mont->new($p); + $mont = $p->mont(); + $r = $mont->r(); + $r2 = $mont->r2(); + $p = $mont->m(); + $x = $mont->in($y); + $a = $mont->mul($x, $y); + $a = $mont->expr($x, $y); + $a = $mont->mexpr($x0, $e0, $x1, $e1, ...); + $x = $mont->reduce($y); + $x = $mont->out($y); + $a = $mont->exp($x, $y); + $a = $mont->mexp($x0, $e0, $x1, $e1, ...); + + $reduce = Catacomb::MP::Reduce->new($p); + $reduce = $p->mkreduce(); + $p = $reduce->m(); + $x = $reduce->reduce($y); + $a = $barrett->exp($x, $y); + + $crt = Catacomb::MP::CRT->new(@n); + $n = $crt->product(); + @n = $crt->moduli(); + $x = $crt->solve(@r); + + $p = newprime($nbits, [$rng]); + + $filt = Catacomb::MP::Prime::Filter->new($x); + $filt = $x->filter(); + $rc = $filt->status(); + $x = $filt->m(); + $rc = $filt->step($n); + $rc = $filt->jump($jfilt); + $newfilt = $filt->muladd($mul, $add); # integers + + $stepper = Catacomb::MP::Prime::Filter->stepper($step); # integer + $stepper = filterstepper($step); + $jumper = Catacomb::MP::Prime::Filter->stepper($jump); # MP + $jumper = filterjumper($jump); + + $rabin = Catacomb::MP::Prime::Rabin->new($m); + $rabin = $p->rabin(); + $m = $rabin->m(); + $rc = $rabin->test($wit); + $n = $rabin->iters(); + $n = Catacomb::MP::Prime::Rabin->ntests($bits); + $tester = Catacomb::MP::Prime::Rabin->tester(); + $tester = $rabintester; + + $events = Catacomb::MP::Prime::Gen::Proc->ev(); + $events = Catacomb::MP::Prime::Gen::Proc->evspin(); + $events = Catacomb::MP::Prime::Gen::Proc->subev(); + + $p = Catacomb::MP::Prime->gen + ($name, $x, $nsteps, $stepper, $ntests, $tester, [$events]); + $p = primegen + ($name, $x, $nsteps, $stepper, $ntests, $tester, [$events]); + if (($x, $j) = Catacomb::MP::Prime->strongprime_setup + ($name, $nbits, [$rng], [$nsteps], [$subevents])) { + $p = Catacomb::MP::Prime->gen + ($name, $x, $nsteps, $j, $ntests, $tester, [$events]); + } + ($p, @f) = Catacomb::MP::Prime->limlee + ($name, $qbits, $pbits, [$rng], [$on], [$oev], [$iev]); + ($p, @f) = limleegen + ($name, $qbits, $pbits, [$rng], [$on], [$oev], [$iev]); + + package MyPrimeGenObject; + sub new { ... }; + sub BEGIN { ... }; + sub TRY { ... }; + sub FAIL { ... }; + sub PASS { ... }; + sub DONE { ... }; + sub ABORT { ... }; + $name = $ev->name(); + $x = $ev->m([$xx]); + $rng = $ev->rand(); + + $a = Catacomb::GF->new($x); + $a = Catacomb::GF->loadb($bytes); + $a = Catacomb::GF->loadl($bytes); + ($x, $rest) = Catacomb::GF->fromstring($str, [$radix]); + $a = gf($mp); + $a = gf($str); + $a = gf($i); + $a = gf_loadb($bytes); + $a = gf_loadl($bytes); + ($x, $rest) = gf_fromstring($str, [$radix]); + $x = mp($a); + $a = $b + $c; + $a = $b - $c; # same as + + $a = $b * $c; + $a = $b / $c; + $a = $b % $c; + $a = $b << $n; + $a = $b >> $n; + $a = $b & $c; + $a = $b | $c; + $a = $b ^ $c; + $a = ~$b; + $p = $b == $c; + $p = $b != $c; + $a = -$b; # does nothing + $a = $b->copy(); # largely pointless + $a = $b->add($c); + $a = $b->sub($c); + $a = $b->mul($c); + $a = $b->sqr(); + ($q, $r) = $a->div($b); + $a = $b->lsl($n); + $a = $b->lsr($n); + $a = $b->and($c); + $a = $b->or($c); + $a = $b->xor($c); + $a = $b->nand($c); + $a = $b->nor($c); + $a = $b->setbit($n); + $a = $b->clearbit($n); + $g = $a->gcd($b); + ($g, $u, $v) = $a->gcd($b); + $p = $p->irreduciblep(); + $a = $b->modinv($c); + $a = $b->modexp($c, $n); + # and all the Catacomb::MP methods + + $F = Catacomb::Field->prime($p); + $F = Catacomb::Field->niceprime($p); + $F = Catacomb::Field->binpoly($p); + $F = Catacomb::Field->binnorm($p, $beta); + $F = Catacomb::Field->byname($name); + $F = $p->primefield(); + $F = $p->niceprimefield(); + $F = $p->binpolyfield(); + $F = $p>binnormfield($beta); + $name = $F->name(); + $ty = $F->type(); + $info = $F->get(); + $p = $F->samep($FF); + $q = $F->q(); + $m = $F->m(); + $nbits = $F->nbits(); + $nbytes = $F-noctets(); + $xi = $F->in($x); + $x = $F->out($xi); + $p = $F->zerop($xi); + $xi = $F->neg($yi); + $xi = $F->add($yi, $zi); + $xi = $F->sub($yi, $zi); + $xi = $F->mul($yi, $zi); + $xi = $F->div($yi, $zi); + $xi = $F->sqr($yi, $zi); + $xi = $F->inv($yi); + $xi = $F->reduce($yi); + $xi = $F->sqrt($yi); + $xi = $F->quadsolve($yi); + $xi = $F->dbl($yi); + $xi = $F->tpl($yi); + $xi = $F->hlv($yi); + + $e = Catacomb::Field::Elt->new($F, $x); + $e = $F->elt($x); + $e = $F->zero(); + $e = $F->one(); + $e = $F->rand([$rng]); + $F = $e->field(); + $x = $e->value(); + $str = $e->tostring([$radix]); + $e = $f->inv(); + $e = $f + $g; + $e = $f - $g; + $e = $f * $g; + $e = $f / $g; + $e = $f ** $n; + $p = $f == $g; + $p = $f != $g; + $e = -$f; + $e = sqrt($f); + $p = $f->zerop(); + + $P = Catacomb::EC::Point->new([$x], [$y], [$z]); + ($P, $rest) = Catacomb::EC::Point->get($buf); + $p = $P->atinfp(); + $x = $P->x(); + $y = $P->y(); + $z = $P->z(); + $p = $P->eq($Q); + $buf = $P->put(); + $str = $P->tostring(); + + $C = Catacomb::EC::Curve->prime($F, $a, $b); + $C = Catacomb::EC::Curve->primeproj($F, $a, $b); + $C = Catacomb::EC::Curve->bin($F, $a, $b); + $C = Catacomb::EC::Curve->binproj($F, $a, $b); + ($C, $G, $r, $h) = Catacomb::EC::Curve->getinfo($name); + $C = $F->primecurve($F, $a, $b); + $C = $F->primeprojcurve($F, $a, $b); + $C = $F->bincurve($F, $a, $b); + $C = $F->binprojcurve($F, $a, $b); + $name = $C->name(); + $a = $C->a(); + $b = $C->b(); + $F = $C->field(); + $info = $C->get(); + $p = $C->samep($CC); + $bytes = $C->putraw($P); + ($pp, $rest) = $C->getraw($bytes); + $buf = $C->putraw($P); + ($P, $rest) = $C->getraw($buf); + $P = $C->neg($Q); + $P = $C->add($Q, $R); + $P = $C->dbl($Q); + $p = $C->check($P); + $P = $C->mul($Q, $n); + $P = $C->mmul($P0, $n0, $P1, $n1, ...); + $err = $C->checkinfo($G, $r, $h); + $Pi = $C->in($P); + $Pi = $C->fix($Pi); + $Pi = $C->ifind($xi); + $Pi = $C->ineg($Qi); + $Pi = $C->iadd($Qi, $Ri); + $Pi = $C->isub($Qi, $Ri); + $Pi = $C->idbl($Qi); + $p = $C->icheck($Pi); + $Pi = $C->imul($Qi, $n); + $Pi = $C->immul($Qi0, $n0, $Qi1, $n1, ...); + $P = $C->out($Pi); + + $P = Catacomb::EC::Point->new($C, [$p]); + $P = Catacomb::EC::Point->new($C, $x, $y); + $P = $C->inf(); + $P = $C->pt($p); + $P = $C->pt($x, $y); + $P = $C->find($x); + $P = $C->rand([$rng]); + $C = $P->curve(); + $F = $P->field(); + $P = $Q->point(); + $p = $P->atinfp(); + $x = $P->x(); + $y = $P->y(); + $p = $P->check(); + $P = $Q->mul($n); + $P = $Q + $R; + $P = $Q - $R; + $P = $Q * $n; + $P = $n * $Q; + $p = $Q == $R; + $p = $Q != $R; + $P = -$Q; + + $G = Catacomb::Group->prime($p, $g, $q); + $G = Catacomb::Group->binary($p, $g, $q); + $G = Catacomb::Group->ec($C, $G, $r, $h); + $G = Catacomb::Group->byname($name); + $G = $p->primegroup($g, $q); + $G = $p->binpolygroup($g, $q); + $G = $C->ecgroup($G, $r, $h); + $info = $G->get(); + $a = $G->mexp($a0, $n0, $a1, $n1, ...); + $p = $G->samep($GG); + $r = $G->r(); + $h = $G->h(); + ($p, $err) = $G->check($rng); + + $a = Catacomb::Group::Elt($G, [$x]); + $a = $G->elt([$x]); + $a = $G->id(); + $g = $G->g(); + $a = $G->fromint($x); + $a = $G->fromec($P); + ($a, $rest) = $G->frombuf($buf); + ($a, $rest) = $G->fromraw($buf); + ($a, $rest) = $G->fromstring($str); + $x = $a->toint(); + $P = $a->toec(); + $buf = $a->tobuf(); + $buf = $a->toraw(); + $str = $a->tostring(); + $G = $a->group(); + $p = $a->identp(); + $p = $a->check(); + $a = $b->exp($n); + $a = $b->inv(); + $a = $b * $c; + $a = $b / $c; + $a = $b ** $n; + $p = $b == $c; + $p = $b != $c; + + $pc = Catacomb::PRPClass->find($name); + $pc = $Catacomb::rijndael; + $ksz = $pc->keysz(); + $name = $pc->name(); + $blksz = $pc->blksz(); + $ct = $pc->eblk($k, $pt); + $pt = $pc->eblk($k, $ct); + $P = $pc->init($k); + $ct = $P->eblk($pt); + $pt = $P->dblk($ct); + $pc = $P->class(); + + $cc = Catacomb::CipherClass->find($name); + $cc = $Catacomb::rijndael_cbc; + $ksz = $cc->keysz(); + $name = $cc->name(); + $blksz = $cc->blksz(); + $ct = $cc->encrypt($k, $pt, [$iv]); + $pt = $cc->decrypt($k, $ct, [$iv]); + $c = $cc->init(); + $ct = $c->encrypt($pt); + $pt = $c->decrypt($ct); + $c->setiv($iv); + $c->bdry(); + $pc = $c->class(); + + $hc = Catacomb::HashClass->find($name); + $hc = $Catacomb::sha; + $hsz = $hc->hashsz(); + $name = $hc->name(); + $res = $hc->hash($msg); + $h = $hc->init(); + $h->hash($buf); # as often as necessary + $hh = $h->copy(); + $hc = $h->class(); + $res = $h->done(); + + $mc = Catacomb::MACClass->find($name); + $mc = $Catacomb::sha_hmac; + $hsz = $mc->hashsz(); + $ksz = $mc->keysz(); + $name = $mc->name(); + $t = $mc->mac($k, $msg); + $m = $mc->key($k); + $mc = $m->class(); + $t = $m->hash($msg); + $h = $m->init(); + + $rng = Catacomb::Rand::True->new(); + $rng = Catacomb::random; + $rng->gate(); + $rng->stretch(); + $rng->key($k); + $rng->noisesrc(); + $rng->seed([$nbits]); + + $rng = Catacomb::Rand::DSA->new($k); + $rng->passes($n); + $k = $rng->seed(); + + $rng = Catacomb::Rand::Fib->new($seed); + $rng = Catacomb::Rand::LC->new($seed); + $rng = Catacomb::Rand::RC4->new($k); + $rng = Catacomb::Rand::SEAL->new($k); + $rng = Catacomb::Rand::MGF->new($name, $k); + $rng = Catacomb::Rand::Counter->new($name, $k); + $rng = Catacomb::Rand::OFB->new($name, $k); + + $rng->seedint($i); + $rng->seedblock($buf); + $rng->seedmp($x); + $rng->seedrand($rng2); + $u = $rng->raw(); + $u = $rng->word(); + $b = $rng->byte(); + $c = $rng->char(); + $u = $rng->range($max); + $x = $rng->mp($nbits, [$or]); + $x = $rng->mprange($max); + $buf = $rng->fill($nbytes); + $name = $rng->name(); + $f = $rng->flags(); + $u = $rng->max(); + + ($p, $g, $q) = Catacomb::PubKey->gen_dh + ($ql, $pl, [$steps], [$r], [$events]); + ($p, $g, $q, @f) = Catacomb::PubKey->gen_limlee + ($ql, $pl, [$flags], [$steps], [$r], [$oevents], [$ievents]); + ($p, $g, $q, $seed, $count) = Catacomb::PubKey->gen_dsa + ($ql, $pl, [$steps], [$k], [$events]); + + $dsapub = Catacomb::DSA::Public->new([$G, $p, $hunoz, $h, $rng]); + $dsapub = Catacomb::DSA::Public->new + ({ G => $G, p => $p, h => $h, rng => $rng}); + $h = $dsapub->beginhash(); + $dsapub->endhash($h); + $p = $dsapub->verify($msg, $r, $s); + + $dsapriv = Catacomb::DSA::Private->new([$G, $p, $u, $h, $rng]); + ($r, $s) = $dsapriv->sign($msg, [$k]); + + $kcdsapub = Catacomb::KCDSA::Public->new([$G, $p, $hunoz, $h, $rng]); + $h = $kcdsapub->beginhash(); + $kcdsapub->endhash($h); + $p = $kcdsapub->verify($msg, $r, $s); + + $kcdsapriv = Catacomb::KCDSA::Private->new([$G, $p, $u, $h, $rng]); + ($r, $s) = $kcdsapriv->sign($msg, [$k]); + + $p1pad = Catacomb::RSA::PKCS1Crypt->new([$ep, $rng]); + $p1pad = Catacomb::RSA::PKCS1Sign->new([$ep, $rng]); + $oaeppad = Catacomb::RSA::OAEP->new([$c, $h, $ep, $rng]); + $psspad = Catacomb::RSA::PSS->new([$c, $h, $ssz, $rng]); + $x = $pad->pad($m, $sz, $nbits); + $m = $cryptpad->unpad($m, $sz, $nbits); + $m = $sigpad->unpad($s, $m, $sz, $nbits); + + $rsapub = Catacomb::RSA::Public->new([$n, $e]); + $rsapub = Catacomb::RSA::Public->new({ n => $n, e => $e }); + $n = $rsapub->n(); + $h = $rsapub->extract(); + $x = $rsapub->op($y); + $c = $rsapub->encrypt($cryptpad, $m); + $rc = $rsapub->verify($signpad, $s, [$m]); + + $rsapriv = Catacomb::RSA::Private->new + ([$n, $e, $d, $p, $q, $dp, $dq, $qi]); + $rsapriv = Catacomb::RSA::Public->new + ({ n => $n, e => $e, d => $d, + p => $p, q => $q, dp => $dp, dq => $dq, qi => $qi }); + $rsapriv = Catacomb::RSA::Private->generate + ($nbits, [$rng], [$steps], [$events]); + $n = $rsapriv->n(); + $h = $rsapriv->extract(); + $x = $rsapriv->op($y, [$rng]); + $m = $rsapriv->decrypt($cryptpad, $c, [$rng]); + $s = $rsapriv->sign($signpad, $m, [$rng]); + + $s = Catacomb::Share::GF->new($t, $sz); + $sz = $s->sz(); + $t = $s->t(); + $i = $s->i(); + $s->mkshares($secret, [$rng]); + $share = $s->get($i); + $left = $s->add($i, $share); + $secret = $s->combine(); + + $s = Catacomb::Share::Prime->new($t, [$p]); + $p = $s->p(); + $t = $s->t(); + $i = $s->i(); + $s->mkshares($secret, [$rng]); + $share = $s->get($i); + $left = $s->add($i, $share); + $secret = $s->combine(); + + $pp = Catacomb::Passphrase->read($tag, [$len]); + $pp = Catacomb::Passphrase->verify($tag, [$len]); + Catacomb::Passphrase->cancel($tag); + + $ssz = $ksz->keysz($sz); + @ksz = $ksz->expand(); + + $kf = Catacomb::Key::File->new($name, [$kopen], [$reporter]); + $p = $kf->merge($name, $fh, [$reporter]); + $p = $kf->extract($key, $fh, [$kfilt]); + $kwriteerr = $kf->save(); + $i = $kf->iterate(); + $key = $i->next(); + + $key = $kf->bytype($kf, $type); + $key = $kf->byid($kf, $id); + $key = $kf->bytag($kf, $tag); + $key = $kf->newkey($kf, $id, $type, $exp); + ($key, $kd, $ftag) = $kf->qtag($qtag); + $p = $key->chkident($id); + $p = $key->chkcomment($id); + $exp = $key->exp(); + $exp = $key->del(); + $comm = $key->comment(); + $id = $key->id(); + $tag = $key->tag(); + $type = $key->type(); + $p = $key->setcomment($comm); + $p = $key->settag($tag); + $p = $key->delete(); + $ftag = $key->fulltag(); + $v = $key->getattr($a); + $p = $key->putattr($a, $v); + $p = $key->expiredp(); + $p = $key->used(); + $p = $key->fingerprint($h, [$kfilt]); + $Catacomb::Key::error; + $str = Catacomb::Key->strerror($errnum); + $ah = $key->attrs(); # returns hashref + $i = $key->attriter(); + ($a, $v) = $i->next(); + + $kfilt = Catacomb::Key::Filter->new($f, $m); + $kfilt = Catacomb::Key::Filter->new($fstr); + $fstr = $kfilt->tostring(); + $f = $kfilt->f(); + $m = $kfilt->m(); + + $kd = Catacomb::Key::Data->new(); + ($kd, $rest) = Catacomb::Key::Data->read($str); + $kd = Catacomb::Key::Data->decode($buf); + $kd = $key->data(); + $kd->setbinary($bin); + $kd->setencrypted($crypted); + $kd->setmp($x); + $kd->setstring($str); + $kd->setec($P); + $f = $kd->flags(); + $bin = $kd->getbinary(); + $crypted = $kd->getcrypted(); + $x = $kd->getmp(); + $str = $kd->getstring(); + $P = $kd->getec(); + $kd->setstruct(); + $kkd = $kd->structfind($t); + $kkd = $kd->structcreate($t); + $kd->structdel($t); + $kh = $kd->structopen(); # returns hashref + $kkd = $kd->copy(); + $kkd = $kd->lock($k); + $kkd = $kd->unlock($k); + $kkd = $kd->plock($tag); + $kkd = $kd->punlock($tag); + $str = $kd->write(); + $buf = $kd->encode(); + $i = $kd->structiter(); + +=head1 DESCRIPTION + +=head1 SEE ALSO + +Catacomb(3). + +=head1 AUTHOR + +Mark Wooding, diff --git a/Catacomb/Base.pm b/Catacomb/Base.pm new file mode 100644 index 0000000..5855f87 --- /dev/null +++ b/Catacomb/Base.pm @@ -0,0 +1,43 @@ +# -*-perl-*- +# +# $Id$ +# +# Basic support stuff +# +# (c) 2004 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. + +package Catacomb; +use DynaLoader; +use Exporter; +@ISA = qw(DynaLoader Exporter); + +sub AUTOLOAD { + my $val = _const($AUTOLOAD); + *$AUTOLOAD = sub { $val }; + goto &$AUTOLOAD; +} + +bootstrap Catacomb; + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Catacomb/Cache.pm b/Catacomb/Cache.pm new file mode 100644 index 0000000..6b42c4e --- /dev/null +++ b/Catacomb/Cache.pm @@ -0,0 +1,72 @@ +# -*-perl-*- +# +# $Id$ +# +# Caching for fields, curves, groups, ... +# +# (c) 2004 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. + +package Catacomb::Cache::Ref; + +sub new { + my ($me, $c) = @_; + $c->[0]++; + return bless [$c], $me; +} + +sub DESTROY { + my ($me) = @_; + my $c = $me->[0]; + if ($c->[0] > 1) { $c->[0]--; return; } + delete $c->[1]{$c->[2]}; +} + +package Catacomb::Cache; + +$debug = 1; + +sub stringify { + my ($x) = @_; + if (ref($x) eq ARRAY) { + return "[" . join("/", map(stringify($_), @$x)) . "]"; + } else { + return $x; + } +} + +sub new { my ($me) = @_; return bless { }, $me; } + +sub intern { + my ($c, $x) = @_; + my $k = stringify($x->get()); + my $e; + if (exists($c->{$k})) { + $e = $c->{$k}; + } else { + $e = $c->{$k} = [0, $c, $k, $x]; + } + return $e->[3], Catacomb::Cache::Ref->new($e); +} + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Catacomb/Crypto.pm b/Catacomb/Crypto.pm new file mode 100644 index 0000000..c4e886d --- /dev/null +++ b/Catacomb/Crypto.pm @@ -0,0 +1,213 @@ +# -*-perl-*- +# +# $Id$ +# +# Cryptographic algorithms +# +# (c) 2004 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. + +#----- Symmetric crypto algorithms ----------------------------------------- + +package Catacomb; +use Catacomb::Base; +use Exporter; + +foreach my $i (qw(PRP Cipher Hash MAC)) { + my $tag = lc($i); + my @v = (); + my $cl = "Catacomb::${i}Class"; + foreach my $c (Catacomb::list($tag)) { + (my $x = $c) =~ tr/a-zA-Z0-9/_/cs; + $$x = undef; # SUYB + $$x = $cl->find($c); + push(@v, "\$$x"); + } + $EXPORT_TAGS{$tag} = \@v; + Exporter::export_ok_tags($tag); +} + +package Catacomb::PRPClass; +use Carp; + +sub eblk { + croak("Usage: Catacomb::PRPClass::eblk(pc, k, pt)") unless @_ == 3; + my ($pc, $k, $pt) = @_; + my $P = $pc->init($k); + return $P->eblk($pt); +} + +sub dblk { + croak("Usage: Catacomb::PRPClass::dblk(pc, k, ct)") unless @_ == 3; + my ($pc, $k, $pt) = @_; + my $P = $pc->init($k); + return $P->dblk($ct); +} + +package Catacomb::CipherClass; +use Carp; + +sub encrypt { + croak("Usage: Catacomb::CipherClass::encrypt(cc, k, [iv], plain)") + if @_ < 3 || @_ > 4; + my ($cc, $k, $iv, $p) = @_; + if (@_ == 3) { + $p = $iv; + $iv = undef; + } + my $c = $cc->init($k); + $c->setiv($iv) if defined($iv); + return $c->encrypt($p); +} + +sub decrypt { + croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)") + if @_ < 3 || @_ > 4; + my ($cc, $k, $iv, $p) = @_; + if (@_ == 3) { + $p = $iv; + $iv = undef; + } + my $c = $cc->init($k); + $c->setiv($iv) if defined($iv); + return $c->decrypt($p); +} + +package Catacomb::HashClass; +use Carp; + +sub hash { + croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2; + my ($hc, $p) = @_; + my $h = $hc->init(); + $h->hash($p); + return $h->done(); +} + +package Catacomb::MACClass; +use Carp; + +sub mac { + croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3; + my ($mc, $k, $p) = @_; + my $m = $mc->key($k); + return $m->hash($p); +} + +package Catacomb::MAC; +use Carp; + +sub hash { + croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2; + my ($m, $p) = @_; + my $h = $m->init(); + $h->hash($p); + return $h->done(); +} + +#----- DSA and KCDSA signing ------------------------------------------------ + +package Catacomb::DSA; +use Carp; +sub new { + croak("Usage: ${me}::new(me, info)") unless @_ == 2; + my ($me, $info) = @_; + return bless $info, $me; +} + +*Catacomb::KCDSA::new = \&new; + +foreach my $i (qw(DSA KCDSA)) { + @{"Catacomb::${i}::Public::ISA"} = ("Catacomb::${i}"); + @{"Catacomb::${i}::Private::ISA"} = ("Catacomb::${i}::Public"); +} + +#----- RSA signing and encryption ------------------------------------------- + +package Catacomb::RSA::Pad; +use Carp; + +sub new { + croak("Usage: ${me}::new(me, info)") unless @_ == 2; + my ($me, $info) = @_; + return bless $info, $me; +} + +foreach my $i (qw(PKCS1Crypt PKCS1Sign OAEP PSS)) { + @{"Catacomb::RSA::${i}::ISA"} = qw(Catacomb::RSA::Pad); +} + +package Catacomb::RSA::Public; +use Carp; +use Catacomb::Base; +use Catacomb::MP; + +sub encrypt { + croak("Usage: Catacomb::RSA::Public::encrypt(pub, pad, msg)") + unless @_ == 3; + my ($pub, $pad, $msg) = @_; + my $n = $pub->n(); + my $r = $pad->pad($msg, $n->octets(), $n->bits()); + return undef unless defined($r); + return $pub->op($r); +} + +sub verify { + croak("Usage: Catacomb::RSA::Public::verify(pub, pad, sig, [msg])") + unless @_ >= 3 && @_ <= 4; + my ($pub, $pad, $sig, $msg) = @_; + my $n = $pub->n(); + my $rc = $pad->unpad($pub->op($sig), $msg, $n->octets(), $n->bits()); + return undef unless defined($rc); + if (defined($msg)) { + return undef unless $rc eq "" || $rc eq $msg; + return 1; + } else { + return $rc; + } +} + +package Catacomb::RSA::Private; +use Carp; +use Catacomb::Base; +use Catacomb::MP; + +sub sign { + croak("Usage: Catacomb::RSA::Private::sign(priv, pad, msg, [rng]") + unless @_ >= 3 && @_ <= 4; + my ($priv, $pad, $msg, $rng) = @_; + my $n = $priv->n(); + my $r = $pad->pad($msg, $n->octets(), $n->bits()); + return undef unless defined($r); + return $priv->op($r, $rng); +} + +sub decrypt { + croak("Usage: Catacomb::RSA::Private::decrypt(priv, pad, ct, [rng]") + unless @_ >= 3 && @_ <= 4; + my ($priv, $pad, $ct, $rng) = @_; + my $n = $priv->n(); + return $pad->unpad($priv->op($ct, $rng), $n->octets(), $n->bits()); +} + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Catacomb/EC.pm b/Catacomb/EC.pm new file mode 100644 index 0000000..d5aacca --- /dev/null +++ b/Catacomb/EC.pm @@ -0,0 +1,295 @@ +# -*-perl-*- +# +# $Id$ +# +# Elliptic curves +# +# (c) 2004 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. + +#----- Elliptic curves ------------------------------------------------------ + +package Catacomb::EC::Curve; +use Carp; +use Catacomb::Base; +use Catacomb::Cache; +use Catacomb::Field; + +$cache = Catacomb::Cache->new(); + +sub intern { + croak("Usage: Catacomb::EC::Curve::intern(c)") unless @_ == 1; + my ($c) = @_; + return $cache->intern($c); +} + +sub pt { + croak("Usage: Catacomb::EC::Curve::pt(c, [x, y | p])") + unless @_ >= 1 && @_ <= 3; + return Catacomb::EC::Pt->new(@_); +} + +sub a { + croak("Usage: Catacomb::EC::Curve::a(c)") unless @_ == 1; + my ($c) = @_; + return $c->field()->elt($c->_a()); +} + +sub b { + croak("Usage: Catacomb::EC::Curve::b(c)") unless @_ == 1; + my ($c) = @_; + return $c->field()->elt($c->_b()); +} + +sub inf { + croak("Usage: Catacomb::EC::Curve::inf(c)") unless @_ == 1; + return Catacomb::EC::Pt->new($_[0]); +} + +sub getraw { + croak("Usage: Catacomb::EC::Curve::getraw(c, s)") unless @_ == 2; + my ($c, $s) = @_; + my ($p, $rest) = $c->_getraw($s); + $p = Catacomb::EC::Pt->new($c, $p); + return !wantarray() ? $p : ($p, $rest); +} + +sub find { + croak("Usage: Catacomb::EC::Curve::find(c, x)") unless @_ == 2; + my ($c, $x) = @_; + my $p = $c->_find($x); + return undef unless defined $p; + return Catacomb::EC::Pt->new($c, $p); +} + +sub rand { + croak("Usage: Catacomb::EC::Curve::rand(c, [rng])") + unless @_ >= 1 && @_ <= 2; + my ($c, $rng) = @_; + $rng ||= $Catacomb::random; + my $p = $c->_rand($rng); + return Catacomb::EC::Pt->new($c, $p); +} + +sub mmul { + croak("Usage: Catacomb::EC::Curve::mmul(c, p_0, x_0, p_1, x_1, ...)") + unless @_ >= 3 && @_ % 2 == 1; + my $c = pop(@_); + my $i; + my @v = (); + my @r = (); + for ($i = 0; $i < @_; $i += 2) { + my $p = $_[$i]; + my $n = $_[$i + 1]; + if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) { + $p->[1] == $c or croak("curve mismatch"); + @r or @r = @$p[1, 2, 3, 4]; + $p = $p->[0]; + } elsif (UNIVERSAL::isa($p, Catacomb::EC::Point)) { + $p = $c->in($p); + } else { + croak("not a curve point"); + } + push(@v, $p, $n); + } + unless (@r) { + my ($cr, $f, $fr); + ($c, $cr) = $c->intern(); + ($f, $fr) = $c->field()->intern(); + @r = ($c, $cr, $f, $fr); + } + return Catacomb::EC::Pt::_pt(immul($c, @v), $c, $cr, $f, $fr); +} + +sub getinfo { + croak("Usage: Catacomb::EC::Curve::getinfo(me, spec)") unless @_ == 2; + my ($me, $spec) = @_; + my ($c, $p, $r, $h) = _getinfo($me, $spec); + my $cr; + ($c, $cr) = $c->intern(); + return $c, $c->pt($p), $r, $h; +} + +sub ecgroup { + croak("Usage: Catacomb::EC::Curve::ecgroup(c, p, r, h)") unless @_ == 4; + return Catacomb::Group->ec(@_); +} + +#----- Elliptic curve points ------------------------------------------------ + +package Catacomb::EC::Point; + +sub tostring { + croak("Usage: Catacomb::EC::Point::tostring(p)") unless @_ == 1; + my ($p) = @_; + if ($p->atinfp()) { + return "inf"; + } else { + return "0x" . $p->x()->tostring(16) . ", 0x" . $p->y()->tostring(16); + } +} + +package Catacomb::EC::Pt; +use Carp; +use Catacomb::Base; +use Catacomb::Field; + +sub _pt { bless [@_], Catacomb::EC::Pt; } + +sub _convert { + my ($c, $cr, $f, $fr, $x) = @_; + if (UNIVERSAL::isa($x, Catacomb::EC::Pt)) { + croak("curve mismatch") unless $c == $x->[1]; + return $x; + } + if (UNIVERSAL::isa($x, Catacomb::EC::Point)) { + return _pt($x, $c, $cr, $f, $fr); + } + croak("can't convert to curve point"); +} + +sub new { + croak("Usage: Catacomb::EC::Pt::new(me, c, [x, y | p])") + unless @_ >= 2 && @_ <= 4; + my ($me, $c, $p); + if (@_ == 2) { + ($me, $c) = @_; + $p = Catacomb::EC::Point->new(); + } elsif (@_ == 3) { + ($me, $c, $p) = @_; + if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) { + $p = $p->point(); + } elsif (!UNIVERSAL::isa($p, Catacomb::EC::Point)) { + croak("not a curve point"); + } + } else { + my ($x, $y); + ($me, $c, $x, $y) = @_; + $p = Catacomb::EC::Point->new($x, $y); + } + my ($cr, $f, $fr); + ($c, $cr) = $c->intern(); + ($f, $fr) = $c->field()->intern(); + return _pt($c->in($p), $c, $cr, $f, $fr); +} + +sub point { + croak("Usage: Catacomb::EC::Pt::point(p)") unless @_ == 1; + return $_[0][1]->out($_[0][0]); +} + +sub curve { + croak("Usage: Catacomb::EC::Pt::curve(p)") unless @_ == 1; + return $_[0][1]; +} + +sub field { + croak("Usage: Catacomb::EC::Pt::field(p)") unless @_ == 1; + return $_[0][3]; +} + +sub atinfp { + croak("Usage: Catacomb::EC::Pt::atinfp(p)") unless @_ == 1; + return $_[0]->point()->atinfp(); +} + +sub x { + croak("Usage: Catacomb::EC::Pt::x(p)") unless @_ == 1; + return $_[0][3]->elt($_[0]->point()->x()); +} + +sub y { + croak("Usage: Catacomb::EC::Pt::y(p)") unless @_ == 1; + return $_[0][3]->elt($_[0]->point()->y()); +} + +sub check { + croak("Usage: Catacomb::EC::Curve::check(c)") unless @_ == 1; + return $_[0][1]->check($_[0][0]); +} + +sub pt { + croak("Usage: Catacomb::EC::Pt::pt(pp, [x, y | p])") + unless @_ >= 1 && @_ <= 3; + my ($pp, $p); + if (@_ == 1) { + ($pp) = @_; + $p = Catacomb::EC::Point->new(); + } elsif (@_ == 2) { + ($pp, $p) = @_; + if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) { + $p = $p->point(); + } elsif (!UNIVERSAL::isa($p, Catacomb::EC::Point)) { + croak("not a curve point"); + } + } else { + my ($x, $y); + ($pp, $x, $y) = @_; + $p = Catacomb::EC::Point->new($x, $y); + } + my (undef, $c, $cr, $f, $fr) = @$pp; + return _pt($c->in($p), $c, $cr, $f, $fr); +} + +sub _binop { + my ($op, $x, $y, $swap) = @_; + my (undef, $c, $cr, $f, $fr) = @$x; + $y = _convert($c, $cr, $f, $fr, $y); + my $z = $swap ? + &$op($c, $x->[0], $y->[0]) : + &$op($c, $y->[0], $x->[0]); + return _pt($z, $c, $cr, $f, $fr); +} + +sub _unop { + my ($op, $x) = @_; + my (undef, $c, $cr, $f, $fr) = @$x; + my $z = &$op($c, $x->[0]); + return _pt($z, $c, $cr, $f, $fr); +} + +sub _eq { + my ($x, $y) = @_; + my (undef, $c, $cr, $f, $fr) = @$x; + $y = _convert($c, $cr, $f, $fr, $y); + return Catacomb::EC::Point::eq($c->out($x), $c->out($y)); +} + +sub mul { + croak("Usage: Catacomb::EC::Pt::mul(p, n)") unless @_ == 2; + my ($p, $x) = @_; + my ($pp, $c, $cr, $f, $fr) = @$p; + return _pt($c->imul($pp, $x), $c, $cr, $f, $fr); +} + +use overload + '+' => sub { _binop(\&Catacomb::EC::Curve::iadd, @_); }, + '-' => sub { _binop(\&Catacomb::EC::Curve::isub, @_); }, + '*' => sub { mul($_[0], $_[1]); }, + '==' => sub { _eq(@_); }, + '!=' => sub { !_eq(@_); }, + 'eq' => sub { _eq(@_); }, + 'ne' => sub { !_eq(@_); }, + '""' => sub { $_[0]->point()->tostring(); }, + '0+' => sub { $_[0]->point()->x()->toint(); }, + 'neg' => sub { _unop(\&Catacomb::EC::Curve::ineg, @_); }; + +#----- That's all, folks ---------------------------------------------------- diff --git a/Catacomb/Field.pm b/Catacomb/Field.pm new file mode 100644 index 0000000..3ca9d37 --- /dev/null +++ b/Catacomb/Field.pm @@ -0,0 +1,222 @@ +# -*-perl-*- +# +# $Id$ +# +# Field abstraction +# +# (c) 2004 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. + +#----- Abstract fields ------------------------------------------------------ + +package Catacomb::Field; +use Carp; +use Catacomb::Base; +use Catacomb::Cache; + +$cache = Catacomb::Cache->new(); + +sub intern { + croak("USage: Catacomb::Field::intern(f)") unless @_ == 1; + my ($f) = @_; + return $cache->intern($f); +} + +sub elt { + croak("Usage: Catacomb::Field::elt(f, x)") unless @_ == 2; + my ($f, $x) = @_; + return Catacomb::Field::Elt->new($f, $x); +} + +sub zero { + croak("Usage: Catacomb::Field::zero(f)") unless @_ == 1; + my ($f) = @_; + return Catacomb::Field::Elt->new($f, $f->_zero()); +} + +sub one { + croak("Usage: Catacomb::Field::one(f)") unless @_ == 1; + my ($f) = @_; + return Catacomb::Field::Elt->new($f, $f->_one()); +} + +sub rand { + croak("Usage: Catacomb::Field::rand(f, [rng])") + unless @_ >= 1 && @_ <= 2; + my ($f, $rng) = @_; + $rng ||= $Catacomb::random; + return Catacomb::Field::Elt->new($f, $f->_one($rng)); +} + +sub div { + croak("Usage: Catacomb::Field::div(f, x, y)") unless @_ == 3; + my ($f, $x, $y) = @_; + return $f->mul($x, $f->inv($y)); +} + +sub primecurve { + croak("Usage: Catacomb::Field::primecurve(f, a, b)") unless @_ == 3; + my ($f, $a, $b) = @_; + croak("not a prime field") unless $f->type == Catacomb::FTY_PRIME; + return Catacomb::EC::Curve->prime($f, $a, $b); +} + +sub primeprojcurve { + croak("Usage: Catacomb::Field::primeprojcurve(f, a, b)") unless @_ == 3; + my ($f, $a, $b) = @_; + croak("not a prime field") unless $f->type == Catacomb::FTY_PRIME; + return Catacomb::EC::Curve->primeproj($f, $a, $b); +} + +sub bincurve { + croak("Usage: Catacomb::Field::bincurve(f, a, b)") unless @_ == 3; + my ($f, $a, $b) = @_; + croak("not a prime field") unless $f->type == Catacomb::FTY_BINARY; + return Catacomb::EC::Curve->bincurve($f, $a, $b); +} + +sub binprojcurve { + croak("Usage: Catacomb::Field::binprojcurve(f, a, b)") unless @_ == 3; + my ($f, $a, $b) = @_; + croak("not a prime field") unless $f->type == Catacomb::FTY_BINARY; + return Catacomb::EC::Curve->binproj($f, $a, $b); +} + +#----- Field elements ------------------------------------------------------- + +package Catacomb::Field::Elt; +use Carp; +use Catacomb::Base; + +sub _elt { bless [@_], Catacomb::Field::Elt; } + +sub new { + croak("Usage: Catacomb::Field::Elt::new(me, f, x)"), unless @_ == 3; + my ($me, $f, $x) = @_; + my $r; + ($f, $r) = $f->intern(); + return _elt($f->in($x), $f, $r); +} + +sub field { + croak("Usage: Catacomb::Field::Elt::field(e)") unless @_ == 1; + return $_[0][1]; +} + +sub value { + croak("Usage: Catacomb::Field::Elt::value(e)") unless @_ == 1; + return $_[0][1]->out($_[0][0]); +} + +sub elt { + croak("Usage: Catacomb::Field::Elt::elt(e, x)") unless @_ == 2; + my ($e, $x) = @_; + my $f = $e->[1]; + return _elt($f->in($x), $f, $e->[2]); +} + +sub tostring { + croak("Usage: Catacomb::Field::Elt::tostring(e, [radix])") + unless @_ >= 1 && @_ <= 2; + my ($e, $radix) = @_; + $radix = 16 unless defined($radix); + return $e->value()->tostring($radix); +} + +sub _convert { + my ($x, $f, $r) = @_; + if (UNIVERSAL::isa($x, Catacomb::Field::Elt)) { + croak("field mismatch") unless $f == $x->[1]; + return $x; + } + if ($x == 0) { + return _elt($f->_zero(), $f, $r); + } + if ($x == 1) { + return _elt($f, $f->_one(), $f, $r); + } + croak("can't convert to field element"); +} + +sub _binop { + my ($op, $x, $y, $swap) = @_; + my $f = $x->[1]; + my $r = $x->[2]; + $y = _convert($y, $f, $r); + my $z = $swap ? + &$op($f, $x->[0], $y->[0]) : + &$op($f, $y->[0], $x->[0]); + return _elt($z, $f, $r); +} + +sub _unop { + my ($op, $x) = @_; + my $f = $x->[1]; + my $r = $x->[2]; + my $z = &$op($f, $x->[0]); + return _elt($z, $f, $r); +} + +sub exp { + croak("Usage: Catacomb::Field::Elt::exp(x, n)") unless @_ == 2; + my ($x, $n) = @_; + my ($xx, $f, $fr) = @$x; + return _elt($f->exp($xx, $n), $f, $fr); +} + +sub sqrt { + croak("Usage: Catacomb::Field::Elt::sqrt(x)") unless @_ == 1; + my ($x) = @_; + my ($xx, $f, $fr) = @$x; + return _elt($f->sqrt($xx), $f, $fr); +} + +sub zerop { + croak("Usage: Catacomb::Field::Elt::zerop(x)") unless @_ == 1; + my ($x) = @_; + my ($xx, $f, $fr) = @$x; + return $f->zero($xx); +} + +sub _eq { + my ($x, $y) = @_; + $y = _convert($y, $x->[1], $x->[2]); + return Catacomb::MP::eq($x->[0], $y->[0]); +} + +use overload + '+' => sub { _binop(\&Catacomb::Field::add, @_); }, + '-' => sub { _binop(\&Catacomb::Field::sub, @_); }, + '*' => sub { _binop(\&Catacomb::Field::mul, @_); }, + '/' => sub { _binop(\&Catacomb::Field::div, @_); }, + '**' => sub { &exp($_[0], $_[1]); }, + '==' => sub { _eq(@_); }, + '!=' => sub { !_eq(@_); }, + 'eq' => sub { _eq(@_); }, + 'ne' => sub { !_eq(@_); }, + '""' => sub { "0x" . $_[0]->tostring(16); }, + '0+' => sub { $_[0][1]->toint(); }, + 'sqrt' => sub { _unop(\&Catacomb::Field::sqrt, @_); }, + 'neg' => sub { _unop(\&Catacomb::Field::neg, @_); }; + +sub inv { _unop(\&Catacomb::Field::inv, @_); } + +#----- That's all, folks ---------------------------------------------------- diff --git a/Catacomb/GF.pm b/Catacomb/GF.pm new file mode 100644 index 0000000..633bf78 --- /dev/null +++ b/Catacomb/GF.pm @@ -0,0 +1,112 @@ +# -*-perl-*- +# +# $Id$ +# +# Binary polynomial arithmetic +# +# (c) 2004 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. + +#----- Binary polynomials --------------------------------------------------- + +package Catacomb::GF; +use Catacomb::Base; +use Catacomb::MP; +use Carp; + +@ISA = qw(Catacomb::MP); + +sub gf { new(Catacomb::GF, $_[0]); } +sub gf_loadb { loadb(Catacomb::GF, $_[0]); } +sub gf_loadl { loadl(Catacomb::GF, $_[0]); } +sub gf_fromstring { fromstring(Catacomb::GF, $_[0]); } + +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 { _binop(\&pow, @_); }, + '>>' => sub { new(undef, &Catacomb::MP::lsr(@_[0, 1])); }, + '<<' => sub { new(undef, &Catacomb::MP::lsl(@_[0, 1])); }, + '~' => sub { new(undef, &Catacomb::MP::not($_[0])) }, + '==' => sub { _binop(\&Catacomb::MP::eq, @_); }, + '!=' => sub { !_binop(\&Catacomb::MP::eq, @_); }, + 'eq' => sub { _binop(\&Catacomb::MP::eq, @_); }, + 'ne' => sub { !_binop(\&Catacomb::MP::eq, @_); }, + '""' => sub { "0x" . &Catacomb::MP::tostring($_[0], 16); }, + 'neg' => sub { $_[0]; }, + '0+' => sub { &Catacomb::MP::toint($_[0]); }; + +sub binpolyfield { + croak("Usage: Catacomb::GF::binpolyfield(p)") unless @_ == 1; + return Catacomb::Field->binpoly($_[0]); +} + +sub binnormfield { + croak("Usage: Catacomb::GF::binnormfield(p, beta)") unless @_ == 2; + return Catacomb::Field->binnormfield($_[0], $_[1]); +} + +sub binpolygroup { + croak("Usage: Catacomb::GF::binpolygroup(p, g, q)") unless @_ == 3; + return Catacomb::Group->binary(@_); +} + +sub mod { (&div($_[0], $_[1]))[1]; } + +sub pow { + croak("Usage: Catacomb::GF::pow(a, b)") unless @_ == 2; + my ($a, $b) = @_; + my $r = Catacomb::GF->new(1); + while ($b) { + $r *= $a if $b & 1; + $a = sqr($a); + $b >>= 1; + } + return $r; +} + +sub _binop { + my ($func, $a, $b, $flag) = @_; + return new(undef, $flag ? &$func($b, $a) : &$func($a, $b)); +} + +sub modexp { + croak("Usage: Catacomb::GF::modexp(p, g, x)") unless @_ == 3; + my ($p, $g, $x) = @_; + my $r = Catacomb::GF::Reduce->new($p); + $g = $r->reduce($g); + return $r->exp($g, $x); +} + +sub modinv { + croak("Usage: Catacomb::GF::modinv(p, g)") unless @_ == 3; + my ($g, undef, $i) = gcd($_[0], $_[1]); + croak("Arguments aren't coprime in Catacomb::GF::modinv") unless $g == 1; + return $i; +} + +#----- That's all, folks ---------------------------------------------------- diff --git a/Catacomb/Group.pm b/Catacomb/Group.pm new file mode 100644 index 0000000..ae28b7e --- /dev/null +++ b/Catacomb/Group.pm @@ -0,0 +1,216 @@ +# -*-perl-*- +# +# $Id$ +# +# Abstract groups +# +# (c) 2004 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. + +#----- Abstract groups ------------------------------------------------------ + +package Catacomb::Group; +use Carp; +use Catacomb::Base; +use Catacomb::Cache; + +$cache = Catacomb::Cache->new(); + +sub intern { + croak("Usage: Catacomb::Group::intern(c)") unless @_ == 1; + my ($c) = @_; + return $cache->intern($c); +} + +sub elt { + croak("Usage: Catacomb::Group::elt(g, [x])") + unless @_ >= 1 && @_ <= 2; + return Catacomb::Group::Elt->new(@_); +} + +sub id { + croak("Usage: Catacomb::Group::id(g)") unless @_ == 1; + return Catacomb::Group::Elt->new($_[0]); +} + +sub g { + croak("Usage: Catacomb::Group::g(g)") unless @_ == 1; + return Catacomb::Group::Elt->new($_[0], $_[0]->_g()); +} + +sub _cvt { + croak("Usage: Catacomb::Group::$_[1](g, x)") unless @_ == 4; + my ($op, $name, $g, $x) = @_; + $x = &$op(&g, $x); + return undef unless defined($x); + return elt($g, &$op(&g, $x)); +} +sub fromint { _cvt(\&_fromint, "fromint", @_); } +sub fromec { _cvt(\&_fromec, "fromec", @_); } + +sub _strcvt { + croak("Usage: Catacomb::Group::$_[1](g, sv)") unless @_ == 4; + my ($op, $name, $g, $sv) = @_; + my ($x, $rest) = &$op($g, $sv); + return undef unless defined($x); + $x = elt($g, $x); + return $x unless wantarray(); + return ($x, $rest); +} +sub frombuf { _strcvt(\&_getbuf, "frombuf", @_); } +sub fromraw { _strcvt(\&_getraw, "fromraw", @_); } +sub fromstring { _strcvt(\&_fromstring, "fromstring", @_); } + +sub mexp { + croak("Usage: Catacomb::Group::mexp(g, x_0, n_0, x_1, n_1, ...)") + unless @_ >= 3 && @_ % 2 == 1; + my $g = pop(@_); + my $i; + my @v = (); + my $gr; + ($g, $gr) = $g->intern(); + for ($i = 0; $i < @_; $i += 2) { + my $x = Catacomb::Group::Elt::_convert($g, $gr, $_[$i]); + my $n = $_[$i + 1]; + push(@v, $x, $n); + } + return Catacomb::Group::Elt::_elt($g->mexp(@v), $g, $gr); +} + +#----- Group elements ------------------------------------------------------- + +package Catacomb::Group::Elt; +use Carp; +use Catacomb::Base; + +sub DESTROY { + my ($x) = @_; + $x->[1]->_destroyelement($x->[0]); + undef $x->[0]; +} + +sub _elt { bless [@_], Catacomb::Group::Elt; } + +sub new { + croak("Usage: Catacomb::Group::Elt::new(me, g, [x])") + unless @_ >= 2 && @_ <= 3; + my ($me, $g, $x); + if (@_ == 2) { + ($me, $g) = @_; + $x = $g->_i(); + } else { + ($me, $g, $x) = @_; + if (UNIVERSAL::isa($x, Catacomb::Group::Elt)) { + croak("group mismatch") unless $x->[1] == $g; + } elsif (UNIVERSAL::isa($x, Catacomb::EC::Pt)) { + my $pt = $x->point(); + $x = $g->_fromec($pt); + } elsif (UNIVERSAL::isa($x, Catacomb::EC::Point)) { + $x = $g->_fromec($x); + } elsif (UNIVERSAL::isa($x, Catacomb::Group::Element)) { + # cool + } else { + $x = $g->_fromint($x); + } + return undef unless defined($x); + } + my $gr; + ($g, $gr) = $g->intern(); + return _elt($x, $g, $gr); +} + +sub _convert { + my ($g, $gr, $x) = @_; + if (UNIVERSAL::isa($x, Catacomb::Group::Elt)) { + $x->[1] == $g or croak("group mismatch"); + return $x; + } + $x == 0 and return _elt($g->_i(), $g, $gr); + croak("can't convert to group element"); +} + +sub _out { + croak("Usage: Catacomb::Group::Elt::$_[1](x)") unless @_ == 3; + my ($op, $name, $x) = @_; + return &$op($x->[1], $x->[0]); +} +sub toint { _out(\&Catacomb::Group::_toint, "toint", @_); } +sub toec { _out(\&Catacomb::Group::_toec, "toec", @_); } +sub tobuf { _out(\&Catacomb::Group::_putbuf, "tobuf", @_); } +sub toraw { _out(\&Catacomb::Group::_putraw, "toraw", @_); } +sub tostring { _out(\&Catacomb::Group::_tostring, "tostring", @_); } + +sub group { + croak("Usage: Catacomb::Group::Elt::group(x)") unless @_ == 1; + return $_[0][1]; +} + +sub identp { _out(\&Catacomb::Group::_identp, "identp", @_); } +sub check { _out(\&Catacomb::Group::_checkelt, "check", @_); } + +sub _binop { + my ($op, $x, $y, $swap) = @_; + my (undef, $g, $gr) = @$x; + $y = _convert($g, $gr, $y); + my $z = $swap ? + &$op($c, $x->[0], $y->[0]) : + &$op($c, $y->[0], $x->[0]); + return _elt($z, $g, $gr); +} + +sub _unop { + my ($op, $x) = @_; + my (undef, $g, $gr) = @$x; + my $z = &$op($c, $x->[0]); + return _elt($z, $g, $gr); +} + +sub _eq { + my ($x, $y) = @_; + my (undef, $g, $gr) = @$x; + $y = _convert($g, $gr, $y); + return Catacomb::Group::_eq($x->[0], $y->[0]); +} + +sub exp { + croak("Usage: Catacomb::Group::Elt::exp(x, n)") unless @_ == 2; + my ($x, $n) = @_; + my ($xx, $g, $gr) = @$x; + return _elt($g->_exp($xx, $n), $g, $gr); +} + +sub inv { + croak("Usage: Catacomb::Group::Elt::inv(x)") unless @_ == 1; + _unop(\&Catacomb::Group::inv, @_); +} + +use overload + '*' => sub { _binop(\&Catacomb::Group::_mul, @_); }, + '/' => sub { _binop(\&Catacomb::Group::_div, @_); }, + '**' => sub { &exp($_[0], $_[1]); }, + '==' => sub { _eq(@_); }, + '!=' => sub { !_eq(@_); }, + 'eq' => sub { _eq(@_); }, + 'ne' => sub { !_eq(@_); }, + '""' => sub { tostring($_[0]); }, + '0+' => sub { toint($_[0]); }; + +#----- That's all, folks ---------------------------------------------------- diff --git a/Catacomb/Key.pm b/Catacomb/Key.pm new file mode 100644 index 0000000..6f84492 --- /dev/null +++ b/Catacomb/Key.pm @@ -0,0 +1,189 @@ +# -*-perl-*- +# +# $Id$ +# +# Key management +# +# (c) 2004 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. + +#----- Key data ------------------------------------------------------------- + +package Catacomb::Key::StructData; +use Carp; +use Catacomb::Base; + +sub TIEHASH { bless [$_[1], []], $_[0]; } +sub FETCH { Catacomb::Key::Data::StructItem->new($_[0][0], $_[1]); } +sub EXISTS { !!$_[0][0]->_get->structfind($_[1]); } +sub DELETE { $_[0][0]->_get->structdel($_[1]); } +sub CLEAR { $_[0][0]->_get()->setstruct(); } +sub STORE { + my ($me, $k, $v) = @_; + $me->[0]->_get()->structcreate($k)->set($v); +} +sub FIRSTKEY { + my ($me) = @_; + my $kd = $me->[0]->_get(); + my $i = $kd->structiter(); + my @k = (); + while (my $k = $i->next()) { + push(@k, $k); + } + $me->[1] = \@k; + return shift(@k); +} +sub NEXTKEY { shift(@{$_[0][1]}); } + +package Catacomb::Key::DataRef; +use Carp; +use Catacomb::Base; +use Catacomb::MP; +use Catacomb::EC; +sub _adopt { + my $kd = shift; + defined($kd) or return; + $kd = bless [$kd], Catacomb::Key::Data; + return wantarray ? ($kd, @_) : $kd; +} +sub new { my $me = shift(@_); bless [@_], $me; } +sub _proxy { my ($op, $kd, @args) = @_; &$op($kd->_get(), @args); } + +sub setbinary { _proxy(\&Catacomb::Key::DataImpl::setbinary, @_); } +sub setencrypted { _proxy(\&Catacomb::Key::DataImpl::setencrypted, @_); } +sub setmp { _proxy(\&Catacomb::Key::DataImpl::setec, @_); } +sub setstring { _proxy(\&Catacomb::Key::DataImpl::setstring, @_); } +sub setec { _proxy(\&Catacomb::Key::DataImpl::setec, @_); } + +sub flags { _proxy(\&Catacomb::Key::DataImpl::flags, @_); } + +sub getbinary { _proxy(\&Catacomb::Key::DataImpl::getbinary, @_); } +sub getencrypted { _proxy(\&Catacomb::Key::DataImpl::getencrypted, @_); } +sub getmp { _proxy(\&Catacomb::Key::DataImpl::getmp, @_); } +sub getstring { _proxy(\&Catacomb::Key::DataImpl::getstring, @_); } +sub getec { _proxy(\&Catacomb::Key::DataImpl::getec, @_); } + +sub setstruct { _proxy(\&Catacomb::Key::DataImpl::setstruct, @_); } +sub structfind { Catacomb::Key::Data::StructItem->new($_[0], $_[1]); } +sub structcreate { + _proxy(\&Catacomb::Key::DataImpl::structcreate, @_); + Catacomb::Key::Data::StructItem->new($_[0], $_[1]); +} +sub structiter { _proxy(\&Catacomb::Key::DataImpl::structiter, @_); } +sub structdel { _proxy(\&Catacomb::Key::DataImpl::structdel, @_); } +sub structopen { my %h; tie %h, Catacomb::Key::StructData, $_[0]; \%h; } + +sub copy { + croak("Usage: Catacomb::Key::Data::Ref::copy(kd, kkd, [filter])") + unless @_ >= 2 && @_ <= 3; + my $kd = Catacomb::Key::Data->new(); + $kd->_get()->set($_[0]->_get(), $_[1]); + return $kd; +} +sub lock { _adopt(_proxy(\&Catacomb::Key::DataImpl::lock, @_)); } +sub unlock { _adopt(_proxy(\&Catacomb::Key::DataImpl::unlock, @_)); } +sub plock { _adopt(_proxy(\&Catacomb::Key::DataImpl::plock, @_)); } +sub punlock { _adopt(_proxy(\&Catacomb::Key::DataImpl::punlock, @_)); } +sub read { _adopt(Catacomb::Key::DataImpl::read(@_)); } +sub write { _proxy(\&Catacomb::Key::DataImpl::write, @_); } +sub decode { _adopt(Catacomb::Key::DataImpl::decode(@_)); } +sub encode { _proxy(\&Catacomb::Key::DataImpl::encode, @_); } + +package Catacomb::Key::Data; +use Carp; +@ISA = qw(Catacomb::Key::DataRef); +sub _get { $_[0][0]; } +## Perl will randomly zap my reference during cleanup. Just pretend +## we didn't notice. +sub DESTROY { $_[0][0]->free() if defined $_[0][0]; } +sub new { + croak("Usage: Catacomb::Key::Data::new(me)") unless @_ == 1; + Catacomb::Key::DataRef::_adopt(Catacomb::Key::DataImpl->new()); +} + +package Catacomb::Key::Data::StructItem; +@ISA = qw(Catacomb::Key::DataRef); +sub _get { $_[0][0]->_get()->structfind($_[0][1]); } + +package Catacomb::Key::Data::KeyData; +@ISA = qw(Catacomb::Key::DataRef); +sub _get { $_[0][0]->_data(); } + +#----- Actual keys ---------------------------------------------------------- + +package Catacomb::Key::Attrs; +use Carp; + +sub TIEHASH { bless [$_[1], []], $_[0]; } +sub FETCH { $_[0][0]->getattr($_[1]); } +sub EXISTS { defined($_[0][0]->getattr($_[1])); } +sub STORE { $_[0][0]->putattr($_[1], $_[2]); } +sub DELETE { $_[0][0]->putattr($_[1]); } +sub FIRSTKEY { + my ($me) = @_; + my $k = $me->[0]; + my $i = $k->attriter(); + my @a; + while (my $a = $i->next()) { push(@a, $a); } + $me->[1] = \@a; + return shift(@a); +} +sub NEXTKEY { shift(@{$_[0][1]}); } + +package Catacomb::Key; + +sub attrs { + croak("Usage: Catacomb::Key::attrs(k)") unless @_ == 1; + my %a; + tie %a, Catacomb::Key::Attrs, @_; + return \%a; +} + +sub data { + croak("Usage: Catacomb::Key::data(k)") unless @_ == 1; + return Catacomb::Key::Data::KeyData->new($_[0]); +} + +package Catacomb::Key::File; +use Carp; +use Catacomb::Base; + +sub qtag { + croak("Usage: Catacomb::Key::File::qtag(kf, tag)") unless @_ == 2; + my ($kf, $tag) = @_; + my @q = (); + if ($tag =~ /^([^.]*)\.(.*)$/) { + $tag = $1; + @q = split(/\./, $2); + } + my $k = $kf->bytag($tag) or return; + my $d = $k->data(); + my $f = $k->fulltag(); + foreach my $t (@q) { + $d = $d->structfind($t) or return; + $f .= "." . $t; + } + return $k, $d, $f; +} + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Catacomb/MP.pm b/Catacomb/MP.pm new file mode 100644 index 0000000..0341626 --- /dev/null +++ b/Catacomb/MP.pm @@ -0,0 +1,205 @@ +# -*-perl-*- +# +# $Id$ +# +# Catacomb multiprecision integer interface +# +# (c) 2004 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. + +#----- Multiprecision arithmetic -------------------------------------------- + +package Catacomb::MP; +use Catacomb::Base; +use Catacomb::Rand; +use Catacomb::Field; +use Carp; + +sub mp { new(Catacomb::MP, $_[0]); } +sub mp_loadb { loadb(Catacomb::MP, $_[0]); } +sub mp_loadl { loadl(Catacomb::MP, $_[0]); } +sub mp_loadb2c { loadb2c(Catacomb::MP, $_[0]); } +sub mp_loadl2c { loadl2c(Catacomb::MP, $_[0]); } +sub mp_fromstring { fromstring(Catacomb::MP, $_[0]); } + +sub mod { (&div($_[0], $_[1]))[1]; } + +sub _binop { + my ($func, $a, $b, $flag) = @_; + return $flag ? &$func($b, $a) : &$func($a, $b); +} + +sub _mul { + my ($a, $b, $flag) = @_; + if (UNIVERSAL::isa($b, Catacomb::EC::Pt)) { + return $b->mul($a); + } + mul($a, $b); +} + +use overload + '+' => sub { _binop(\&add, @_); }, + '-' => sub { _binop(\&sub, @_); }, + '*' => \&_mul, + '/' => sub { _binop(\&div, @_); }, + '%' => sub { _binop(\&mod, @_); }, + '&' => sub { _binop(\&and2c, @_); }, + '|' => sub { _binop(\&or2c, @_); }, + '^' => sub { _binop(\&xor2c, @_); }, + '**' => sub { _binop(\&exp, @_); }, + '>>' => sub { &lsr2c(@_[0, 1]); }, + '<<' => sub { &lsl2c(@_[0, 1]); }, + '~' => sub { ¬2c($_[0]) }, + '==' => sub { _binop(\&eq, @_); }, + 'eq' => sub { _binop(\&eq, @_); }, + '<=>' => sub { _binop(\&cmp, @_); }, + 'cmp' => sub { _binop(\&cmp, @_); }, + '""' => sub { &tostring($_[0]); },, + '0+' => sub { &toint($_[0]); }, + 'sqrt' => sub { &sqrt($_[0]); }, + 'neg' => sub { &neg($_[0]); }; + +sub import { + my ($me, @imp) = @_; + for my $i (@imp) { + if ($i eq ":constant") { + overload::constant integer => sub { new(undef, $_[0]); }; + } else { + croak("unknown import for Catacomb::MP: `$i'"); + } + } +} + +sub modexp { + croak("Usage: Catacomb::MP::modexp(p, g, x)") unless @_ == 3; + my ($p, $g, $x) = @_; + $g = $p - $g if $g < 0; + $g = $g % $p if $g > $p; + if ($p & 1) { + my $mm = $p->mont(); + return $mm->exp($g, $x); + } else { + my $mb = $p->barrett(); + return $mb->exp($g, $x); + } +} + +sub primefield { + croak("Usage: Catacomb::MP::primefield(p)") unless @_ == 1; + return Catacomb::Field->prime($_[0]); +} + +sub niceprimefield { + croak("Usage: Catacomb::MP::niceprimefield(p)") unless @_ == 1; + return Catacomb::Field->niceprime($_[0]); +} + +sub primegroup { + croak("Usage: Catacomb::MP::primegroup(p, g, q)") unless @_ == 3; + return Catacomb::Group->prime(@_); +} + +sub filter { + croak("Usage: Catacomb::MP::filter(p)") unless @_ == 1; + return Catacomb::MP::Prime::Filter->new($_[0]); +} + +sub modinv { + croak("Usage: Catacomb::MP::modinv(p, x)") unless @_ == 2; + my ($g, undef, $i) = gcd($_[0], $_[1]); + croak("Arguments aren't coprime in Catacomb::MP::modinv") unless $g == 1; + return $i; +} + +sub jac { + # Reverse arguments for object-oriented syntax. + croak("Usage: Catacomb::MP::jac(n, a)") unless @_ == 2; + jacobi($_[1], $_[0]); +} + +sub mont { + croak("Usage: Catacomb::MP::mont(x)") unless @_ == 1; + return Catacomb::MP::Mont->new($_[0]); +} + +sub barrett { + croak("Usage: Catacomb::MP::barrett(x)") unless @_ == 1; + return Catacomb::MP::Mont->new($_[0]); +} + +sub mkreduce { + croak("Usage: Catacomb::MP::mkreduce(x)") unless @_ == 1; + return Catacomb::MP::Reduce->new($_[0]); +} + +sub rabin { + croak("Usage: Catacomb::MP::rabin(x)") unless @_ == 1; + return Catacomb::MP::Prime::Rabin->new($_[0]); +} + +sub newprime { + croak("Usage: Catacomb::MP::newprime(nbits, [rng]") + unless @_ >= 1 && @_ <= 2; + my ($nbits, $rng) = @_; + $rng ||= $Catacomb::random; + return Catacomb::MP::Prime->gen + ("p", $rng->mp($nbits, 1), 0, + Catacomb::MP::Prime::Filter->stepper(2), + Catacomb::MP::Prime::Rabin->ntests($nbits), + Catacomb::MP::Prime::Rabin->tester()); +} + +sub jumper { + croak("Usage: Catacomb::MP::jumper(p)") unless @_ == 1; + return Catacomb::MP::Prime::Filter->jumper($_[0]); +} + +package Catacomb::MP::Mont; + +*out = \&reduce; + +package Catacomb::MP::Prime::Filter; + +package Catacomb::MP::Prime::Filter; + +sub filterstepper { &stepper(Catacomb::MP::Prime::Filter, @_); } +sub filterjumper { &jumper(Catacomb::MP::Prime::Filter, @_); } + +package Catacomb::MP::Prime; + +sub primegen { &gen(Catacomb::MP::Prime, @_); } +sub limleegen { &limlee(Catacomb::MP::Prime, @_); } + +package Catacomb::MP::Prime::Rabin; + +sub rabintester { &tester(Catacomb::MP::Prime::Rabin, @_); } + +{ + my $cmpg = "Catacomb::MP::Prime::Gen"; + foreach my $i (qw(FilterStepper JumpStepper RabinTester)) { + @{"${cmpg}::${i}::ISA"} = ("${cmpg}::MagicProc"); + } + @{"${cmpg}::MagicProc::ISA"} = ("${cmpg}::Proc"); +} + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Catacomb/Rand.pm b/Catacomb/Rand.pm new file mode 100644 index 0000000..a74b650 --- /dev/null +++ b/Catacomb/Rand.pm @@ -0,0 +1,43 @@ +# -*-perl-*- +# +# $Id$ +# +# Random number generators +# +# (c) 2004 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. + +#----- Random number generators --------------------------------------------- + +package Catacomb; +use Catacomb::Base; + +foreach my $i (qw(True Fib LC DSA RC4 SEAL MGF Counter OFB Magic)) { + @{"Catacomb::Rand::${i}::ISA"} = qw(Catacomb::Rand); +} + +$Catacomb::random = Catacomb::Rand::True->_global(); +$Catacomb::random->noisesrc(); +$Catacomb::random->seed(160); + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Catacomb::MP.pod b/Catacomb::MP.pod new file mode 100644 index 0000000..59a1873 --- /dev/null +++ b/Catacomb::MP.pod @@ -0,0 +1,621 @@ +=head1 NAME + +Catacomb::MP - Multiprecision integer arithmetic + +=head1 SYNOPSIS + + use Catacomb qw(:const :mp :random :pgen); + + $x = Catacomb::MP->new($str, [$radix]); + $x = Catacomb::MP->new($i); + $x = Catacomb::MP->loadb($bytes); + $x = Catacomb::MP->loadl($bytes); + $x = Catacomb::MP->loadb2c($bytes); + $x = Catacomb::MP->loadl2c($bytes); + ($x, $rest) = Catacomb::MP->fromstring($str, [$radix]); + $x = mp($str, [$radix]); + $x = mp($i); + ($x, $rest) = mp_fromstring($str, [$radix]); + $a = $b + $c; + $a = $b - $c; + $a = $b * $c; + $a = $b / $c; + $a = $b % $c; + $a = $b ** $n; + $a = $b << $n; + $a = $b >> $n; + $a = $b & $c; + $a = $b | $c; + $a = $b ^ $c; + $a = ~$b; + $p = $b == $c; + $p = $b != $c; + $p = $b < $c; + $p = $b > $c; + $p = $b <= $c; + $p = $b >= $c; + $a = sqrt($b); + $a = -$b; + $a = $b->add($c); + $a = $b->sub($c); + $a = $b->mul($c); + ($q, $r) = $a->div($b); + $a = $b->sqr(); + $a = $b->exp($c); + $a = $b->sqrt(); + $a = $b->neg(); + $a = $b->not(); + $a = $b->not2c(); + $a = $b->mod($c); + $p = $b->eq($c); + $cmp = $b->cmp($c); + $a = $b->and($c); + $a = $b->and2c($c); + $a = $b->or($c); + $a = $b->or2c($c); + $a = $b->xor($c); + $a = $b->xor2c($c); + $a = $b->nand($c); + $a = $b->nand2c($c); + $a = $b->nor($c); + $a = $b->nor2c($c); + $a = $b->not(); + $a = $b->not2c(); + $a = $b->lsl($n); + $a = $b->lsl2c($n); + $a = $b->lsr($n); + $a = $b->lsr2c($n); + $a = $b->setbit($n); + $a = $b->setbit2c($n); + $a = $b->clearbit($n); + $a = $b->clearbit2c($n); + $p = $b->testbit($n); + $p = $b->testbit2c($n); + $x = $y->copy(); # largely useless + $g = $a->gcd($b); + ($g, $u, $v) = $a->gcd($b); + ($s, $t) = $m->odd(); # m = 2^s t + $a = $p->modexp($x, $e); + $a = $p->modinv($b); + $r = $p->modsqrt($x); + $q = $n->jac($a); + $p = $x->primep([$rng]); + $nbits = $x->bits(); + $nbytes = $x->octets(); + $bytes = $x->storeb([$nbytes]); + $bytes = $x->storel([$nbytes]); + $bytes = $x->storeb2c([$nbytes]); + $bytes = $x->storel2c([$nbytes]); + $str = $x->tostring([$radix]); + $n = $x->toint(); + + $barrett = Catacomb::MP::Barrett->new($p); + $barrett = $p->barrett(); + $p = $barrett->m(); + $x = $barrett->reduce($y); + $a = $barrett->exp($x, $y); + + $mont = Catacomb::MP::Mont->new($p); + $mont = $p->mont(); + $r = $mont->r(); + $r2 = $mont->r2(); + $p = $mont->m(); + $x = $mont->in($y); + $a = $mont->mul($x, $y); + $a = $mont->expr($x, $y); + $a = $mont->mexpr($x0, $e0, $x1, $e1, ...); + $x = $mont->reduce($y); + $x = $mont->out($y); + $a = $mont->exp($x, $y); + $a = $mont->mexp($x0, $e0, $x1, $e1, ...); + + $reduce = Catacomb::MP::Reduce->new($p); + $reduce = $p->mkreduce(); + $p = $reduce->m(); + $x = $reduce->reduce($y); + $a = $barrett->exp($x, $y); + + $crt = Catacomb::MP::CRT->new(@n); + $n = $crt->product(); + @n = $crt->moduli(); + $x = $crt->solve(@r); + +=head1 DESCRIPTION + +This is a full-featured multiprecision maths library. Integer objects +belong to the class C. Most standard arithmetic operators +are overloaded and do the Right Thing. See below for more details. + +Note that multiprecision integers are I. No operation can +change the value of an integer. + +=head2 Constructors + +=over + +=item Bnew(>iB<)> + +=item BIB<)> + +Return the multiprecision integer whose value is I. + +=item Bnew(>I, [I]B<)> + +=item BI, [I]B<)> + +Returns the multiprecision integer whose value is represented by +I, in the given I. If I is 0, as it is by +default, then I may have a prefix giving its radix: it may be +B<0> for octal, B<0x> for hex, or IB<_> for radix I. If the +argument is invalid, B is returned. + +=item Bloadb(>IB<)> + +=item Bloadl(>IB<)> + +=item BIB<)> + +=item BIB<)> + +Returns the multiprecision integer whose value is represented in big- or +little-endian base-256 form by I. This will always be +nonnegative. + +Returns the multiprecision integer whose value is represented in +little-endian base-256 form by I. This will always be +nonnegative. + +=item Bloadb2c(>IB<)> + +=item Bloadl2c(>IB<)> + +=item BIB<)> + +=item BIB<)> + +Returns the multiprecision integer whose value is represented in +two's complement big- or little-endian base-256 form by I. + +=item Bfromstring(>I, [I]B<)> + +=item BI, [I]B<)> + +Returns the multiprecision integer whose value is represented by +I, and (in a list context) the remainder of I. If +I is 0 then I may have a prefix, as for B. If +I is invalid, an empty list is returned. + +=back + +=head2 Methods + +The B package overloads the standard arithmetic +operators. As long as one operand is a B object, the +other may be any argument acceptable to B. As a special +exception, either argument to B<*> may be a B object, +to perform elliptic curve point multiplication. + +=over + +=item IB<-Eadd(>IB<)> + +=item IB<-Esub(>IB<)> + +=item IB<-Emul(>IB<)> + +=item IB<-Ediv(>IB<)> + +=item IB<-Emod(>IB<)> + +The basic algorithms. The argument I may be any value acceptable to +the B constructor. + +In an array context, the B method returns a two values: the +quotient and remainder. The quotient returned is the I of the +true quotient: the remainder therefore has the same sign as the divisor. +This is usually the right result for number-theoretic purposes. + +=item IB<-Esqr()> + +Returns the square of its argument. Usually faster than multiplying it +by itself. + +=item IB<-Eexp(>IB<)> + +Returns the result I^I. Theoretically, I can be a +multiprecision integer, but the result will be impossibly huge if this +is the case. The exponent I may not be negative. + +=item IB<-Esqrt()> + +Returns the integer square-root of I -- i.e., the largest integer +less than or equal to the true square root. + +=item IB<-Eeq(>IB<)> + +Returns true if I and I are equal; or false otherwise. + +=item IB<-Ecmp(>IB<)> + +Returns -1, 0 or +1 according to whether I is less than, equal to or +greater than I. + +=item IB<-Eand(>IB<)> + +=item IB<-Eand2c(>IB<)> + +=item IB<-Eor(>IB<)> + +=item IB<-Eor2c(>IB<)> + +=item IB<-Exor(>IB<)> + +=item IB<-Exor2c(>IB<)> + +=item IB<-Enand(>IB<)> + +=item IB<-Enand2c(>IB<)> + +=item IB<-Enor(>IB<)> + +=item IB<-Enor2c(>IB<)> + +=item IB<-Enot()> + +=item IB<-Enot2c()> + +Standard bitwise operators. The unadorned methods ignore the sign of +their operands and use only the absolute values. The B<2c> versions use +a two's complement representation, with the sign bit repeated +infinitely. + +=item IB<-Elsl(>IB<)> + +=item IB<-Elsl2c(>IB<)> + +=item IB<-Elsr(>IB<)> + +=item IB<-Elsr2c(>IB<)> + +Standard shifting operators. The unadorned methods treat only absolute +values, while the B<2c> versions use a two's complement representation, +with the sign bit repeated infinitely. + +=item IB<-Esetbit(>IB<)> + +=item IB<-Esetbit2c(>IB<)> + +=item IB<-Eclearbit(>IB<)> + +=item IB<-Eclearbit2c(>IB<)> + +Returns a copy of the argument I with bit I set or clear. The +unadorned methods treat only absolute values, while the B<2c> variants +use a two's complement representation with the sign bit repeated +infinitely. + +=item IB<-Etestbit(>IB<)> + +=item IB<-Etestbit2c(>IB<)> + +Returns true or false according to whether I has bit I set or +clear. The unadorned methods treat only absolute values, while the +B<2c> variant uses a two's complement representation with the sign bit +repeated infinitely. + +=item IB<-Ecopy()> + +Returns a copy of I. Not useful: use assignment instead. + +=item IB<-Egcd(>IB<)> + +Returns the greatest common divisor of I and I. This will never +be negative. In a list context, it also returns two further results, +I and I: if the GCD is I then we have I I + I I = +I. Furthermore, I will have the same sign as I. + +=item IB<-Eodd()> + +Returns a pair of numbers I and I, so that I = I << I, +with I odd and I as large as possible. I will be +multiprecision; I will be a standard Perl integer. + +=item IB<-Emodexp(>IB<,> IB<)> + +Returns I^I mod I. + +=item IB<-Emodinv(>IB<)> + +Returns the inverse of I modulo I. If no inverse exists then +report an error. + +=item IB<-Emodsqrt(>IB<)> + +If I is prime, and I is a quadratic residue mod I, then return +a square root of I mod I. If I is not prime, does something +arbitrary; if I is a nonresidue then report an error. + +=item IB<-Ejac(>IB<)> + +Returns the Jacobi symbol (I/I). If I is prime, then this is +I^((I - 1)/2), i.e., 0 if I is a multiple of I, +1 if I +is a quadratic residue modulo I, or -1 if I is a quadratic +nonresidue mod I. + +=item IB<-Eprimep(>[I]I<)> + +Returns true or false, depending on whether I is (probably) prime. +If I is specified, it must be a random number generator -- see +Catacomb::Crypto(3). + +=item IB<-Ebits()> + +Returns the smallest number of bits required to represent the integer +I. + +=item IB<-Eoctets()> + +Returns the smallest number of bytes required to represent the integer +I, ignoring sign. + +=item IB<-Eoctets2c()> + +Returns the smallest number of bytes required to represent the integer +I as two's complement. This may be one greater than the result +returned by B in the case where the top bit of I is the top +bit of an octet. + +=item IB<-Estoreb(>[I]B<)> + +=item IB<-Estorel(>[I]B<)> + +Return (the absolute value of) I as a raw base-256 string in big- or +little-endian order. The returned string has length I, which +defaults to the smallest nonzero length necessary to represent the +argument. If I is too small, more significant bits are silently +discarded. The sign is ignored. + +=item IB<-Estoreb2c(>[I]B<)> + +=item IB<-Estorel2c(>[I]B<)> + +Return I as a raw two's complement base-256 string in big- or +little-endian order. The returned string has length I, which +defaults to the smallest nonzero length necessary to represent the +argument. If I is too small, more significant bits are silently +discarded. An alternative way to look at this operation is that the +returned value is congruent to I modulo 2^(8 I). + +=item IB<-Etostring(>[I]B<)> + +Return I expressed as a base-I string. The default I +is 10. The result may be preceded by a minus sign if I is negative. +No leading zeroes or other radix prefix are prepended. + +=item IB<-Etoint()> + +Returns I as a Perl integer. If I cannot be represented as a Perl +integer then an undefined result is returned. + +=back + +=head2 Barrett reduction + +Barrett reduction is an efficient way of doing modular reduction on +numbers which aren't too much bigger than the modulus. Barrett +reduction isn't as efficient as Montgomery reduction (see below) but is +simpler and works on even moduli. + +The precomputed information used to perform Barrett reduction are stored +in an object of type B. + +=over + +=item Bnew(>IB<)> + +=item IB<-Ebarrett()> + +Create a new Barrett reduction context, set up for reducing modulo I. + +=item IB<-Em()> + +Returns the modulus stored in the reduction context I. + +=item IB<-Ereduce(>IB<)> + +Let I be the modulus stored in the reduction context I. Then, if +I is nonnegative and less then I^2, returns I mod I. +Otherwise the return value is undefined. + +=item IB<-Eexp(>IB<,> IB<)> + +Let I be the modulus stored in the reduction context I. Then +return I^I mod I. If I is negative then I must have an +inverse modulo I; otherwise you'll get a big mess. + +=back + +=head2 Montgomery reduction + +Montgomery reduction is a clever and efficient way of doing modular +reduction on numbers which aren't too much bigger than the modulus. It +only works if the modulus is positive and odd, and it's a little +complicated. + +Let I be the modulus in question. There is a value I which is +computed in some way from I. The Montgomery reduction operation, +given a number I, actually returns I I^(-1) mod I, which +doesn't sound useful. However, if you multiply all your numbers by a +factor of I then the cleverness becomes clear: if you reduce I +I I^2, you get I I I mod I. Indeed, there's an +efficient multiply-and-reduce operation which takes two operands, each +with a factor of I and returns a result with the factor of I. One +more reduction step drops off the final factor of I to give you the +real answer. Getting numbers into the required form involves +multiplying by I^2 mod I and reducing: conveniently, I^2 mod +I is precomputed. Addition and subtraction leave the factor of I +where it was, so you can just test-and-subtract to reduce. One final +tip, if you're just multiplying two numbers, multiply them together +first, and then multiply the result by I^2 to fix the answer. + +If that all sounded too difficult, then you can use the B method to +convert to internal form, B to multiply numbers in internal form, +B and B to do modular exponentiation, and B to +convert the result to external form. + +The precomputed information used to perform Montgomery reduction are +stored in an object of type B. + +=over + +=item Bnew(>IB<)> + +=item IB<-Emont()> + +Constructs a Montgomery reduction context for reduction modulo I. +Returns B unless I is an odd positive integer. + +=item IB<-Er()> + +Returns the Montgomery reduction factor I. + +=item IB<-Er2()> + +Returns the Montgomerization factor I^2. + +=item IB<-Em()> + +Returns the modulus I. + +=item IB<-Ein(>IB<)> + +Returns the Montgomerized form of I, i.e., I I mod I. I +can be any integer. + +=item IB<-Emul(>IB<,> IB<)> + +Montgomery multiplication. If I and I are Montgomerized, then +returns their Montgomerized product; i.e., I I I^(-1) mod I. + +=item IB<-Eexpr(>IB<,> IB<)> + +Montgomery exponentiation. If I is Montgomerized, then returns the +Montgomerized value of I^I mod I; i.e., if I = I I, +it returns I^I I mod I. Here, if I is negative, then +I must have an inverse modulo I; otherwise there'll be a big mess. + +=item IB<-Emexpr(>IB<,> IB<,> IB<,> IB<,> ...B<)> + +Simultaneous Montgomery exponentiation. If the I are Montgomerized, +then returns the Montgomerized value of I^I I^I ... mod +I; i.e., if I = I I, it returns I^I I^I +... I mod I. Here, if some I is negative, then the +corresponding I must have an inverse modulo I; otherwise there'll +be a big mess. + +=item IB<-Ereduce(>IB<)> + +=item IB<-Eout(>IB<)> + +Returns the unMontgomerized form of I; i.e., I I^(-1) mod I. + +=item IB<-Eexpr(>IB<,> IB<)> + +Modular exponentiation. Returns I^I mod I. Here, if I is +negative, then I must have an inverse modulo I; otherwise there'll +be a big mess. + +=item IB<-Emexpr(>IB<,> IB<,> IB<,> IB<,> ...B<)> + +Simultaneous modular exponentiation. Returns I^I I^I +... mod I. Here, if some I is negative, then the corresponding +I must have an inverse modulo I; otherwise there'll be a big +mess. + +=back + +=head2 Nice prime reduction + +For some numbers, we can do modular reduction quite rapidly. +Specifically, these are numbers of the form + +=over + +2^I - 2^I +/- 2^I +/- ... +/- 2^I + +=back + +where I > I > ... I, for small values of I. We call such +numbers `nice' (that's specific to Catacomb, not a term in general use). +Usually, numbers of interest to us will be prime; hence, we shall speak +of `nice primes'. + +Information for efficient reduction modulo a nice number is stored in an +object of type B. + +=over + +=item Bnew(>IB<)> + +=item IB<-Emkreduce()> + +Create a new nice-modulus reduction context, set up for reducing modulo +I. + +=item IB<-Em()> + +Returns the modulus stored in the reduction context I. + +=item IB<-Ereduce(>IB<)> + +Let I be the modulus stored in the reduction context I. Then, if +I, returns I mod I. Otherwise the return value is undefined. + +=item IB<-Eexp(>IB<,> IB<)> + +Let I be the modulus stored in the reduction context I. Then +return I^I mod I. If I is negative then I must have an +inverse modulo I; otherwise you'll get a big mess. + +=back + +=head2 Chinese Remainder Theorem solution + +Catacomb can solve simultaneous congruence problems, i.e., of the form +I = I (mod I) using the Chinese Remainder Theorem (CRT). It +is required that the I be positive and pairwise relatively prime; +otherwise you'll get an unpleasant mess. + +=over + +=item Bnew(>IB<,> IB<,> ...B<)> + +Construct a new CRT solving context, for solving congruences mod the +I, and return it. + +=item IB<-Eproduct()> + +Returns the product of the moduli I. In a scalar context, return +the number of moduli. + +=item IB<-Emoduli()> + +Returns a list of the I, as passed to B. + +=item IB<-Esolve(>IB<,> IB<,>, ...B<)> + +Returns the unique answer I (modulo the product of the I) to the +congruences I = I (mod I). You will get an unhelpful answer +if any I >= I, and an error if you pass the wrong number of +I arguments. + +=back + +=head1 SEE ALSO + +Catacomb(3). + +=head1 AUTHOR + +Mark Wooding, + diff --git a/Catacomb::MP::Prime.pod b/Catacomb::MP::Prime.pod new file mode 100644 index 0000000..8bd543b --- /dev/null +++ b/Catacomb::MP::Prime.pod @@ -0,0 +1,524 @@ +=head1 NAME + +Catacomb::MP::Prime - prime number generation + +=head1 SYNOPSIS + + use Catacomb qw(:const :mp :random :pgen); + + $p = newprime($nbits, [$rng]); + + $filt = Catacomb::MP::Prime::Filter->new($x); + $filt = $x->filter(); + $rc = $filt->status(); + $x = $filt->m(); + $rc = $filt->step($n); + $rc = $filt->jump($jfilt); + $newfilt = $filt->muladd($mul, $add); # integers + + $stepper = Catacomb::MP::Prime::Filter->stepper($step); # integer + $stepper = filterstepper($step); + $jumper = Catacomb::MP::Prime::Filter->stepper($jump); # MP + $jumper = filterjumper($jump); + + $rabin = Catacomb::MP::Prime::Rabin->new($m); + $rabin = $p->rabin(); + $m = $rabin->m(); + $rc = $rabin->test($wit); + $n = $rabin->iters(); + $n = Catacomb::MP::Prime::Rabin->ntests($bits); + $tester = Catacomb::MP::Prime::Rabin->tester(); + $tester = $rabintester; + + $events = Catacomb::MP::Prime::Gen::Proc->ev(); + $events = Catacomb::MP::Prime::Gen::Proc->evspin(); + $events = Catacomb::MP::Prime::Gen::Proc->subev(); + + $p = Catacomb::MP::Prime->gen + ($name, $x, $nsteps, $stepper, $ntests, $tester, [$events]); + $p = primegen + ($name, $x, $nsteps, $stepper, $ntests, $tester, [$events]); + if (($x, $j) = Catacomb::MP::Prime->strongprime_setup + ($name, $nbits, [$rng], [$nsteps], [$subevents])) { + $p = Catacomb::MP::Prime->gen + ($name, $x, $nsteps, $j, $ntests, $tester, [$events]); + } + ($p, @f) = Catacomb::MP::Prime->limlee + ($name, $qbits, $pbits, [$rng], [$on], [$oev], [$iev]); + ($p, @f) = limleegen + ($name, $qbits, $pbits, [$rng], [$on], [$oev], [$iev]); + + package MyPrimeGenObject; + sub new { ... }; + sub BEGIN { ... }; + sub TRY { ... }; + sub FAIL { ... }; + sub PASS { ... }; + sub DONE { ... }; + sub ABORT { ... }; + $name = $ev->name(); + $x = $ev->m([$xx]); + $rng = $ev->rand(); + +=head1 DESCRIPTION + +The B and related packages provide a framework for +generating prime numbers of various special forms. Read Catacomb::MP(3) +for more information about Catacomb's multiprecision integer support. + +=head2 Simple functions + +=over + +=item BIB<,> [I]B<)> + +Returns a random prime between 2^I and 2^(I+1) (unless +you're very unlucky). Here, I must be a random number generator +object: see Catacomb::Crypto(3). + +=back + +=head2 Result codes + +The following result codes are used by various of the prime-number +generation functions. They may be imported using the B<:consts> tag. + +=over + +=item B + +About to test a new candidate prime discovered by filtering. This +shouldn't be returned by functions, but it is used as part of the +event-handling system. + +=item B + +A new candidate has been found by a filter, but has not yet passed a +primality test. + +=item B + +The number is definitely composite. + +=item B + +The number has passed at least one primality test, and is therefore +likely to be prime. + +=item B + +The number is definitely prime. + +=item B + +The search for a prime number has been aborted. + +=back + +=head2 Filtering for small primes + +The class B implements a relatively +efficient technique for finding numbers with no small factors. + +=over + +=item IB<-Esmallfactor()> + +Returns B if I is definitely prime (and therefore fairly +small), B if it has some small factor, or B if it +has no small factors but might be composite anyway. + +=item Bnew(>IB<)> + +=item IB<-Efilter()> + +Returns a new small-primes filter, initially looking at the number +I. + +=item IB<-Em()> + +Returns the current number I in the filter. + +=item IB<-Estatus()> + +Returns the state (a B code) for the current number I in the +filter. This will usually be B if I has a small factor, +or B if not; though B is also possible if I is +small enough. + +=item IB<-Estep(>IB<)> + +Advances the number in the filter by a small step I, returning +the new status. + +=item IB<-Ejump(>IB<)> + +Advances the number in the filter by a large jump, as represented by +another filter I. This is useful for finding a prime which has +the form I I + I for some other prime I -- store 2 I in +a filter and use it as a jump to search for another prime. + +=item IB<-Emuladd(>IB<,> IB<)> + +Returns a new filter whose number is I I + I. + +=back + +=head2 Miller-Rabin primality tests + +Catacomb's main primality test is the Miller-Rabin test. It is a +probabilistic test, with a 1/4 probability that any particular test will +fail to recognize a given number as being composite. However, it is +important to observe that this is not the same as the probability that a +random number is composite given that it passed a test -- this latter is +much smaller. + +=over + +=item Bnew(>IB<)> + +=item IB<-Erabin()> + +Constructs a new Rabin-Miller testing context for the purpose of testing +the candidate I. Returns B if I is negative or even. + +=item IB<-Em()> + +Returns the integer under test in the given context. + +=item IB<-Etest(>IB<)> + +Tests I with witness I. Returns B or B. +The witness should usually be chosen randomly. + +=item IB<-Eiters()> + +Returns the recommended number of tests for the candidate under test, +assuming that we came across the candidate at random. + +=item Bntests(>IB<)> + +Returns the recommended number of tests for a candidate which is +I bits long, assuming that we came across the candidate at +random. + +=back + +=head2 Prime generation concepts + +The prime generator is based on the concepts of I, I +and I. + +=over + +=item * + +Steppers are responsible for producing candidate primes, and (usually) +testing them for small factors (e.g., using B). A +stepper is expected to be relatively fast, and leave the heavy lifting +to testers. + +=item * + +Testers are responsible for applying primality tests to candidates. + +=item * + +Event handlers report interesting events during prime generation, to +maintain a progress display or similar. + +=back + +These various kinds of objects all have essentially the same interface, +which is built from I. An event contains all the useful +information about the current progress of a prime generation task. +Events are objects of type B, though +fortunately one rarely needs to type this. Event objects can't be +created by Perl code. + +=over + +=item IB<-Ename()> + +Returns the name of the prime being generated. + +=item IB<-Em(>[I]B<)> + +Returns the current candidate prime. If I is supplied then it +sets a new candidate prime. This is used by the stepper interface. + +=item IB<-Esteps()> + +Returns the number of steps remaining before the generation task fails. + +=item IB<-Etests()> + +Returns the name of tests remaining before the generation task succeeds. + +=item IB<-Erand()> + +Returns a pseudorandom number generator which is likely to be fast but +not cryptographically strong. + +=back + +=head2 Built-in steppers and testers + +=over + +=item Bstepper(>IB<)> + +=item BIB<)> + +Returns a stepper object which steps on by I (a small Perl +integer) until it finds a number with no small prime factors. + +=item Bjumper(>IB<)> + +=item IB<-Ejumper()> + +Returns a jumper object which jumps on by I (a large +multiprecision integer) until it finds a number with no small prime +factors. + +=item Btester()> + +Returns a tester object which applies an iteration of the Miller-Rabin +probabilistic primality test. In fact, there only needs to be one of +these, so it's called B<$rabintester>. + +=item Bev()> + +A standard event handler which prints the name of the prime being +generated and a string of C<.> and C<+> signs for failures and +successes, such as is relatively commonplace. In fact, there only needs +to be one of these, so it's called B<$pg_events>. + +=item Bevspin()> + +An event handler which shows a spinning baton while it works. This is +mainly used as the subsidiary event handler when generating Lim-Lee +primes. There only needs to be one of these, so it's called +B<$pg_evspin>. + +=item Bsubev()> + +An event handler which works like B above, but puts square +brackets around its output. Also suitable for use in Lim-Lee +generation. There only needs to be one of these, so it's called +B<$pg_subev>. + +=back + +=head2 Prime generation + +Prime generation is driven by the procedure +Bgen()>, which is also named B for +convenience. + +=over + +=item Bgen(>IB<,> IB<,> IB<,> IB<,> IB<,> IB<,> [I]B<)> + +=item BIB<,> IB<,> IB<,> IB<,> IB<,> IB<,> [I]B<)> + +Generates a prime number. It will start with the integer I, and run +the I for at most I times (infinitely if I is +zero), returning B if it fails. Each time the stepper reports a +plausible candidate, it runs the tester up to I times; it +returns the candidate if all these tests succeeded. It will call the +event handler after each step and test. + +=back + +=head2 Writing your own steppers, testers and event handlers + +As mentioned, steppers, testers and event handlers have similar +interfaces. Each is represented by an object whose class is a +descendent (via B<@ISA>) of B. The +prime generator will call methods on your object as required. + +Event handlers are the easiest, so we deal with them first. All methods +are called with one argument which is the event object. The methods +called are as follows. + +=over + +=item B + +Prime generation has begun. + +=item B + +About to start testing a new number. + +=item B + +Number passed a primality test. + +=item B + +Number failed a primality test. + +=item B + +Prime number found successfully. + +=item B + +No prime number found; we gave up. + +=back + +Any of these methods may return B (-1) to abandon prime +searching. This is intended to be used, for example, by a progress +dialogue box if its cancel button is pressed. Any other value is +ignored. + +Here's a simple example of an event handler. + + package Strange::Events; + @ISA = qw(Catacomb::MP::Prime::Gen::Proc); + + sub new { bless {}, $_[0]; } + + sub PG_BEGIN { + my ($me, $ev) = @_; + local $| = 1; + print $ev->name(), " ["; + } + + sub PG_PASS { local $| = 1; print "*"; } + sub PG_FAIL { local $| = 1; print "."; } + sub PG_ABORT { local $| = 1; print "] :-(\n"; } + sub PG_DONE { local $| = 1; print "]\n"; } + +Steppers use fewer methods, but are a bit more involved. + +=over + +=item B + +Initialize the stepper. Read the starting point from the event, or +store a new starting point, as appropriate. Return B if the +starting point is satisfactory, B for failure, or B +to run the tester. + +=item B + +Advance the stepper. Write the new number to the event. Return as for +B. + +=item B + +All is over. Tidy up. + +=back + +Testers are similar. + +=over + +=item B + +Initialize the tester. Read the starting point from the event. Return +B if the starting point is satisfactory, B if +you've actually run a successful test, B to reject the +candidate, or B to proceed to testing. + +=item B + +Run a test. Return B if the number is satisfactory, +B if it passed a test, or B if it failed. + +=item B + +Testing is done. Tidy up. + +=back + +Finally, any method can return B to stop prime generation in +its tracks almost immediately. (The B methods are still called +for the stepper, and for the tester if it's active.) + +It's probably best to do tidying in B rather than leaving it +until B, since testers and steppers and things may get left +around for a while, espectially if they're simple. + +Since steppers and testers often work together, here's an example of a +pair for generating I. A prime number I is +Sophie-Germain prime if 2 I + 1 is also prime. We work by +maintaining separate filters and testing contexts for I and 2 I + +1, and checking both in parallel. Generating Sophie Germain primes is a +long job. + + package SophieGermain::Stepper; + use Catacomb qw(:const :mp :pgen); + @ISA = qw(Catacomb::MP::Prime::Gen::Proc); + + sub new { bless [undef, undef], $_[0]; } + + sub _step { + my ($me, $ev) = @_; + while ($me->[0]->status() == PGEN_FAIL || + $me->[1]->status() == PGEN_FAIL) { + $me->[0]->step(2); + $me->[1]->step(4); + } + $ev->m($me->[0]->m()); + return PGEN_TRY; + } + + sub PG_BEGIN { + my ($me, $ev) = @_; + my $x = $ev->m(); + $me->[0] = $x->filter(); + $me->[1] = (2*$x + 1)->filter(); + _step($me, $ev); + } + + sub PG_TRY { + my ($me, $ev) = @_; + $me->[0]->step(2); + $me->[1]->step(4); + _step($me, $ev); + } + + sub PG_DONE { + my ($me, $ev) = @_; + $me->[0] = $me->[1] = undef; + } + + package SophieGermain::Tester; + use Catacomb qw(:const :mp :pgen); + @ISA = qw(Catacomb::MP::Prime::Gen::Proc); + + sub new { bless [undef, undef], $_[0]; } + + sub PG_BEGIN { + my ($me, $ev) = @_; + my $x = $ev->m(); + $me->[0] = $x->rabin(); + $me->[1] = (2*$x + 1)->rabin(); + return PGEN_TRY; + } + + sub _test { + my ($r, $rabin) = @_; + my $w = $r->mprange($rabin->m()); + return $rabin->test($w) == PGEN_PASS; + } + + sub PG_TRY { + my ($me, $ev) = @_; + my $r = $ev->rand(); + my $w = $r->mprange($me->[0]->m()); + return _test($r, $me->[0]) && _test($r, $me->[1]) ? + PGEN_PASS : PGEN_FAIL; + } + + sub PG_DONE { + my ($me, $ev) = @_; + $me->[0] = $me->[1] = undef; + } + diff --git a/Makefile.PL b/Makefile.PL index 88318e2..9d06e47 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -28,6 +28,17 @@ use ExtUtils::MakeMaker; use Config; +sub pmfix { + my $h = {}; + foreach my $i (@_) { + my $f = $i; + $f =~ s!::!/!; + $f .= ".pm"; + $h->{$f} = "\$(INST_LIBDIR)/$f"; + } + return $h; +} + WriteMakefile(NAME => "Catacomb", DISTNAME => "catacomb-perl", AUTHOR => "Mark Wooding (mdw\@nsict.org)", @@ -37,12 +48,17 @@ WriteMakefile(NAME => "Catacomb", @{[qw(algs mpstuff catacomb algstuff keystuff pgproc utils)]}), CONFIGURE => \&configure, + PM => pmfix(Catacomb, Catacomb::Base, Catacomb::Cache, + Catacomb::MP, Catacomb::Field, Catacomb::EC, + Catacomb::Group, Catacomb::GF, Catacomb::Rand, + Catacomb::Crypto, Catacomb::Key), + PERL_MALLOC_OK => 1, PL_FILES => { 'algs.PL' => 'algs.c' }, depend => { '$(MAKEFILE)' => '$(VERSION_FROM)', 'catacomb.c' => join(" ", grep { s/$/.xs/ } @{[qw(catacomb algorithms mp field ec - gf misc pgen key)]}) + gf misc pgen key group pubkey)]}) }, VERSION_FROM => "Catacomb.pm"); diff --git a/algorithms.xs b/algorithms.xs index 6001d9d..6a01f15 100644 --- a/algorithms.xs +++ b/algorithms.xs @@ -25,16 +25,22 @@ # 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::CipherClass - -PROTOTYPES: DISABLE +MODULE = Catacomb PACKAGE = Catacomb::PRPClass -gccipher * +PRPClass * find(me, name) SV *me char *name - CODE: - RETVAL = (gccipher *)gcipher_byname(name); + PREINIT: + int i; + CODE: + RETVAL = 0; + for (i = 0; prptab[i]; i++) { + if (strcmp(name, prptab[i]->name) == 0) { + RETVAL = prptab[i]; + break; + } + } OUTPUT: RETVAL @@ -42,11 +48,117 @@ SV * list(me) SV *me PREINIT: - const gccipher *const *cc; - SV *sv; + int i; PPCODE: - for (cc = gciphertab; *cc; cc++) - XPUSHs(RET((gccipher *)*cc, "Catacomb::CipherClass")); + for (i = 0; prptab[i]; i++) + XPUSHs(RET(prptab[i], "Catacomb::PRPClass")); + +keysize * +keysz(p) + PRPClass *p + CODE: + RETVAL = p->ksz; + OUTPUT: + RETVAL + +char * +name(p) + PRPClass *p + CODE: + RETVAL = p->name; + OUTPUT: + RETVAL + +UV +blksz(p) + PRPClass *p + CODE: + RETVAL = p->blksz; + OUTPUT: + RETVAL + +PRP * +init(p, k) + PRPClass *p + SV *k + PREINIT: + char *pp; + STRLEN len; + CODE: + pp = SvPV(k, len); + if (keysz(len, p->ksz) != len) + croak("key size mismatch"); + RETVAL = sub_alloc(sizeof(PRP) + p->ctxsz); + RETVAL->c = p; + p->init(RETVAL + 1, pp, len); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::PRP + +SV * +DESTROY(p) + PRP *p + CODE: + sub_free(p, sizeof(PRP) + p->c->ctxsz); + XSRETURN_YES; + +SV * +eblk(p, x) + PRP *p + SV *x + PREINIT: + char *pp; + STRLEN len; + CODE: + pp = SvPV(x, len); + if (len != p->c->blksz) + croak("block size mismatch"); + RETVAL = NEWSV(0, p->c->blksz); + p->c->eblk(p + 1, pp, SvPVX(RETVAL)); + SvPOK_on(RETVAL); + SvCUR_set(RETVAL, p->c->blksz); + OUTPUT: + RETVAL + +SV * +dblk(p, x) + PRP *p + SV *x + PREINIT: + char *pp; + STRLEN len; + CODE: + pp = SvPV(x, len); + if (len != p->c->blksz) + croak("block size mismatch"); + RETVAL = NEWSV(0, p->c->blksz); + p->c->dblk(p + 1, pp, SvPVX(RETVAL)); + SvPOK_on(RETVAL); + SvCUR_set(RETVAL, p->c->blksz); + OUTPUT: + RETVAL + +PRPClass * +class(p) + PRP *p + CODE: + RETVAL = p->c; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::CipherClass + +PROTOTYPES: DISABLE + +gccipher * +find(me, name) + SV *me + char *name + CODE: + RETVAL = (gccipher *)gcipher_byname(name); + OUTPUT: + RETVAL keysize * keysz(cc) @@ -96,7 +208,7 @@ DESTROY(c) gcipher *c CODE: c->ops->destroy(c); - XSRETURN_UNDEF; + XSRETURN_YES; SV * encrypt(c, plain) @@ -144,14 +256,14 @@ setiv(c, iv) c->ops->c->name, (unsigned long)c->ops->c->blksz); } c->ops->setiv(c, p); - XSRETURN_UNDEF; + XSRETURN_YES; SV * bdry(c) gcipher *c CODE: c->ops->bdry(c); - XSRETURN_UNDEF; + XSRETURN_YES; gccipher * class(c) @@ -172,16 +284,6 @@ find(me, name) OUTPUT: RETVAL -SV * -list(me) - SV *me - PREINIT: - const gchash *const *hc; - SV *sv; - PPCODE: - for (hc = ghashtab; *hc; hc++) - XPUSHs(RET((gchash *)*hc, "Catacomb::HashClass")); - size_t hashsz(hc) gchash *hc @@ -213,7 +315,7 @@ DESTROY(h) ghash *h CODE: h->ops->destroy(h); - XSRETURN_UNDEF; + XSRETURN_YES; SV * hash(h, sv) @@ -225,7 +327,7 @@ hash(h, sv) CODE: p = SvPV(sv, len); h->ops->hash(h, p, len); - XSRETURN_UNDEF; + XSRETURN_YES; SV * done(h) @@ -270,7 +372,6 @@ list(me) SV *me PREINIT: const gcMAC *const *mc; - SV *sv; PPCODE: for (mc = gmactab; *mc; mc++) XPUSHs(RET((gcMAC *)*mc, "Catacomb::MACClass")); @@ -323,7 +424,7 @@ DESTROY(m) gMAC *m CODE: m->ops->destroy(m); - XSRETURN_UNDEF; + XSRETURN_YES; ghash * init(m) @@ -351,7 +452,7 @@ seedint(r, seed) if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDUINT32)) croak("rng `%s' doesn't support `seedint'", r->ops->name); r->ops->misc(r, GRAND_SEEDUINT32, seed); - XSRETURN_UNDEF; + XSRETURN_YES; SV * seedblock(r, seed) @@ -365,7 +466,7 @@ seedblock(r, seed) croak("rng `%s' doesn't support `seedblock'", r->ops->name); p = SvPV(seed, len); r->ops->misc(r, GRAND_SEEDBLOCK, p, len); - XSRETURN_UNDEF; + XSRETURN_YES; SV * seedmp(r, seed) @@ -375,7 +476,7 @@ seedmp(r, seed) if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDMP)) croak("rng `%s' doesn't support `seedmp'", r->ops->name); r->ops->misc(r, GRAND_SEEDMP, seed); - XSRETURN_UNDEF; + XSRETURN_YES; SV * seedrand(r, seed) @@ -385,7 +486,7 @@ seedrand(r, seed) if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDRAND)) croak("rng `%s' doesn't support `seedrand'", r->ops->name); r->ops->misc(r, GRAND_SEEDRAND, seed); - XSRETURN_UNDEF; + XSRETURN_YES; U32 raw(r) @@ -506,14 +607,14 @@ gate(r) Rand_True *r CODE: r->ops->misc(r, RAND_GATE); - XSRETURN_UNDEF; + XSRETURN_YES; SV * stretch(r) Rand_True *r CODE: r->ops->misc(r, RAND_STRETCH); - XSRETURN_UNDEF; + XSRETURN_YES; SV * key(r, k) @@ -525,14 +626,14 @@ key(r, k) CODE: p = SvPV(k, len); r->ops->misc(r, RAND_KEY, p, len); - XSRETURN_UNDEF; + XSRETURN_YES; SV * noisesrc(r) Rand_True *r CODE: r->ops->misc(r, RAND_NOISESRC, &noise_source); - XSRETURN_UNDEF; + XSRETURN_YES; SV * seed(r, bits = 160) @@ -540,7 +641,7 @@ seed(r, bits = 160) int bits CODE: r->ops->misc(r, RAND_SEED, bits); - XSRETURN_UNDEF; + XSRETURN_YES; MODULE = Catacomb PACKAGE = Catacomb::Rand::Fib @@ -585,7 +686,7 @@ passes(r, n) unsigned n CODE: r->ops->misc(r, DSARAND_PASSES, n); - XSRETURN_UNDEF; + XSRETURN_YES; SV * seed(r) @@ -635,7 +736,8 @@ new(me, k, n = 0) MODULE = Catacomb PACKAGE = Catacomb::Rand::MGF SV * -new(name, k) +new(me, name, k) + SV *me char *name SV *k CODE: @@ -643,16 +745,11 @@ new(name, k) OUTPUT: RETVAL -void -list(me) - SV *me - PPCODE: - listrand(mgftab); - MODULE = Catacomb PACKAGE = Catacomb::Rand::Counter SV * -new(name, k) +new(me, name, k) + SV *me char *name SV *k CODE: @@ -660,16 +757,11 @@ new(name, k) OUTPUT: RETVAL -void -list(me) - SV *me - PPCODE: - listrand(ctrtab); - MODULE = Catacomb PACKAGE = Catacomb::Rand::OFB SV * -new(name, k) +new(me, name, k) + SV *me char *name SV *k CODE: @@ -677,18 +769,12 @@ new(name, k) OUTPUT: RETVAL -void -list(me) - SV *me - PPCODE: - listrand(ofbtab); - MODULE = Catacomb PACKAGE = Catacomb::Rand::Magic SV * DESTROY(r) grand *r CODE: - XSRETURN_UNDEF; + XSRETURN_YES; #----- That's all, folks ---------------------------------------------------- diff --git a/algs.PL b/algs.PL index 26c1fe3..cab2dc5 100644 --- a/algs.PL +++ b/algs.PL @@ -62,7 +62,7 @@ sub cross { return @$x; } -open OUT, "> $ARGV[0]" or die "couldn't write `$ARGV[0].c': $!"; +open OUT, "> $ARGV[0]" or die "couldn't write `$ARGV[0]': $!"; print OUT <\n"), "\n"; print OUT cross("#include \n"), "\n"; print OUT cross("#include \n"), "\n"; @@ -101,4 +102,40 @@ print OUT <name; rt++) XPUSHs(sv_2mortal(newSVpvn((char *)rt->name, strlen(rt->name)))); + PUTBACK; } /*----- That's all, folks -------------------------------------------------*/ diff --git a/catacomb-perl.h b/catacomb-perl.h index ec6d8af..ef36efc 100644 --- a/catacomb-perl.h +++ b/catacomb-perl.h @@ -35,16 +35,18 @@ /*----- Header files ------------------------------------------------------*/ +#include + #include #include #include -#include #include #include #include #include +#include #include #include #include @@ -56,12 +58,20 @@ #include #include +#include +#include + #include #include #include #include #include +#include +#include +#include +#include +#include #include #include #include @@ -83,16 +93,60 @@ struct consttab { const char *name; UV val; }; +typedef struct cursor { + unsigned f; + union { + HV *hv; + struct { AV *av; unsigned i; } a; + } u; +} cursor; +#define CF_ARRAY 0u +#define CF_HASH 1u +#define CF_MUST 1u + 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, ...); +extern void *ptrfromsvdflt(SV *sv, const char *type, void *dflt, + const char *what); +extern void c_init(cursor *c, SV *sv); +extern void c_skip(cursor *c); +extern SV *c_get(cursor *c, const char *tag, unsigned f); +extern ge *groupelt(SV *sv, const char *what); +extern mp *fieldelt(SV *sv, const char *what); +extern ec *ecpt(SV *sv, 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) +#define C_MP(c, tag) mp_fromsv(c_get(c, tag, CF_MUST), tag, 0, 0) +#define C_PTR(c, tag, type) ptrfromsv(c_get(c, tag, CF_MUST), type, tag) +#define C_PTRDFLT(c, tag, type, def) \ + ptrfromsvdflt(c_get(c, tag, 0), type, def, tag) +#define C_GE(c, tag) groupelt(c_get(c, tag, CF_MUST), tag) +#define C_FE(c, tag) fieldelt(c_get(c, tag, CF_MUST), tag) +#define C_EC(c, tag) ecpt(c_get(c, tag, CF_MUST), tag) +extern void hvput(HV *hv, const char *k, SV *val); /*----- Crypto algorithms -------------------------------------------------*/ +typedef struct PRPClass { + char *name; + const octet *ksz; + size_t ctxsz; + size_t blksz; + void (*init)(void *ctx, const void *k, size_t sz); + void (*eblk)(const void *ctx, const void *in, void *out); + void (*dblk)(const void *ctx, const void *in, void *out); +} PRPClass; + +typedef struct PRP { + PRPClass *c; +} PRP; + +extern PRPClass *const prptab[]; + struct randtab { const char *name; grand *(*rand)(const void *, size_t); }; typedef const octet keysize; @@ -101,25 +155,46 @@ typedef gcmac gcMAC; typedef grand Rand_True, Rand_DSA; +typedef rsa_pubctx RSA_Public; +typedef rsa_privctx RSA_Private; + +typedef gfshare Share_GF; +typedef share Share_Prime; + extern const struct randtab mgftab[], ctrtab[], ofbtab[]; +extern void gdsa_privfromsv(gdsa *g, SV *sv); +extern void gdsa_pubfromsv(gdsa *g, SV *sv); 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_File { + unsigned ref; + key_file kf; +} Key_File; + typedef struct Key { - key_file *kf; + Key_File *kf; key *k; } Key; +typedef struct Key_AttrIter { + Key_File *kf; + key_attriter i; +} Key_AttrIter; 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); +typedef key_data Key_DataImpl; +typedef struct Key_FileIter { + Key_File *kf; + key_iter i; +} Key_FileIter; +typedef sym_iter Key_StructIter; +typedef key_filter Key_Filter; + +extern void keyreport(const char *file, int line, const char *err, void *p); extern SV *keyerr(int rc); /*------ Multiprecision maths ---------------------------------------------*/ @@ -132,9 +207,11 @@ typedef mpcrt MP_CRT; typedef mpreduce MP_Reduce; typedef gfreduce GF_Reduce; -typedef ec EC_Point; typedef ec_curve EC_Curve; typedef field Field; +typedef mp fe; + +typedef group Group; #define XSINTERFACE_FUNC_SETMP(cv, f) \ CvXSUBANY(cv).any_dptr = (void (*) _((void *)))(mp_##f) @@ -142,17 +219,19 @@ typedef field Field; CvXSUBANY(cv).any_dptr = (void (*) _((void *)))(gf_##f) #define SET_MP(sv, x) SET(sv, x, "Catacomb::MP") +#define MAKE_MP(x) MAKE(x, "Catacomb::MP") #define RET_MP(x) RET(x, "Catacomb::MP") #define SET_GF(sv, x) SET(sv, x, "Catacomb::GF") +#define MAKE_GF(x) MAKE(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, const char *ty, - int radix, int keep, ...); +extern mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...); +extern int group_writesv(group *g, ge *x, SV *sv); /*----- Prime generation --------------------------------------------------*/ @@ -170,6 +249,12 @@ extern void pgproc_get(SV *sv, pgen_proc **p, void **ctx); /*----- Other gear --------------------------------------------------------*/ +extern void names(const char *name); + +extern SV *info_field(field *f); +extern SV *info_curve(ec_curve *c); +extern SV *info_group(group *g); + extern field *copy_field(field *f); extern ec_curve *copy_curve(ec_curve *c); extern group *copy_group(group *g); diff --git a/catacomb.xs b/catacomb.xs index 0f010b4..5bcc441 100644 --- a/catacomb.xs +++ b/catacomb.xs @@ -28,39 +28,58 @@ #include "catacomb-perl.h" +const struct consttab ct[] = { +#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(DH_SUBGROUP), + 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(KERR_MALFORMED), + C(KERR_IO), + C(KWRITE_OK), C(KWRITE_FAIL), C(KWRITE_BROKEN), + C(FTY_PRIME), C(FTY_BINARY), +#undef C + { 0, 0 }, +}; + MODULE = Catacomb PACKAGE = Catacomb U32 -const(name) +_const(name) char *name PREINIT: - const struct consttab ct[] = { -#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(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 }, - }; CODE: RETVAL = findconst(ct, "Catacomb", name); OUTPUT: RETVAL +void +_constants() + PREINIT: + int i; + PPCODE: + for (i = 0; ct[i].name; i++) + XPUSHs(sv_2mortal(newSVpv(ct[i].name, 0))); + +void +list(name) + const char *name + PPCODE: + PUTBACK; + names(name); + SPAGAIN; + PROTOTYPES: DISABLE INCLUDE: algorithms.xs @@ -68,6 +87,8 @@ INCLUDE: mp.xs INCLUDE: gf.xs INCLUDE: field.xs INCLUDE: ec.xs +INCLUDE: group.xs +INCLUDE: pubkey.xs INCLUDE: misc.xs INCLUDE: pgen.xs INCLUDE: key.xs diff --git a/ec.xs b/ec.xs index f546ab3..83d1f72 100644 --- a/ec.xs +++ b/ec.xs @@ -27,13 +27,14 @@ MODULE = Catacomb PACKAGE = Catacomb::EC::Point PREFIX = ec_ -EC_Point * -new(x = 0, y = 0, z = 0) +ec * +new(me, x = 0, y = 0, z = 0) + SV *me mp *x mp *y mp *z CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); if (x && y) { RETVAL->x = MP_COPY(x); @@ -46,7 +47,7 @@ new(x = 0, y = 0, z = 0) bool atinfp(p) - EC_Point *p + ec *p CODE: RETVAL = EC_ATINF(p); OUTPUT: @@ -54,7 +55,7 @@ atinfp(p) mp * x(p) - EC_Point *p + ec *p CODE: RETVAL = p->x ? MP_COPY(p->x) : 0; OUTPUT: @@ -62,7 +63,7 @@ x(p) mp * y(p) - EC_Point *p + ec *p CODE: RETVAL = p->y ? MP_COPY(p->y) : 0; OUTPUT: @@ -70,7 +71,7 @@ y(p) mp * z(p) - EC_Point *p + ec *p CODE: RETVAL = p->z ? MP_COPY(p->z) : 0; OUTPUT: @@ -78,54 +79,98 @@ z(p) bool ec_eq(p, q) - EC_Point *p - EC_Point *q + ec *p + ec *q SV * DESTROY(p) - EC_Point *p + ec *p CODE: EC_DESTROY(p); DESTROY(p); XSRETURN_YES; +SV * +put(p) + ec *p + PREINIT: + buf b; + size_t n = EC_ATINF(p) ? 2 : 4 + mp_octets(p->x) + mp_octets(p->y); + CODE: + RETVAL = NEWSV(0, n); + buf_init(&b, SvPVX(RETVAL), n); + if (buf_putec(&b, p)) + croak("unexpected failure in Catacomb::EC::Point::put"); + SvCUR_set(RETVAL, BLEN(&b)); + OUTPUT: + RETVAL + +void +get(s) + SV *s + PREINIT: + ec *p; + buf b; + char *q; + STRLEN n; + CODE: + q = SvPV(s, n); + buf_init(&b, q, n); + p = CREATE(ec); + EC_CREATE(p); + if (buf_getec(&b, p)) + DESTROY(p); + else { + XPUSHs(RET(p, "Catacomb::EC::Point")); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(BCUR(&b), BLEFT(&b)))); + } + MODULE = Catacomb PACKAGE = Catacomb::EC::Curve PREFIX = ec_ EC_Curve * -ec_prime(me, f, a, b) +prime(me, f, a, b) SV *me Field *f mp *a mp *b - C_ARGS: - f, a, b + CODE: + RETVAL = ec_prime(f, a, b); + OUTPUT: + RETVAL EC_Curve * -ec_primeproj(me, f, a, b) +primeproj(me, f, a, b) SV *me Field *f mp *a mp *b - C_ARGS: - f, a, b + CODE: + RETVAL = ec_primeproj(f, a, b); + OUTPUT: + RETVAL EC_Curve * -ec_bin(me, f, a, b) +bin(me, f, a, b) SV *me Field *f gf *a gf *b - C_ARGS: - f, a, b + CODE: + RETVAL = ec_bin(f, a, b); + OUTPUT: + RETVAL EC_Curve * -ec_binproj(me, f, a, b) +binproj(me, f, a, b) SV *me Field *f gf *a gf *b - C_ARGS: - f, a, b + CODE: + RETVAL = ec_binproj(f, a, b); + OUTPUT: + RETVAL char * name(c) @@ -135,17 +180,88 @@ name(c) OUTPUT: RETVAL +mp * +_a(c) + EC_Curve *c + CODE: + RETVAL = F_OUT(c->f, MP_NEW, c->a); + OUTPUT: + RETVAL + +mp * +_b(c) + EC_Curve *c + CODE: + RETVAL = F_OUT(c->f, MP_NEW, c->a); + OUTPUT: + RETVAL + +Field * +field(c) + EC_Curve *c + CODE: + RETVAL = copy_field(c->f); + OUTPUT: + RETVAL + +SV * +get(c) + EC_Curve *c + CODE: + RETVAL = info_curve(c); + OUTPUT: + RETVAL + bool ec_samep(me, c) EC_Curve *me EC_Curve *c -EC_Point * -find(c, x) +SV * +putraw(c, p) EC_Curve *c - mp *x + ec *p + PREINIT: + buf b; + size_t n = c->f->noctets * 2 + 1; + CODE: + RETVAL = NEWSV(0, n); + buf_init(&b, SvPVX(RETVAL), n); + if (ec_putraw(c, &b, p)) + croak("unexpected failure in Catacomb::EC::Curve::putraw"); + SvCUR_set(RETVAL, BLEN(&b)); + OUTPUT: + RETVAL + +void +_getraw(c, s) + EC_Curve *c + SV *s + PREINIT: + ec *p; + buf b; + char *q; + STRLEN n; CODE: - RETVAL = CREATE(EC_Point); + q = SvPV(s, n); + buf_init(&b, q, n); + p = CREATE(ec); + EC_CREATE(p); + if (ec_getraw(c, &b, &p)) + DESTROY(p); + else { + XPUSHs(RET(p, "Catacomb::EC::Point")); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(BCUR(&b), BLEFT(&b)))); + } + +ec * +_find(c, x) + EC_Curve *c + fe *x + CODE: + RETVAL = CREATE(ec); + EC_CREATE(RETVAL); if (!ec_find(c, RETVAL, x)) { DESTROY(RETVAL); RETVAL = 0; @@ -153,142 +269,123 @@ find(c, x) OUTPUT: RETVAL -EC_Point * -rand(c, r = &rand_global) +ec * +_rand(c, r = &rand_global) EC_Curve *c grand *r CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); + EC_CREATE(RETVAL); ec_rand(c, RETVAL, r); OUTPUT: RETVAL -EC_Point * +ec * neg(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); ec_neg(c, RETVAL, p); OUTPUT: RETVAL -EC_Point * +ec * add(c, p, q) EC_Curve *c - EC_Point *p - EC_Point *q + ec *p + ec *q CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); ec_add(c, RETVAL, p, q); OUTPUT: RETVAL -EC_Point * +ec * sub(c, p, q) EC_Curve *c - EC_Point *p - EC_Point *q + ec *p + ec *q CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); ec_sub(c, RETVAL, p, q); OUTPUT: RETVAL -EC_Point * +ec * dbl(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); ec_dbl(c, RETVAL, p); OUTPUT: RETVAL -bool -ec_check(c, p) +SV * +check(c, p) EC_Curve *c - EC_Point *p + ec *p + CODE: + if (ec_check(c, p)) + XSRETURN_UNDEF; + XSRETURN_YES; -EC_Point * +ec * mul(c, p, x) EC_Curve *c - EC_Point *p + ec *p mp *x CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); 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 * +ec * in(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_IN(c, RETVAL, p); OUTPUT: RETVAL -EC_Point * +ec * out(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_OUT(c, RETVAL, p); OUTPUT: RETVAL -EC_Point * +ec * fix(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_FIX(c, RETVAL, p); OUTPUT: RETVAL -EC_Point * +ec * ifind(c, x) EC_Curve *c mp *x CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); if (!EC_FIND(c, RETVAL, x)) { DESTROY(RETVAL); RETVAL = 0; @@ -296,47 +393,47 @@ ifind(c, x) OUTPUT: RETVAL -EC_Point * +ec * ineg(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_NEG(c, RETVAL, p); OUTPUT: RETVAL -EC_Point * +ec * iadd(c, p, q) EC_Curve *c - EC_Point *p - EC_Point *q + ec *p + ec *q CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_ADD(c, RETVAL, p, q); OUTPUT: RETVAL -EC_Point * +ec * isub(c, p, q) EC_Curve *c - EC_Point *p - EC_Point *q + ec *p + ec *q CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_SUB(c, RETVAL, p, q); OUTPUT: RETVAL -EC_Point * +ec * idbl(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); EC_DBL(c, RETVAL, p); OUTPUT: @@ -345,25 +442,25 @@ idbl(c, p) bool icheck(c, p) EC_Curve *c - EC_Point *p + ec *p CODE: RETVAL = EC_CHECK(c, p); OUTPUT: RETVAL -EC_Point * +ec * imul(c, p, x) EC_Curve *c - EC_Point *p + ec *p mp *x CODE: - RETVAL = CREATE(EC_Point); + RETVAL = CREATE(ec); EC_CREATE(RETVAL); ec_imul(c, RETVAL, p, x); OUTPUT: RETVAL -EC_Point * +ec * immul(c, ...) EC_Curve *c PREINIT: @@ -377,8 +474,8 @@ immul(c, ...) 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); + v[j].base = *ecpt(ST(i), "p_i"); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0); } RETVAL = CREATE(RETVAL); EC_CREATE(RETVAL); @@ -388,19 +485,37 @@ immul(c, ...) RETVAL void -getinfo(me, p) +_getinfo(me, p) + SV *me char *p PREINIT: ec_info i; const char *e; - EC_Point *pt; + ec *pt; PPCODE: if ((e = ec_getinfo(&i, p)) != 0) croak("bad curve spec: %s", e); - pt = CREATE(EC_Point); + pt = CREATE(ec); *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")); +const char * +checkinfo(c, g, r, h, rng = &rand_global) + EC_Curve *c + ec *g + mp *r + mp *h + grand *rng + PREINIT: + ec_info ei; + CODE: + ei.c = c; + ei.g = *g; + ei.r = r; + ei.h = h; + RETVAL = ec_checkinfo(&ei, rng); + OUTPUT: + RETVAL diff --git a/field.xs b/field.xs index 5121979..78067c4 100644 --- a/field.xs +++ b/field.xs @@ -97,23 +97,23 @@ type(f) OUTPUT: RETVAL -mp * -zero(f) +fe * +_zero(f) Field *f CODE: RETVAL = MP_COPY(f->zero); OUTPUT: RETVAL -mp * -one(f) +fe * +_one(f) Field *f CODE: RETVAL = MP_COPY(f->one); OUTPUT: RETVAL -mp * +fe * m(f) Field *f CODE: @@ -121,6 +121,14 @@ m(f) OUTPUT: RETVAL +fe * +q(f) + Field *f + CODE: + RETVAL = MP_COPY(f->q); + OUTPUT: + RETVAL + UV nbits(f) Field *f @@ -137,8 +145,8 @@ noctets(f) OUTPUT: RETVAL -mp * -rand(f, r = &rand_global) +fe * +_rand(f, r = &rand_global) Field *f grand *r CODE: @@ -155,19 +163,19 @@ samep(f, ff) OUTPUT: RETVAL -mp * +fe * in(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_IN(f, MP_NEW, x); OUTPUT: RETVAL -mp * +fe * out(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_OUT(f, MP_NEW, x); OUTPUT: @@ -176,91 +184,93 @@ out(f, x) bool zerop(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_ZEROP(f, x); OUTPUT: RETVAL -mp * +fe * neg(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_NEG(f, MP_NEW, x); OUTPUT: RETVAL -mp * +fe * add(f, x, y) Field *f - mp *x - mp *y + fe *x + fe *y CODE: RETVAL = F_ADD(f, MP_NEW, x, y); OUTPUT: RETVAL -mp * +fe * sub(f, x, y) Field *f - mp *x - mp *y + fe *x + fe *y CODE: RETVAL = F_SUB(f, MP_NEW, x, y); OUTPUT: RETVAL -mp * +fe * mul(f, x, y) Field *f - mp *x - mp *y + fe *x + fe *y CODE: RETVAL = F_MUL(f, MP_NEW, x, y); OUTPUT: RETVAL -mp * +fe * sqr(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_SQR(f, MP_NEW, x); OUTPUT: RETVAL -mp * +fe * inv(f, x) Field *f - mp *x + fe *x CODE: + if (F_ZEROP(f, x)) + croak("division by zero"); RETVAL = F_INV(f, MP_NEW, x); OUTPUT: RETVAL -mp * +fe * reduce(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_REDUCE(f, MP_NEW, x); OUTPUT: RETVAL -mp * +fe * sqrt(f, x) Field *f - mp *x + fe *x CODE: RETVAL = F_SQRT(f, MP_NEW, x); OUTPUT: RETVAL -mp * +fe * quadsolve(f, x) Field *f - mp *x + fe *x CODE: if (F_TYPE(f) != FTY_BINARY) croak("quadsolve only works on binary fields"); @@ -268,10 +278,10 @@ quadsolve(f, x) OUTPUT: RETVAL -mp * +fe * dbl(f, x) Field *f - mp *x + fe *x CODE: if (F_TYPE(f) != FTY_PRIME) croak("dbl only works on prime fields"); @@ -279,10 +289,10 @@ dbl(f, x) OUTPUT: RETVAL -mp * +fe * tpl(f, x) Field *f - mp *x + fe *x CODE: if (F_TYPE(f) != FTY_PRIME) croak("tpl only works on prime fields"); @@ -290,10 +300,10 @@ tpl(f, x) OUTPUT: RETVAL -mp * +fe * qdl(f, x) Field *f - mp *x + fe *x CODE: if (F_TYPE(f) != FTY_PRIME) croak("qdl only works on prime fields"); @@ -301,10 +311,10 @@ qdl(f, x) OUTPUT: RETVAL -mp * +fe * hlv(f, x) Field *f - mp *x + fe *x CODE: if (F_TYPE(f) != FTY_PRIME) croak("hlv only works on prime fields"); @@ -312,3 +322,10 @@ hlv(f, x) OUTPUT: RETVAL +SV * +get(f) + Field *f + CODE: + RETVAL = info_field(f); + OUTPUT: + RETVAL diff --git a/finger.pl b/finger.pl new file mode 100644 index 0000000..11c8fb2 --- /dev/null +++ b/finger.pl @@ -0,0 +1,33 @@ +use ExtUtils::testlib; +use Catacomb; + +package Report; + +sub new { bless [], $_[0]; } +sub report { my ($me, @info) = @_; push(@$me, \@info); } +sub done { + my ($me) = @_; + if (@$me) { + print STDERR "Errors reading key file:\n"; + foreach my $i (@$me) { + printf STDERR " %s:%d: %s\n", @$i; + } + exit(1); + } +} + +package main; + +my $fn = shift || "keyring"; +my $rep = Report->new(); +$kf = Catacomb::Key::File->new($fn, KFILE_READ, $rep) + or die("error opening keyring: $!"); +$rep->done(); +$hcn = shift || "rmd160"; +$hc = Catacomb::HashClass->find($hcn) or die("no hash algorithm `$hcn'"); +$filt = Catacomb::Key::Filter->new("-secret"); +for (my $i = $kf->iterate(); my $k = $i->next(); ) { + $h = $hc->init(); + $fp = $k->fingerprint($h, $filt); + print unpack("H*", $h->done()), " ", $k->fulltag(), "\n"; +} diff --git a/gf.xs b/gf.xs index 3ea6464..270d69c 100644 --- a/gf.xs +++ b/gf.xs @@ -34,7 +34,7 @@ new(me, sv = 0, radix = 0) SV *sv int radix CODE: - RETVAL = sv ? mp_fromsv(sv, "sv", "Catacomb::GF", radix, 1) : MP_ZERO; + RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO; OUTPUT: RETVAL @@ -72,70 +72,6 @@ loadl(me, sv) 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 @@ -159,9 +95,32 @@ binop(a, b) INTERFACE: add sub mul +mp * +logop(a, b) + gf *a + gf *b + C_ARGS: + MP_NEW, a, b + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + and or xor nand nor + +mp * +unop(a) + gf *a + C_ARGS: + MP_NEW, a + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + not + gf * shiftop(a, n) - mp *a + gf *a int n C_ARGS: MP_NEW, a, n @@ -171,14 +130,17 @@ shiftop(a, n) INTERFACE: lsl lsr -int -gf_eq(a, b) +gf * +flipbits(a, n) gf *a - gf *b - CODE: - RETVAL = mp_eq(a, b); - OUTPUT: - RETVAL + unsigned long n + C_ARGS: + MP_NEW, a, n + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + setbit clearbit int gf_irreduciblep(a) @@ -235,15 +197,6 @@ gcd(a, b) 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 * diff --git a/group.xs b/group.xs new file mode 100644 index 0000000..51af11c --- /dev/null +++ b/group.xs @@ -0,0 +1,428 @@ +# ---?--- +# +# $Id$ +# +# Abstract groups +# +# (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::Group PREFIX = group_ + +Group * +prime(me, p, g, q) + SV *me + mp *p + mp *g + mp *q + PREINIT: + gprime_param gp; + CODE: + gp.p = p; + gp.q = q; + gp.g = g; + RETVAL = group_prime(&gp); + OUTPUT: + RETVAL + +Group * +binary(me, p, g, q) + SV *me + mp *p + mp *g + mp *q + PREINIT: + gbin_param gb; + CODE: + gb.p = p; + gb.q = q; + gb.g = g; + RETVAL = group_binary(&gb); + OUTPUT: + RETVAL + +Group * +ec(me, c, g, r, h) + SV *me + EC_Curve *c + ec *g + mp *r + mp *h + PREINIT: + ec_info ei; + CODE: + ei.c = copy_curve(c); + EC_CREATE(&ei.g); + EC_COPY(&ei.g, g); + ei.r = MP_COPY(r); + ei.h = MP_COPY(h); + RETVAL = group_ec(&ei); + OUTPUT: + RETVAL + +Group * +byname(me, n) + SV *me + char *n + PREINIT: + const char *e; + CODE: + if ((e = group_fromstring(n, &RETVAL)) != 0) + croak("bad group name: `%s'", e); + OUTPUT: + RETVAL + +SV * +DESTROY(g) + Group *g + CODE: + G_DESTROYGROUP(g); + XSRETURN_YES; + +ge * +_i(g) + Group *g + CODE: + RETVAL = G_CREATE(g); + G_COPY(g, RETVAL, g->i); + OUTPUT: + RETVAL + +ge * +_g(g) + Group *g + CODE: + RETVAL = G_CREATE(g); + G_COPY(g, RETVAL, g->g); + OUTPUT: + RETVAL + +mp * +r(g) + Group *g + CODE: + RETVAL = MP_COPY(g->r); + OUTPUT: + RETVAL + +mp * +h(g) + Group *g + CODE: + RETVAL = MP_COPY(g->h); + OUTPUT: + RETVAL + +bool +group_samep(g, h) + Group *g + Group *h + +void +check(g, rng = &rand_global) + Group *g + grand *rng + PREINIT: + const char *e; + PPCODE: + e = G_CHECK(g, rng); + if (!e) + XSRETURN_YES; + XPUSHs(&PL_sv_undef); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpv(e, 0))); + +SV * +_checkelt(g, x) + Group *g + ge *x + CODE: + if (group_check(g, x)) + XSRETURN_UNDEF; + else + XSRETURN_YES; + +SV * +_destroyelement(g, x) + Group *g + ge *x + CODE: + G_DESTROY(g, x); + XSRETURN_YES; + +bool +_identp(g, x) + Group *g + ge *x + CODE: + RETVAL = G_IDENTP(g, x); + OUTPUT: + RETVAL + +SV * +get(g) + Group *g + CODE: + RETVAL = info_group(g); + OUTPUT: + RETVAL + +bool +_eq(g, x, y) + Group *g + ge *x + ge *y + CODE: + RETVAL = G_EQ(g, x, y); + OUTPUT: + RETVAL + +ge * +_mul(g, x, y) + Group *g + ge *x + ge *y + CODE: + RETVAL = G_CREATE(g); + G_MUL(g, RETVAL, x, y); + OUTPUT: + RETVAL + +ge * +_sqr(g, x) + Group *g + ge *x + CODE: + RETVAL = G_CREATE(g); + G_SQR(g, RETVAL, x); + OUTPUT: + RETVAL + +ge * +_inv(g, x) + Group *g + ge *x + CODE: + RETVAL = G_CREATE(g); + G_INV(g, RETVAL, x); + OUTPUT: + RETVAL + +ge * +_div(g, x, y) + Group *g + ge *x + ge *y + CODE: + RETVAL = G_CREATE(g); + G_DIV(g, RETVAL, x, y); + OUTPUT: + RETVAL + +ge * +_exp(g, x, n) + Group *g + ge *x + mp *n + CODE: + RETVAL = G_CREATE(g); + G_EXP(g, RETVAL, x, n); + OUTPUT: + RETVAL + +ge * +_mexp(g, ...) + Group *g + PREINIT: + group_expfactor *v; + size_t i, j, n; + CODE: + if (items < 3 || !(items & 1)) { + croak("Usage: Catacomb::Group::mexp" + "(g, x_0, n_0, x_1, n_1, ..."); + } + n = (items - 1)/2; + v = xmalloc(n * sizeof(group_expfactor)); + for (i = 1, j = 0; i < items; i += 2, j++) { + v[j].base = ptrfromsv(ST(i), "Catacomb::Group::Element", "p_i"); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0); + } + RETVAL = G_CREATE(g); + G_MEXP(g, RETVAL, v, n); + xfree(v); + OUTPUT: + RETVAL + +mp * +_toint(g, x) + Group *g + ge *x + CODE: + RETVAL = G_TOINT(g, MP_NEW, x); + OUTPUT: + RETVAL + +ge * +_fromint(g, x) + Group *g + mp *x + CODE: + RETVAL = G_CREATE(g); + if (G_FROMINT(g, RETVAL, x)) { + G_DESTROY(g, RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +ec * +_toec(g, x) + Group *g + ge *x + CODE: + RETVAL = CREATE(ec); + EC_CREATE(RETVAL); + if (G_TOEC(g, RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +ge * +_fromec(g, x) + Group *g + ec *x + CODE: + RETVAL = G_CREATE(g); + if (G_FROMEC(g, RETVAL, x)) { + G_DESTROY(g, RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +SV * +_putbuf(g, x) + Group *g + ge *x + PREINIT: + buf b; + size_t n = g->noctets + 8; /* Guess */ + CODE: + RETVAL = NEWSV(0, n); + buf_init(&b, SvPVX(RETVAL), n); + if (G_TOBUF(g, &b, x)) + croak("unexpected failure in Catacomb::Group::putbuf"); + SvCUR_set(RETVAL, BLEN(&b)); + OUTPUT: + RETVAL + +void +_getbuf(g, s) + Group *g + SV *s + PREINIT: + ge *x; + buf b; + char *q; + STRLEN n; + CODE: + q = SvPV(s, n); + buf_init(&b, q, n); + x = G_CREATE(g); + if (G_FROMBUF(g, &b, x)) + G_DESTROY(g, x); + else { + XPUSHs(RET(x, "Catacomb::Group::Element")); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(BCUR(&b), BLEFT(&b)))); + } + +SV * +_putraw(g, x) + Group *g + ge *x + PREINIT: + buf b; + size_t n = g->noctets; + CODE: + RETVAL = NEWSV(0, n); + buf_init(&b, SvPVX(RETVAL), n); + if (G_TORAW(g, &b, x)) + croak("unexpected failure in Catacomb::Group::putraw"); + SvCUR_set(RETVAL, BLEN(&b)); + OUTPUT: + RETVAL + +void +_getraw(g, s) + Group *g + SV *s + PREINIT: + ge *x; + buf b; + char *q; + STRLEN n; + CODE: + q = SvPV(s, n); + buf_init(&b, q, n); + x = G_CREATE(g); + if (G_FROMRAW(g, &b, x)) + G_DESTROY(g, x); + else { + XPUSHs(RET(x, "Catacomb::Group::Element")); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(BCUR(&b), BLEFT(&b)))); + } + +SV * +_tostring(g, x) + Group *g + ge *x + CODE: + RETVAL = NEWSV(0, 64); + if (group_writesv(g, x, RETVAL)) { + SvREFCNT_dec(RETVAL); + XSRETURN_UNDEF; + } + OUTPUT: + RETVAL + +void +_fromstring(g, s) + Group *g + SV *s + PREINIT: + mptext_stringctx ms; + STRLEN len; + ge *x; + PPCODE: + ms.buf = SvPV(s, len); + ms.lim = ms.buf + len; + x = G_CREATE(g); + if (G_READ(g, x, &mptext_stringops, &ms)) + G_DESTROY(g, x); + else { + XPUSHs(RET(x, "Catacomb::Group::Element")); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(ms.buf, ms.lim - ms.buf))); + } diff --git a/key.xs b/key.xs index d4162e9..d14ad70 100644 --- a/key.xs +++ b/key.xs @@ -27,6 +27,14 @@ MODULE = Catacomb PACKAGE = Catacomb::Key PREFIX = key_ +SV * +DESTROY(k) + Key *k + CODE: + keyfile_dec(k->kf); + DESTROY(k); + XSRETURN_YES; + bool key_chkident(me, p) SV *me @@ -57,8 +65,8 @@ del(k) OUTPUT: RETVAL -Key_Data * -data(k) +Key_DataImpl * +_data(k) Key *k CODE: RETVAL = &k->k->k; @@ -102,20 +110,20 @@ key_setcomment(k, p) Key *k char *p C_ARGS: - k->kf, k->k, p + &k->kf->kf, k->k, p KeyErr key_settag(k, p) Key *k char *p C_ARGS: - k->kf, k->k, p + &k->kf->kf, k->k, p KeyErr key_delete(k) Key *k C_ARGS: - k->kf, k->k + &k->kf->kf, k->k SV * fulltag(k) @@ -124,7 +132,7 @@ fulltag(k) dstr d = DSTR_INIT; CODE: key_fulltag(k->k, &d); - RETVAL = newSVpv(d.buf, d.len); + RETVAL = newSVpvn(d.buf, d.len); dstr_destroy(&d); OUTPUT: RETVAL @@ -134,25 +142,35 @@ key_getattr(k, a) Key *k char *a C_ARGS: - k->kf, k->k, a + &k->kf->kf, k->k, a KeyErr -key_putattr(k, a, v) +putattr(k, a, v = &PL_sv_undef) Key *k char *a - char *v - C_ARGS: - k->kf, k->k, a, v + SV *v + PREINIT: + char *vv; + STRLEN len; + CODE: + if (!SvOK(v)) + vv = 0; + else + vv = SvPV(v, len); + RETVAL = key_putattr(&k->kf->kf, k->k, a, vv); + OUTPUT: + RETVAL -void -attrlist(k) +Key_AttrIter * +attriter(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)))); + CODE: + RETVAL = CREATE(Key_AttrIter); + key_mkattriter(&RETVAL->i, k->k); + RETVAL->kf = k->kf; + k->kf->ref++; + OUTPUT: + RETVAL bool expiredp(k) @@ -166,31 +184,22 @@ KeyErr key_expire(k) Key *k C_ARGS: - k->kf, k->k + &k->kf->kf, k->k KeyErr key_used(k, t) Key *k time_t t C_ARGS: - k->kf, k->k, t + &k->kf->kf, k->k, t bool -fingerprint(k, h, kfiltstr) +key_fingerprint(k, h, kf = 0) 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 + Key_Filter *kf + C_ARGS: + k->k, h, kf const char * key_strerror(me, err) @@ -199,10 +208,98 @@ key_strerror(me, err) C_ARGS: err -MODULE = Catacomb PACKAGE = Catacomb::Key::Data PREFIX = key_ +MODULE = Catacomb PACKAGE = Catacomb::Key::AttrIter + +void +next(i) + Key_AttrIter *i + PREINIT: + const char *a, *v; + PPCODE: + if (key_nextattr(&i->i, &a, &v)) { + XPUSHs(sv_2mortal(newSVpv(a, 0))); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpv(v, 0))); + } + +SV * +DESTROY(i) + Key_AttrIter *i + CODE: + keyfile_dec(i->kf); + DESTROY(i); + XSRETURN_YES; + +MODULE = Catacomb PACKAGE = Catacomb::Key::Filter + +Key_Filter * +new(me, f = 0, m = 0) + SV *me + SV *f + SV *m + PREINIT: + char *p; + STRLEN len; + CODE: + RETVAL = CREATE(Key_Filter); + if (!f || !SvOK(f)) + RETVAL->f = RETVAL->m = 0; + else if (m) { + RETVAL->f = SvUV(f); + RETVAL->m = SvUV(m); + } else { + p = SvPV(f, len); + if (key_readflags(p, 0, &RETVAL->f, &RETVAL->m)) { + DESTROY(RETVAL); + RETVAL = 0; + } + } + OUTPUT: + RETVAL + +SV * +DESTROY(kf) + Key_Filter *kf + CODE: + if (!kf) + XSRETURN_UNDEF; + DESTROY(kf); + XSRETURN_YES; + +SV * +tostring(kf) + Key_Filter *kf + PREINIT: + dstr d = DSTR_INIT; + CODE: + if (!kf) + XSRETURN_UNDEF; + key_writeflags(kf->f, &d); + RETVAL = newSVpvn(d.buf, d.len); + dstr_destroy(&d); + OUTPUT: + RETVAL + +UV +f(kf) + Key_Filter *kf + CODE: + RETVAL = kf ? kf->f : 0; + OUTPUT: + RETVAL -Key_Data * -_new(me) +UV +m(kf) + Key_Filter *kf + CODE: + RETVAL = kf ? kf->m : 0; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Key::DataImpl PREFIX = key_ + +Key_DataImpl * +new(me) SV *me CODE: RETVAL = CREATE(key_data); @@ -213,101 +310,127 @@ _new(me) RETVAL SV * -destroy(kd) - Key_Data *kd +free(kd) + Key_DataImpl *kd + CODE: + key_destroy(kd); + DESTROY(kd); + XSRETURN_YES; + +SV * +clear(kd) + Key_DataImpl *kd CODE: key_destroy(kd); + kd->e = 0; + kd->u.k.k = 0; + kd->u.k.sz = 0; XSRETURN_YES; SV * setbinary(kd, sv) - Key_Data *kd + Key_DataImpl *kd SV *sv PREINIT: char *p; STRLEN len; CODE: p = SvPV(sv, len); + key_destroy(kd); key_binary(kd, p, len); XSRETURN_YES; SV * setencrypted(kd, sv) - Key_Data *kd + Key_DataImpl *kd SV *sv PREINIT: char *p; STRLEN len; CODE: p = SvPV(sv, len); + key_destroy(kd); key_encrypted(kd, p, len); XSRETURN_YES; SV * setmp(kd, x) - Key_Data *kd + Key_DataImpl *kd mp *x CODE: + key_destroy(kd); key_mp(kd, x); XSRETURN_YES; SV * setstring(kd, p) - Key_Data *kd + Key_DataImpl *kd char *p CODE: + key_destroy(kd); key_string(kd, p); XSRETURN_YES; SV * setec(kd, p) - Key_Data *kd - EC_Point *p + Key_DataImpl *kd + ec *p CODE: + key_destroy(kd); key_ec(kd, p); XSRETURN_YES; U32 flags(kd) - Key_Data *kd + Key_DataImpl *kd CODE: RETVAL = kd->e; OUTPUT: RETVAL SV * +setflags(kd, f) + Key_DataImpl *kd + U32 f + CODE: + if (f & KF_ENCMASK) + croak("can't change encoding flags"); + kd->e = (kd->e & KF_ENCMASK) | (f & ~KF_ENCMASK); + XSRETURN_YES; + +SV * getbinary(kd) - Key_Data *kd + Key_DataImpl *kd CODE: if ((kd->e & KF_ENCMASK) != KENC_BINARY) croak("key is not binary"); - RETVAL = newSVpv(kd->u.k.k, kd->u.k.sz); + RETVAL = newSVpvn(kd->u.k.k, kd->u.k.sz); OUTPUT: RETVAL SV * getencrypted(kd) - Key_Data *kd + Key_DataImpl *kd CODE: if ((kd->e & KF_ENCMASK) != KENC_ENCRYPT) croak("key is not encrypted"); - RETVAL = newSVpv(kd->u.k.k, kd->u.k.sz); + RETVAL = newSVpvn(kd->u.k.k, kd->u.k.sz); OUTPUT: RETVAL mp * getmp(kd) - Key_Data *kd + Key_DataImpl *kd CODE: if ((kd->e & KF_ENCMASK) != KENC_MP) croak("key is not bignum"); - RETVAL = kd->u.m; + RETVAL = MP_COPY(kd->u.m); OUTPUT: RETVAL -EC_Point * +ec * getec(kd) - Key_Data *kd + Key_DataImpl *kd CODE: if ((kd->e & KF_ENCMASK) != KENC_EC) croak("key is not a curve point"); @@ -319,7 +442,7 @@ getec(kd) char * getstring(kd) - Key_Data *kd + Key_DataImpl *kd CODE: if ((kd->e & KF_ENCMASK) != KENC_STRING) croak("key is not string"); @@ -329,36 +452,42 @@ getstring(kd) SV * setstruct(kd) - Key_Data *kd + Key_DataImpl *kd CODE: + key_destroy(kd); key_structure(kd); XSRETURN_YES; -Key_Data * +Key_DataImpl * key_structfind(kd, tag) - Key_Data *kd + Key_DataImpl *kd char *tag + INIT: + if ((kd->e & KF_ENCMASK) != KENC_STRUCT) + XSRETURN_UNDEF; -Key_Data * +Key_DataImpl * key_structcreate(kd, tag) - Key_Data *kd + Key_DataImpl *kd char *tag + INIT: + if ((kd->e & KF_ENCMASK) != KENC_STRUCT) + croak("key is not structured"); -void -getstruct(kd) - Key_Data *kd - PREINIT: - sym_iter i; - key_struct *ks; - PPCODE: +Key_StructIter * +structiter(kd) + Key_DataImpl *kd + CODE: 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")); + RETVAL = CREATE(Key_StructIter); + sym_mkiter(RETVAL, &kd->u.s); + OUTPUT: + RETVAL SV * structdel(kd, tag) - Key_Data *kd + Key_DataImpl *kd char *tag PREINIT: key_struct *ks; @@ -367,113 +496,135 @@ structdel(kd, tag) croak("key is not structured"); if ((ks = sym_find(&kd->u.s, tag, -1, 0, 0)) == 0) XSRETURN_UNDEF; + key_destroy(&ks->k); 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))); +bool +key_match(kd, kf) + Key_DataImpl *kd + Key_Filter *kf -SV * -getflags(me, f) - SV *me - U32 f +bool +set(kd, kkd, kf = 0) + Key_DataImpl *kd + Key_DataImpl *kkd + Key_Filter *kf + CODE: + key_destroy(kd); + kd->e = 0; + kd->u.k.k = 0; + kd->u.k.sz = 0; + RETVAL = key_copy(kd, kkd, kf); + OUTPUT: + RETVAL + +Key_DataImpl * +lock(kd, key) + Key_DataImpl *kd + SV *key PREINIT: - dstr d = DSTR_INIT; + STRLEN len; + char *p; CODE: - key_writeflags(f, &d); - RETVAL = newSVpv(d.buf, d.len); - dstr_destroy(&d); + if ((kd->e & KF_ENCMASK) == KENC_ENCRYPT) + croak("already encrypted"); + RETVAL = CREATE(Key_DataImpl); + p = SvPV(key, len); + key_lock(RETVAL, kd, p, len); OUTPUT: RETVAL -Key_Data * -copy(kd, kfiltstr = 0) - Key_Data *kd - char *kfiltstr +Key_DataImpl * +unlock(kd, key) + Key_DataImpl *kd + SV *key PREINIT: - key_filter kfilt; + STRLEN len; + char *p; + int rc; 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)) { + if ((kd->e & KF_ENCMASK) != KENC_ENCRYPT) + croak("not encrypted"); + RETVAL = CREATE(Key_DataImpl); + p = SvPV(key, len); + if ((rc = key_unlock(RETVAL, kd, p, len)) != 0) { DESTROY(RETVAL); + keyerr(rc); RETVAL = 0; } OUTPUT: RETVAL -Key_Data * +Key_DataImpl * plock(kd, tag) - Key_Data *kd + Key_DataImpl *kd char *tag + PREINIT: + int rc; CODE: - RETVAL = CREATE(Key_Data); - if (key_plock(tag, kd, RETVAL)) { + if ((kd->e & KF_ENCMASK) == KENC_ENCRYPT) + croak("already encrypted"); + RETVAL = CREATE(Key_DataImpl); + if ((rc = key_plock(tag, kd, RETVAL)) != 0) { DESTROY(RETVAL); + keyerr(rc); RETVAL = 0; } OUTPUT: RETVAL -Key_Data * +Key_DataImpl * punlock(kd, tag) - Key_Data *kd + Key_DataImpl *kd char *tag + PREINIT: + int rc; CODE: - RETVAL = CREATE(Key_Data); - if (key_punlock(tag, kd, RETVAL)) { + if ((kd->e & KF_ENCMASK) != KENC_ENCRYPT) + croak("not encrypted"); + RETVAL = CREATE(Key_DataImpl); + if ((rc = key_punlock(tag, kd, RETVAL)) != 0) { DESTROY(RETVAL); + keyerr(rc); RETVAL = 0; } OUTPUT: RETVAL -Key_Data * +void read(me, p) SV *me char *p - CODE: - RETVAL = CREATE(key_data); - if (key_read(p, RETVAL, 0)) { - DESTROY(RETVAL); - RETVAL = 0; + PREINIT: + key_data *kd; + char *pp; + PPCODE: + kd = CREATE(key_data); + if (key_read(p, kd, &pp)) + DESTROY(kd); + else { + XPUSHs(RET(kd, "Catacomb::Key::DataImpl")); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(pp, strlen(pp)))); } - OUTPUT: - RETVAL SV * -write(kd, kfiltstr = 0) - Key_Data *kd - char *kfiltstr +write(kd, kf = 0) + Key_DataImpl *kd + Key_Filter *kf 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); + if (key_write(kd, &d, kf)) + RETVAL = newSVpvn(d.buf, d.len); else RETVAL = &PL_sv_undef; dstr_destroy(&d); OUTPUT: RETVAL -Key_Data * +Key_DataImpl * decode(me, sv) SV *me SV *sv @@ -491,35 +642,79 @@ decode(me, sv) RETVAL SV * -encode(kd, kfiltstr = 0) - Key_Data *kd - char *kfiltstr +encode(kd, kf = 0) + Key_DataImpl *kd + Key_Filter *kf 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); + if (key_encode(kd, &d, kf)) + RETVAL = newSVpvn(d.buf, d.len); else RETVAL = &PL_sv_undef; dstr_destroy(&d); OUTPUT: RETVAL +MODULE = Catacomb PACKAGE = Catacomb::Key::StructIter + +SV * +next(i) + Key_StructIter *i + PREINIT: + key_struct *s; + CODE: + if ((s = sym_next(i)) == 0) + XSRETURN_UNDEF; + RETVAL = newSVpvn(SYM_NAME(s), SYM_LEN(s)); + OUTPUT: + RETVAL + +SV * +DESTROY(i) + Key_StructIter *i + CODE: + DESTROY(i); + XSRETURN_YES; + +MODULE = Catacomb PACKAGE = Catacomb::Key::Data + +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 = newSVpvn(d.buf, d.len); + dstr_destroy(&d); + OUTPUT: + RETVAL + MODULE = Catacomb PACKAGE = Catacomb::Key::File PREFIX = key_ Key_File * -new(me, file, how) +new(me, file, how = KOPEN_READ, report = &PL_sv_undef) SV *me char *file unsigned how + SV *report CODE: RETVAL = CREATE(key_file); - if (key_open(RETVAL, file, how, warn_keyreporter, 0)) { + if (key_open(&RETVAL->kf, file, how, keyreport, report)) { DESTROY(RETVAL); RETVAL = 0; } @@ -530,65 +725,34 @@ SV * DESTROY(kf) Key_File *kf CODE: - key_close(kf); - DESTROY(kf); + keyfile_dec(kf); XSRETURN_UNDEF; KeyErr -merge(kf, name, fp) +merge(kf, name, fp, report = &PL_sv_undef) Key_File *kf char *name FILE *fp + SV *report CODE: - RETVAL = key_merge(kf, name, fp, warn_keyreporter, 0); + RETVAL = key_merge(&kf->kf, name, fp, keyreport, report); OUTPUT: RETVAL bool -extract(kf, k, fp, kfiltstr = 0) +key_extract(kf, k, fp, kfilt = 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 + Key_Filter *kfilt + C_ARGS: + &kf->kf, k->k, fp, kfilt 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); + C_ARGS: + &kf->kf Key * bytype(kf, type) @@ -596,9 +760,10 @@ bytype(kf, type) char *type CODE: RETVAL = CREATE(Key); - if ((RETVAL->k = key_bytype(kf, type)) != 0) + if ((RETVAL->k = key_bytype(&kf->kf, type)) != 0) { + kf->ref++; RETVAL->kf = kf; - else { + } else { DESTROY(RETVAL); RETVAL = 0; } @@ -611,9 +776,10 @@ byid(kf, id) U32 id CODE: RETVAL = CREATE(Key); - if ((RETVAL->k = key_byid(kf, id)) != 0) + if ((RETVAL->k = key_byid(&kf->kf, id)) != 0) { + kf->ref++; RETVAL->kf = kf; - else { + } else { DESTROY(RETVAL); RETVAL = 0; } @@ -626,28 +792,72 @@ bytag(kf, tag) char *tag CODE: RETVAL = CREATE(Key); - if ((RETVAL->k = key_bytag(kf, tag)) != 0) + if ((RETVAL->k = key_bytag(&kf->kf, tag)) != 0) { + kf->ref++; RETVAL->kf = kf; - else { + } else { DESTROY(RETVAL); RETVAL = 0; } OUTPUT: RETVAL -void -list(kf) +Key * +newkey(kf, id, type, exp) Key_File *kf + U32 id + const char *type + time_t exp 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")); + int err; + CODE: + RETVAL = CREATE(Key); + if ((RETVAL->k = key_new(&kf->kf, id, type, exp, &err)) == 0) { + DESTROY(RETVAL); + keyerr(err); + RETVAL = 0; + } else { + kf->ref++; + RETVAL->kf = kf; + } + OUTPUT: + RETVAL + + +Key_FileIter * +iterate(kf) + Key_File *kf + CODE: + RETVAL = CREATE(Key_FileIter); + key_mkiter(&RETVAL->i, &kf->kf); + RETVAL->kf = kf; + kf->ref++; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Key::FileIter + +Key * +next(ki) + Key_FileIter *ki + CODE: + RETVAL = CREATE(Key); + if ((RETVAL->k = key_next(&ki->i)) == 0) { + DESTROY(RETVAL); + RETVAL = 0; + } else { + RETVAL->kf = ki->kf; + ki->kf->ref++; } + OUTPUT: + RETVAL + +SV * +DESTROY(ki) + Key_FileIter *ki + CODE: + keyfile_dec(ki->kf); + DESTROY(ki); + XSRETURN_YES; #----- That's all, folks ---------------------------------------------------- diff --git a/keystuff.c b/keystuff.c index b8c9519..beb9a74 100644 --- a/keystuff.c +++ b/keystuff.c @@ -32,9 +32,31 @@ /*----- Main code ---------------------------------------------------------*/ -void warn_keyreporter(const char *file, int line, const char *err, void *p) +void keyreport(const char *file, int line, const char *err, void *p) { - warn("%s:%i: keyfile error: %s", file, line, err); + SV *sv = p; + dSP; + + if (!SvOK(sv)) + warn("%s:%i: keyfile error: %s", file, line, err); + else { + ENTER; SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv); + XPUSHs(sv_2mortal(newSVpv(file, 0))); + XPUSHs(sv_2mortal(newSViv(line))); + XPUSHs(sv_2mortal(newSVpv(err, 0))); + PUTBACK; + + call_method("report", G_DISCARD | G_EVAL | G_KEEPERR); + if (SvTRUE(ERRSV)) { + STRLEN len; + warn("reporter raised error (ignoring): %s", SvPV(ERRSV, len)); + } + + FREETMPS; LEAVE; + } } SV *keyerr(int rc) @@ -49,4 +71,15 @@ SV *keyerr(int rc) return (&PL_sv_undef); } +void keyfile_dec(Key_File *kf) +{ + kf->ref--; + if (!kf->ref) { + key_discard(&kf->kf); + DESTROY(kf); + } +} + + + /*----- That's all, folks -------------------------------------------------*/ diff --git a/misc.xs b/misc.xs index e7484dd..d0eb19d 100644 --- a/misc.xs +++ b/misc.xs @@ -1,6 +1,6 @@ # ---?--- # -# $Id: misc.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Miscellaneous function interfaces # @@ -25,6 +25,223 @@ # 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::Share::GF PREFIX = gfshare_ + +Share_GF * +new(me, t, sz) + SV *me + UV t + UV sz + CODE: + RETVAL = CREATE(Share_GF); + if (t < 1 || t > 255) + croak("share threshhold out of range"); + gfshare_create(RETVAL, t, sz); + OUTPUT: + RETVAL + +UV +sz(s) + Share_GF *s + CODE: + RETVAL = s->sz; + OUTPUT: + RETVAL + +UV +t(s) + Share_GF *s + CODE: + RETVAL = s->t; + OUTPUT: + RETVAL + +UV +i(s) + Share_GF *s + CODE: + RETVAL = s->i; + OUTPUT: + RETVAL + +SV * +DESTROY(s) + Share_GF *s + CODE: + gfshare_destroy(s); + DESTROY(s); + XSRETURN_YES; + +SV * +mkshares(s, x, r = &rand_global) + Share_GF *s + SV *x + grand *r + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(x, len); + if (len != s->sz) + croak("secret length mismatch"); + gfshare_mkshares(s, r, p); + s->i = ~0u; + XSRETURN_YES; + +SV * +get(s, i) + Share_GF *s + UV i + CODE: + if (i >= 255) + croak("share index out of range"); + if (s->i != ~0u) + croak("not making shares"); + RETVAL = NEWSV(0, s->sz); + SvPOK_on(RETVAL); + gfshare_get(s, i, SvPVX(RETVAL)); + SvCUR_set(RETVAL, s->sz); + OUTPUT: + RETVAL + +unsigned +add(s, i, x) + Share_GF *s + UV i + SV *x + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(x, len); + if (len != s->sz) + croak("secret length mismatch"); + if (i == ~0u) + croak("making shares"); + if (i >= 255) + croak("share index out of range"); + if (s->i >= s->t) + croak("too many shares"); + RETVAL = gfshare_add(s, i, p); + OUTPUT: + RETVAL + +SV * +combine(s) + Share_GF *s + CODE: + if (s->i == ~0u) + croak("making shares"); + if (s->i != s->t) + croak("not enough shares yet"); + RETVAL = NEWSV(0, s->sz); + SvPOK_on(RETVAL); + gfshare_combine(s, SvPVX(RETVAL)); + SvCUR_set(RETVAL, s->sz); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Share::Prime PREFIX = share_ + +Share_Prime * +new(me, t, p = &PL_sv_undef) + SV *me + UV t + SV *p + CODE: + RETVAL = CREATE(Share_Prime); + if (t < 1 || t > MPW_MAX) + croak("share threshhold out of range"); + share_create(RETVAL, t); + if (SvOK(p)) + RETVAL->p = mp_fromsv(p, "p", 0, 1); + OUTPUT: + RETVAL + +mp * +p(s) + Share_Prime *s + CODE: + if (!s->p) + XSRETURN_UNDEF; + RETVAL = MP_COPY(s->p); + OUTPUT: + RETVAL + +UV +t(s) + Share_Prime *s + CODE: + RETVAL = s->t; + OUTPUT: + RETVAL + +UV +i(s) + Share_Prime *s + CODE: + RETVAL = s->i; + OUTPUT: + RETVAL + +SV * +DESTROY(s) + Share_Prime *s + CODE: + share_destroy(s); + DESTROY(s); + XSRETURN_YES; + +SV * +mkshares(s, x, r = &rand_global) + Share_Prime *s + mp *x + grand *r + CODE: + if (s->p && MP_CMP(s->p, <=, x)) + croak("secret out of range"); + share_mkshares(s, r, x); + s->i = ~0u; + XSRETURN_YES; + +mp * +share_get(s, i) + Share_Prime *s + UV i + INIT: + if (i >= MPW_MAX) + croak("share index out of range"); + if (s->i != ~0u) + croak("not making shares"); + C_ARGS: + s, MP_NEW, i + +unsigned +share_add(s, i, x) + Share_Prime *s + UV i + mp *x + INIT: + if (!s->p) + croak("no prime set"); + if (i == ~0u) + croak("making shares"); + if (i >= MPW_MAX) + croak("share index out of range"); + if (s->i >= s->t) + croak("too many shares"); + C_ARGS: + s, i, x + +mp * +share_combine(s) + Share_Prime *s + INIT: + if (s->i == ~0u) + croak("making shares"); + if (s->i != s->t) + croak("not enough shares yet"); + MODULE = Catacomb PACKAGE = Catacomb::Passphrase SV * @@ -61,7 +278,7 @@ cancel(me, tag) char *tag CODE: passphrase_cancel(tag); - XSRETURN_UNDEF; + XSRETURN_YES; MODULE = Catacomb PACKAGE = Catacomb::KeySize @@ -74,4 +291,29 @@ keysz(ksz, sz) OUTPUT: RETVAL +void +expand(ksz) + keysize *ksz + PREINIT: + int i; + PPCODE: + switch (ksz[0]) { + case KSZ_ANY: + XPUSHs(sv_2mortal(newSVpv("ANY", 0))); + XPUSHs(sv_2mortal(newSViv(ksz[1]))); + break; + case KSZ_RANGE: + XPUSHs(sv_2mortal(newSVpv("RANGE", 0))); + for (i = 1; i < 5; i++) + XPUSHs(sv_2mortal(newSViv(ksz[i]))); + break; + case KSZ_SET: + XPUSHs(sv_2mortal(newSVpv("SET", 0))); + for (i = 1; ksz[i]; i++) + XPUSHs(sv_2mortal(newSViv(ksz[i]))); + break; + default: + abort(); + } + #----- That's all, folks ---------------------------------------------------- diff --git a/mp.xs b/mp.xs index 28c22f9..9eb7fe2 100644 --- a/mp.xs +++ b/mp.xs @@ -34,8 +34,7 @@ new(me, sv = 0, radix = 0) SV *sv int radix CODE: - RETVAL = sv ? mp_fromsv(sv, "sv", - "Catacomb::MP", radix, 1) : MP_ZERO; + RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO; OUTPUT: RETVAL @@ -73,6 +72,32 @@ loadl(me, sv) OUTPUT: RETVAL +mp * +loadb2c(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = mp_loadb2c(MP_NEW, p, len); + OUTPUT: + RETVAL + +mp * +loadl2c(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = mp_loadl2c(MP_NEW, p, len); + OUTPUT: + RETVAL + int metrics(m) mp *m @@ -80,7 +105,7 @@ metrics(m) XSINTERFACE_FUNC XSINTERFACE_FUNC_SETMP INTERFACE: - octets bits + octets bits octets2c SV * storeb(m, i = -1) @@ -89,7 +114,13 @@ storeb(m, i = -1) PREINIT: size_t sz; CODE: - sz = (i < 0) ? mp_octets(m) : i; + if (i >= 0) + sz = i; + else { + sz = mp_octets(m); + if (!sz) + sz = 1; + } RETVAL = NEWSV(0, sz ? sz : 1); mp_storeb(m, SvPVX(RETVAL), sz); SvCUR_set(RETVAL, sz); @@ -113,6 +144,36 @@ storel(m, i = -1) RETVAL SV * +storeb2c(m, i = -1) + mp *m + int i + PREINIT: + size_t sz; + CODE: + sz = (i < 0) ? mp_octets2c(m) : i; + RETVAL = NEWSV(0, sz ? sz : 1); + mp_storeb(m, SvPVX(RETVAL), sz); + SvCUR_set(RETVAL, sz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +storel2c(m, i = -1) + mp *m + int i + PREINIT: + size_t sz; + CODE: + sz = (i < 0) ? mp_octets2c(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 = 10) mp *m int radix @@ -122,6 +183,25 @@ tostring(m, radix = 10) OUTPUT: RETVAL +void +fromstring(me, s, radix = 10) + SV *me + SV *s + int radix + PREINIT: + mptext_stringctx ms; + STRLEN len; + mp *x; + PPCODE: + ms.buf = SvPV(s, len); + ms.lim = ms.buf + len; + x = mp_read(MP_NEW, radix, &mptext_stringops, &ms); + if (x) { + XPUSHs(RET_MP(x)); + if (GIMME_V == G_ARRAY) + XPUSHs(sv_2mortal(newSVpvn(ms.buf, ms.lim - ms.buf))); + } + SV * toint(m) mp *m @@ -146,7 +226,7 @@ unop(a) XSINTERFACE_FUNC XSINTERFACE_FUNC_SETMP INTERFACE: - not sqr sqrt + not not2c sqr sqrt mp * neg(a) @@ -176,7 +256,7 @@ binop(a, b) XSINTERFACE_FUNC XSINTERFACE_FUNC_SETMP INTERFACE: - add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor + add sub mul and2c or2c nand2c nor2c xor2c and or nand nor xor exp mp * shiftop(a, n) @@ -237,6 +317,11 @@ mp * mp_modsqrt(p, x) mp *p mp *x + INIT: + if (!MP_POSP(p) || !MP_ODDP(p)) + croak("p is not positive and odd"); + if (mp_jacobi(x, p) != 1) + croak("x not a quadratic residue mod p"); C_ARGS: MP_NEW, x, p @@ -261,7 +346,7 @@ div(a, b) case G_VOID: break; default: - mp_div(&q, &r, a, b); + mp_div(&q, 0, a, b); EXTEND(SP, 1); PUSHs(RET_MP(q)); break; @@ -300,64 +385,21 @@ odd(m) PPCODE: t = mp_odd(MP_NEW, m, &s); EXTEND(SP, 2); - PUSHs(RET_MP(t)); PUSHs(sv_2mortal(newSViv(s))); + PUSHs(RET_MP(t)); -int -smallfactor(x) - mp *x - CODE: - RETVAL = pfilt_smallfactor(x); - OUTPUT: - RETVAL +MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pgen_ -MP_Reduce * -makereduce(x) +bool +pgen_primep(x, r = &rand_global) 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 + grand *r -MP_Mont * -mont(x) - mp *x - CODE: - if (!MP_POSP(x)) - croak("Argument to Catacomb::MP::mont must be positive"); - if (!MP_ODDP(x)) - croak("Argument to Catacomb::MP::mont must be odd"); - RETVAL = CREATE(MP_Mont); - mpmont_create(RETVAL, x); - OUTPUT: - RETVAL +MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = pfilt_ -MP_Barrett * -barrett(x) +int +pfilt_smallfactor(x) mp *x - CODE: - if (!MP_POSP(x)) - croak("Argument to Catacomb::MP::barrett must be positive"); - RETVAL = CREATE(mpbarrett); - mpbarrett_create(RETVAL, x); - OUTPUT: - RETVAL - -MP_Prime_Rabin * -rabin(x) - mp *x - CODE: - if (!MP_POSP(x)) - croak("Argument to Catacomb::MP::rabin must be positive"); - if (!MP_ODDP(x)) - croak("Argument to Catacomb::MP::rabin must be odd"); - RETVAL = CREATE(MP_Prime_Rabin); - rabin_create(RETVAL, x); - OUTPUT: - RETVAL MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_ @@ -366,12 +408,11 @@ new(me, x) SV *me mp *x CODE: - if (!MP_POSP(x)) - croak("Argument to Catacomb::MP::Mont::new must be positive"); - if (!MP_ODDP(x)) - croak("Argument to Catacomb::MP::Mont::new must be odd"); - RETVAL = CREATE(MP_Mont); - mpmont_create(RETVAL, x); + RETVAL = CREATE(MP_Mont); + if (mpmont_create(RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } OUTPUT: RETVAL @@ -399,6 +440,17 @@ mpmont_mul(mm, x, y) mm, MP_NEW, x, y mp * +in(mm, x) + MP_Mont *mm + mp *x + CODE: + RETVAL = MP_NEW; + mp_div(0, &RETVAL, x, mm->m); + RETVAL = mpmont_mul(mm, RETVAL, RETVAL, mm->r2); + OUTPUT: + RETVAL + +mp * mpmont_expr(mm, g, x) MP_Mont *mm mp *g @@ -428,8 +480,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", "Catacomb::MP", 0, 0); - v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0); + v[j].base = mp_fromsv(ST(i), "g_i", 0, 0); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0); } RETVAL = mpmont_mexpr(mm, MP_NEW, v, n); xfree(v); @@ -450,10 +502,8 @@ 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", - "Catacomb::MP", 0, 0, (unsigned long)i); - v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", - "Catacomb::MP", 0, 0, (unsigned long)i); + 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); } RETVAL = mpmont_mexp(mm, MP_NEW, v, n); xfree(v); @@ -491,10 +541,11 @@ new(me, x) SV *me mp *x CODE: - if (!MP_POSP(x)) - croak("Argument to Catacomb::MP::Barrett::new must be positive"); RETVAL = CREATE(mpbarrett); - mpbarrett_create(RETVAL, x); + if (mpbarrett_create(RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } OUTPUT: RETVAL @@ -536,10 +587,11 @@ 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); + RETVAL = CREATE(MP_Reduce); + if (mpreduce_create(RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } OUTPUT: RETVAL @@ -591,14 +643,34 @@ new(me, ...) v = xmalloc(n * sizeof(mpcrt_mod)); for (i = 0; i < n; i++) { v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", - "Catacomb::MP", 0, 0, - (unsigned long)i)); + 0, 0, (unsigned long)i)); + v[i].n = v[i].ni = v[i].nni = 0; } RETVAL = CREATE(MP_CRT); mpcrt_create(RETVAL, v, n, 0); OUTPUT: RETVAL +mp * +product(mc) + MP_CRT *mc + CODE: + RETVAL = MP_COPY(mc->mb.m); + OUTPUT: + RETVAL + +void +moduli(mc) + MP_CRT *mc + PREINIT: + size_t n, i; + PPCODE: + n = mc->k; + if (GIMME_V == G_SCALAR) + XPUSHs(sv_2mortal(newSViv(n))); + else for (i = 0; i < n; i++) + XPUSHs(RET_MP(MP_COPY(mc->v[i].m))); + SV * DESTROY(mc) MP_CRT *mc @@ -618,10 +690,9 @@ 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", "Catacomb::MP", - 0, 0, (unsigned long)i); - } + v = xmalloc(n * sizeof(mp *)); + for (i = 0; i < n; i++) + v[i] = mp_fromsv(ST(i + 1), "r_%lu", 0, 0, (unsigned long)i); RETVAL = mpcrt_solve(mc, MP_NEW, v); xfree(v); OUTPUT: diff --git a/mpstuff.c b/mpstuff.c index e048ff1..9881edc 100644 --- a/mpstuff.c +++ b/mpstuff.c @@ -94,12 +94,23 @@ mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix) return (m); } +int group_writesv(group *g, ge *x, SV *sv) +{ + mptext_svctx c; + int rc; + STRLEN len; + sv_setpvn(sv, "", 0); + c.sv = sv; + rc = G_WRITE(g, x, &mptext_svops, &c); + return (rc); +} + int mp_writesv(mp *m, SV *sv, int radix) { mptext_svctx c; int rc; STRLEN len; - SvPV(sv, len); + sv_setpvn(sv, "", 0); c.sv = sv; rc = mp_write(m, radix, &mptext_svops, &c); return (rc); @@ -107,8 +118,7 @@ int mp_writesv(mp *m, SV *sv, int radix) /* --- Conversion to and from SVs --- */ -mp *mp_fromsv(SV *sv, const char *what, const char *ty, - int radix, int keep, ...) +mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...) { mp *m; if (SvROK(sv)) { @@ -119,7 +129,7 @@ mp *mp_fromsv(SV *sv, const char *what, const char *ty, SV *t = sv_newmortal(); va_start(ap, keep); sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); - croak("%s is not of type %s", SvPVX(t), ty); + croak("%s is not of type Catacomb::MP", SvPVX(t)); } if (m && keep) MP_COPY(m); @@ -129,7 +139,7 @@ mp *mp_fromsv(SV *sv, const char *what, const char *ty, else m = mp_readsv(MP_NEW, sv, 0, radix); if (m && !keep) - RET(m, ty); /* Kill temporary later */ + RET_MP(m); /* Kill temporary later */ } return (m); } diff --git a/pgen.xs b/pgen.xs index 5da3c69..dd413a6 100644 --- a/pgen.xs +++ b/pgen.xs @@ -1,6 +1,6 @@ # -*-fundamental-*- # -# $Id: pgen.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $ +# $Id$ # # Prime generation gubbins # @@ -60,9 +60,9 @@ muladd(pf, m, a) U32 a CODE: if (m > MPW_MAX) - croak("multiplier too large in Catacomb::MP::Prime::Filter::muladd"); + croak("multiplier too large"); if (a > MPW_MAX) - croak("step too large in Catacomb::MP::Prime::Filter::muladd"); + croak("step too large"); RETVAL = CREATE(MP_Prime_Filter); RETVAL->rc = pfilt_muladd(&RETVAL->pf, &pf->pf, m, a); OUTPUT: @@ -74,7 +74,7 @@ step(pf, n) U32 n CODE: if (n > MPW_MAX) - croak("step too large in Catacomb::MP::Prime::Filter::step"); + croak("step too large"); RETVAL = pf->rc = pfilt_step(&pf->pf, n); OUTPUT: RETVAL @@ -128,12 +128,11 @@ new(me, x) SV *me mp *x CODE: - if (x->f & MP_NEG) - croak("Argument to Catacomb::MP::Prime::Rabin must be positive"); - if (x->v == x->vl || !(x->v[0] & 1u)) - croak("Argument to Catacomb::MP::Prime::Rabin must be odd"); RETVAL = CREATE(MP_Prime_Rabin); - rabin_create(RETVAL, x); + if (rabin_create(RETVAL, x)) { + DESTROY(RETVAL); + RETVAL = 0; + } OUTPUT: RETVAL @@ -150,6 +149,14 @@ rabin_test(r, g) MP_Prime_Rabin *r mp *g +mp * +m(r) + MP_Prime_Rabin *r + CODE: + RETVAL = MP_COPY(r->mm.m); + OUTPUT: + RETVAL + int rabin_iters(r) MP_Prime_Rabin *r @@ -157,7 +164,8 @@ rabin_iters(r) mp_bits(r->mm.m) int -ntests(bits) +ntests(me, bits) + SV *me int bits CODE: RETVAL = rabin_iters(bits); @@ -243,10 +251,26 @@ subev(me) OUTPUT: RETVAL +int +PG_BEGIN(me, ev) + SV *me + MP_Prime_Gen_Event *ev + ALIAS: + PG_TRY = 0 + PG_PASS = 1 + PG_FAIL = 2 + PG_ABORT = 3 + PG_DONE = 4 + CODE: + RETVAL = 0; + OUTPUT: + RETVAL + MODULE = Catacomb PACKAGE = Catacomb::MP::Prime mp * -gen(name, m, steps, stepper, tests, tester, events = &PL_sv_undef) +gen(me, name, m, steps, stepper, tests, tester, events = &PL_sv_undef) + SV *me char *name mp *m MP_Prime_Gen_NullProc *events @@ -267,7 +291,8 @@ gen(name, m, steps, stepper, tests, tester, events = &PL_sv_undef) RETVAL void -strongprime_setup(name, bits, r = &rand_global, n = 0, events = &PL_sv_undef) +strongprime_setup(me, name, bits, r = &rand_global, n = 0, events = &PL_sv_undef) + SV *me char *name unsigned bits grand *r @@ -283,11 +308,9 @@ strongprime_setup(name, bits, r = &rand_global, n = 0, events = &PL_sv_undef) j = CREATE(MP_Prime_Gen_JumpStepper); d = strongprime_setup(name, MP_NEW, &j->pf, bits, r, n, ev, ectx); EXTEND(SP, 2); - if (!d) { + if (!d) DESTROY(j); - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_undef); - } else { + else { j->j.j = &j->pf; j->mg.p = pgen_jump; j->mg.ctx = &j->j; @@ -296,7 +319,8 @@ strongprime_setup(name, bits, r = &rand_global, n = 0, events = &PL_sv_undef) } void -limlee(name, qbits, pbits, r = &rand_global, on = 0, oevents = &PL_sv_undef, ievents = &PL_sv_undef) +limlee(me, name, qbits, pbits, r = &rand_global, on = 0, oevents = &PL_sv_undef, ievents = &PL_sv_undef) + SV *me char *name unsigned qbits unsigned pbits @@ -316,11 +340,13 @@ limlee(name, qbits, pbits, r = &rand_global, on = 0, oevents = &PL_sv_undef, iev if (GIMME_V == G_SCALAR) { x = limlee(name, MP_NEW, MP_NEW, qbits, pbits, r, on, oev, oec, iev, iec, 0, 0); + if (!x) return; EXTEND(SP, 1); PUSHs(RET_MP(x)); } else { x = limlee(name, MP_NEW, MP_NEW, qbits, pbits, r, on, oev, oec, iev, iec, &nf, &f); + if (!x) return; EXTEND(SP, 1 + nf); PUSHs(RET_MP(x)); for (i = 0; i < nf; i++) @@ -339,18 +365,38 @@ name(ev) RETVAL mp * -mp(ev, m = 0) +m(ev, x = &PL_sv_undef) MP_Prime_Gen_Event *ev - mp *m + SV *x + PREINIT: + mp *y; CODE: RETVAL = mp_copy(ev->m); - if (items > 1) { + if (SvOK(x)) { + if ((y = mp_fromsv(x, "x", 0, 1)) == 0) + croak("bad integer"); mp_drop(ev->m); - ev->m = mp_copy(m); + ev->m = y; } OUTPUT: RETVAL +int +steps(ev) + MP_Prime_Gen_Event *ev + CODE: + RETVAL = ev->steps; + OUTPUT: + RETVAL + +int +tests(ev) + MP_Prime_Gen_Event *ev + CODE: + RETVAL = ev->tests; + OUTPUT: + RETVAL + SV * rand(ev) MP_Prime_Gen_Event *ev diff --git a/pgproc.c b/pgproc.c index b3818ef..ef2b272 100644 --- a/pgproc.c +++ b/pgproc.c @@ -1,6 +1,6 @@ /* -*-c-*- * - * $Id: pgproc.c,v 1.2 2004/04/08 01:36:21 mdw Exp $ + * $Id$ * * Prime generation procedures * @@ -41,12 +41,12 @@ static int perlevent(int rq, pgen_event *e, void *p) dSP; switch (rq) { - case PGEN_BEGIN: meth = "pgen_begin"; break; - case PGEN_TRY: meth = "pgen_try"; break; - case PGEN_FAIL: meth = "pgen_fail"; break; - case PGEN_PASS: meth = "pgen_pass"; break; - case PGEN_DONE: meth = "pgen_done"; break; - case PGEN_ABORT: meth = "pgen_abort"; break; + case PGEN_BEGIN: meth = "PG_BEGIN"; break; + case PGEN_TRY: meth = "PG_TRY"; break; + case PGEN_FAIL: meth = "PG_FAIL"; break; + case PGEN_PASS: meth = "PG_PASS"; break; + case PGEN_DONE: meth = "PG_DONE"; break; + case PGEN_ABORT: meth = "PG_ABORT"; break; default: abort(); } @@ -55,8 +55,7 @@ static int perlevent(int rq, pgen_event *e, void *p) SAVETMPS; PUSHMARK(SP); XPUSHs(sv); - XPUSHs(sv_setref_pv(sv_newmortal(), "Catacomb::MP::Prime::Gen::Event", - (void *)e)); + XPUSHs(RET(e, "Catacomb::MP::Prime::Gen::Event")); PUTBACK; n = perl_call_method(meth, G_SCALAR); assert(n == 1); diff --git a/pubkey.xs b/pubkey.xs new file mode 100644 index 0000000..ee98e5c --- /dev/null +++ b/pubkey.xs @@ -0,0 +1,593 @@ +# ---?--- +# +# $Id$ +# +# Key-management interface +# +# (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::PubKey + +void +gen_dh(me, ql, pl, steps = 0, r = &rand_global, events = &PL_sv_undef) + SV *me + unsigned ql + unsigned pl + unsigned steps + grand *r + MP_Prime_Gen_NullProc *events + PREINIT: + dh_param dp; + pgen_proc *evproc; + void *evctx; + PPCODE: + pgproc_get(events, &evproc, &evctx); + if (dh_gen(&dp, ql, pl, steps, r, evproc, evctx)) + XSRETURN_EMPTY; + XPUSHs(RET_MP(dp.p)); + XPUSHs(RET_MP(dp.g)); + XPUSHs(RET_MP(dp.q)); + +void +gen_limlee(me, ql, pl, flags = 0, steps = 0, r = &rand_global, oevents = &PL_sv_undef, ievents = &PL_sv_undef) + SV *me + unsigned ql + unsigned pl + unsigned flags + unsigned steps + grand *r + MP_Prime_Gen_NullProc *oevents + MP_Prime_Gen_NullProc *ievents + PREINIT: + dh_param dp; + pgen_proc *oev, *iev; + void *oec, *iec; + size_t nf; + mp **f; + size_t i; + PPCODE: + pgproc_get(oevents, &oev, &oec); + pgproc_get(ievents, &iev, &iec); + if (dh_limlee(&dp, ql, pl, flags, steps, r, + oev, oec, iev, iec, &nf, &f)) + XSRETURN_EMPTY; + XPUSHs(RET_MP(dp.p)); + XPUSHs(RET_MP(dp.g)); + XPUSHs(RET_MP(dp.q)); + for (i = 0; i < nf; i++) + XPUSHs(RET_MP(f[i])); + xfree(f); + +void +gen_dsa(me, ql, pl, steps = 0, k = &PL_sv_undef, events = &PL_sv_undef) + SV *me + unsigned ql + unsigned pl + unsigned steps + SV *k + MP_Prime_Gen_NullProc *events + PREINIT: + char *kp; + STRLEN ksz; + dsa_seed ds; + dsa_param dp; + pgen_proc *evproc; + void *evctx; + char buf[20]; + PPCODE: + if (SvOK(k)) + kp = SvPV(k, ksz); + else { + kp = buf; + ksz = 20; + rand_get(RAND_GLOBAL, kp, ksz); + } + pgproc_get(events, &evproc, &evctx); + if (dsa_gen(&dp, ql, pl, steps, kp, ksz, &ds, evproc, evctx)) + XSRETURN_EMPTY; + XPUSHs(RET_MP(dp.p)); + XPUSHs(RET_MP(dp.g)); + XPUSHs(RET_MP(dp.q)); + XPUSHs(sv_2mortal(newSVpvn(ds.p, ds.sz))); + XPUSHs(sv_2mortal(newSViv(ds.count))); + xfree(ds.p); + +MODULE = Catacomb PACKAGE = Catacomb::DSA + +ghash * +beginhash(c) + SV *c + PREINIT: + gdsa g; + CODE: + gdsa_pubfromsv(&g, c); + RETVAL = gdsa_beginhash(&g); + OUTPUT: + RETVAL + +SV * +endhash(c, h) + SV *c + ghash *h + PREINIT: + gdsa g; + CODE: + gdsa_pubfromsv(&g, c); + gdsa_endhash(&g, h); + XSRETURN_YES; + +MODULE = Catacomb PACKAGE = Catacomb::DSA::Private + +void +sign(c, m, k = 0) + SV *c + SV *m + mp *k + PREINIT: + gdsa g; + gdsa_sig s = GDSA_SIG_INIT; + char *p; + STRLEN len; + PPCODE: + gdsa_privfromsv(&g, c); + p = SvPV(m, len); + if (len != g.h->hashsz) + croak("bad message length"); + gdsa_sign(&g, &s, p, k); + XPUSHs(MAKE_MP(s.r)); + XPUSHs(MAKE_MP(s.s)); + +MODULE = Catacomb PACKAGE = Catacomb::DSA::Public + +bool +verify(c, m, r, s) + SV *c + mp *r + mp *s + SV *m + PREINIT: + gdsa g; + gdsa_sig ss = GDSA_SIG_INIT; + char *p; + STRLEN len; + CODE: + gdsa_pubfromsv(&g, c); + p = SvPV(m, len); + if (len != g.h->hashsz) + croak("bad message length"); + ss.r = r; + ss.s = s; + RETVAL = !gdsa_verify(&g, &ss, p); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::KCDSA + +ghash * +beginhash(c) + SV *c + PREINIT: + gkcdsa g; + CODE: + gdsa_pubfromsv(&g, c); + RETVAL = gkcdsa_beginhash(&g); + OUTPUT: + RETVAL + +SV * +endhash(c, h) + SV *c + ghash *h + PREINIT: + gkcdsa g; + CODE: + gdsa_pubfromsv(&g, c); + gkcdsa_endhash(&g, h); + XSRETURN_YES; + +MODULE = Catacomb PACKAGE = Catacomb::KCDSA::Private + +void +sign(c, m, k = 0) + SV *c + SV *m + mp *k + PREINIT: + gkcdsa g; + gkcdsa_sig s = GKCDSA_SIG_INIT; + char *p; + STRLEN len; + PPCODE: + gdsa_privfromsv(&g, c); + p = SvPV(m, len); + if (len != g.h->hashsz) + croak("bad message length"); + gkcdsa_sign(&g, &s, p, k); + XPUSHs(sv_2mortal(newSVpvn(s.r, g.h->hashsz))); + XPUSHs(RET_MP(s.s)); + xfree(s.r); + +MODULE = Catacomb PACKAGE = Catacomb::KCDSA::Public + +bool +verify(c, m, r, s) + SV *c + SV *r + mp *s + SV *m + PREINIT: + gkcdsa g; + gkcdsa_sig ss = GKCDSA_SIG_INIT; + char *p; + STRLEN len; + CODE: + gdsa_pubfromsv(&g, c); + p = SvPV(m, len); + if (len != g.h->hashsz) + croak("bad message length"); + ss.r = SvPV(r, len); + if (len != g.h->hashsz) + croak("bad signature (r) length"); + ss.s = s; + RETVAL = !gkcdsa_verify(&g, &ss, p); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::RSA::Public PREFIX = rsa_ + +RSA_Public * +new(me, sv) + SV *me + SV *sv + PREINIT: + cursor c; + rsa_pub *rp; + CODE: + rp = CREATE(rsa_pub); + c_init(&c, sv); + rp->n = C_MP(&c, "n"); + rp->e = C_MP(&c, "e"); + RETVAL = CREATE(rsa_pubctx); + rsa_pubcreate(RETVAL, rp); + OUTPUT: + RETVAL + +mp * +n(rp) + RSA_Public *rp + CODE: + RETVAL = MP_COPY(rp->rp->n); + OUTPUT: + RETVAL + +HV * +extract(rp) + RSA_Public *rp + CODE: + RETVAL = newHV(); + hvput(RETVAL, "n", MAKE_MP(rp->rp->n)); + hvput(RETVAL, "e", MAKE_MP(rp->rp->e)); + OUTPUT: + RETVAL + +SV * +DESTROY(rp) + RSA_Public *rp + PREINIT: + rsa_pub *rrp; + CODE: + rrp = rp->rp; + rsa_pubdestroy(rp); + DESTROY(rp); + rsa_pubfree(rrp); + DESTROY(rrp); + XSRETURN_YES; + +mp * +op(rp, p) + RSA_Public *rp + mp *p + CODE: + RETVAL = rsa_pubop(rp, MP_NEW, p); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::RSA::Private PREFIX = rsa_ + +RSA_Private * +new(me, sv) + SV *me + SV *sv + PREINIT: + cursor c; + rsa_priv *rp; + CODE: + c_init(&c, sv); + rp = CREATE(rsa_priv); + rp->n = C_MP(&c, "n"); + rp->e = C_MP(&c, "e"); + rp->d = C_MP(&c, "d"); + rp->p = C_MP(&c, "p"); + rp->q = C_MP(&c, "q"); + rp->dp = C_MP(&c, "dp"); + rp->dq = C_MP(&c, "dq"); + rp->q_inv = C_MP(&c, "qi"); + if (rsa_recover(rp)) + croak("insuffcient values in Catacomb::RSA::Private::new"); + RETVAL = CREATE(rsa_privctx); + rsa_privcreate(RETVAL, rp, &rand_global); + OUTPUT: + RETVAL + +RSA_Private * +generate(me, nbits, r = &rand_global, n = 0, events = &PL_sv_undef) + SV *me + unsigned nbits + grand *r + unsigned n + MP_Prime_Gen_NullProc *events + PREINIT: + pgen_proc *ev; + void *ec; + rsa_priv *rp; + CODE: + rp = CREATE(rsa_priv); + pgproc_get(events, &ev, &ec); + if (rsa_gen(rp, nbits, r, n, ev, ec)) { + DESTROY(rp); + XSRETURN_UNDEF; + } + RETVAL = CREATE(rsa_privctx); + rsa_privcreate(RETVAL, rp, &rand_global); + OUTPUT: + RETVAL + +HV * +extract(rp) + RSA_Private *rp + CODE: + RETVAL = newHV(); + hvput(RETVAL, "n", MAKE_MP(rp->rp->n)); + hvput(RETVAL, "e", MAKE_MP(rp->rp->e)); + hvput(RETVAL, "d", MAKE_MP(rp->rp->d)); + hvput(RETVAL, "p", MAKE_MP(rp->rp->p)); + hvput(RETVAL, "q", MAKE_MP(rp->rp->q)); + hvput(RETVAL, "dp", MAKE_MP(rp->rp->dp)); + hvput(RETVAL, "dq", MAKE_MP(rp->rp->dq)); + hvput(RETVAL, "qi", MAKE_MP(rp->rp->q_inv)); + OUTPUT: + RETVAL + +mp * +n(rp) + RSA_Private *rp + CODE: + RETVAL = MP_COPY(rp->rp->n); + OUTPUT: + RETVAL + +SV * +DESTROY(rp) + RSA_Private *rp + PREINIT: + rsa_priv *rrp; + CODE: + rp->r = &rand_global; + rrp = rp->rp; + rsa_privdestroy(rp); + DESTROY(rp); + rsa_privfree(rrp); + DESTROY(rrp); + XSRETURN_YES; + +mp * +op(rp, p, r = &PL_sv_undef) + RSA_Private *rp + mp *p + SV *r + CODE: + rp->r = SvOK(r) ? ptrfromsv(r, "Catacomb::Rand", "r") : 0; + RETVAL = rsa_privop(rp, MP_NEW, p); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::RSA::PKCS1Crypt + +mp * +pad(c, m, sz, nbits) + SV *c + SV *m + size_t sz + unsigned long nbits + PREINIT: + pkcs1 pc; + void *b; + void *mm; + STRLEN msz; + CODE: + pkcs1_fromsv(&pc, c); + mm = SvPV(m, msz); + b = xmalloc(sz); + RETVAL = pkcs1_cryptencode(MP_NEW, mm, msz, b, sz, nbits, &pc); + xfree(b); + OUTPUT: + RETVAL + +SV * +unpad(c, m, sz, nbits) + SV *c + mp *m + size_t sz + unsigned long nbits + PREINIT: + pkcs1 pc; + void *b; + int rc; + CODE: + pkcs1_fromsv(&pc, c); + b = xmalloc(sz); + rc = pkcs1_cryptdecode(m, b, sz, nbits, &pc); + if (rc < 0) + RETVAL = &PL_sv_undef; + else + RETVAL = newSVpvn(b, rc); + xfree(b); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::RSA::PKCS1Sign + +mp * +pad(c, m, sz, nbits) + SV *c + SV *m + size_t sz + unsigned long nbits + PREINIT: + pkcs1 pc; + void *b; + void *mm; + STRLEN msz; + CODE: + pkcs1_fromsv(&pc, c); + mm = SvPV(m, msz); + b = xmalloc(sz); + RETVAL = pkcs1_sigencode(MP_NEW, mm, msz, b, sz, nbits, &pc); + xfree(b); + OUTPUT: + RETVAL + +SV * +unpad(c, s, m, sz, nbits) + SV *c + mp *s + SV *m + size_t sz + unsigned long nbits + PREINIT: + pkcs1 pc; + void *b; + void *mm; + STRLEN msz; + int rc; + CODE: + pkcs1_fromsv(&pc, c); + mm = SvPV(m, msz); + b = xmalloc(sz); + rc = pkcs1_sigdecode(s, mm, msz, b, sz, nbits, &pc); + if (rc < 0) XSRETURN_UNDEF; + RETVAL = newSVpvn(b, rc); + xfree(b); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::RSA::OAEP + +mp * +pad(c, m, sz, nbits) + SV *c + SV *m + size_t sz + unsigned long nbits + PREINIT: + oaep pc; + void *b; + void *mm; + STRLEN msz; + CODE: + oaep_fromsv(&pc, c); + mm = SvPV(m, msz); + b = xmalloc(sz); + RETVAL = oaep_encode(MP_NEW, mm, msz, b, sz, nbits, &pc); + xfree(b); + OUTPUT: + RETVAL + +SV * +unpad(c, m, sz, nbits) + SV *c + mp *m + size_t sz + unsigned long nbits + PREINIT: + oaep pc; + void *b; + int rc; + CODE: + oaep_fromsv(&pc, c); + b = xmalloc(sz); + rc = oaep_decode(m, b, sz, nbits, &pc); + if (rc < 0) + RETVAL = &PL_sv_undef; + else + RETVAL = newSVpvn(b, rc); + xfree(b); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::RSA::PSS + +mp * +pad(c, m, sz, nbits) + SV *c + SV *m + size_t sz + unsigned long nbits + PREINIT: + pss pc; + void *b; + void *mm; + STRLEN msz; + CODE: + pss_fromsv(&pc, c); + mm = SvPV(m, msz); + b = xmalloc(sz); + RETVAL = pss_encode(MP_NEW, mm, msz, b, sz, nbits, &pc); + xfree(b); + OUTPUT: + RETVAL + +SV * +unpad(c, s, m, sz, nbits) + SV *c + mp *s + SV *m + size_t sz + unsigned long nbits + PREINIT: + pss pc; + void *b; + void *mm; + STRLEN msz; + int rc; + CODE: + pss_fromsv(&pc, c); + mm = SvPV(m, msz); + b = xmalloc(sz); + rc = pss_decode(s, mm, msz, b, sz, nbits, &pc); + if (rc < 0) XSRETURN_UNDEF; + RETVAL = newSVpvn(b, rc); + xfree(b); + OUTPUT: + RETVAL + +#----- That's all, folks ---------------------------------------------------- diff --git a/random-word.pl b/random-word.pl new file mode 100755 index 0000000..7e87bda --- /dev/null +++ b/random-word.pl @@ -0,0 +1,38 @@ +#! /usr/bin/perl + +use Catacomb qw(:random); +use Getopt::Long qw(:config gnu_getopt); + +$help = 0; +$dict = undef; +GetOptions("dict=s" => \$dict, "help" => \$help) or exit 1; + +DICT: { + last DICT if defined $dict; + $dict = $ENV{"DICT"}; last DICT if defined $dict; + $dict = "/usr/share/dict/words"; last DICT if -r $dict; + -r $dict or $dict = "/usr/dict/words"; last DICT if -r $dict; + die "no appropriate word list"; +} +open DICT, "$dict" or die "can't open $dict: $!"; + +sub filter { 1; } +$filter = shift(); +if (defined $filter) { + eval "sub filter { $filter };"; + die $@ if $@; +} + +$rng = Catacomb::Rand::Counter->new("blowfish", $random->fill(32)); + +$word = undef; +$i = 1; +WORD: while () { + chomp(); + next WORD unless filter; + $rng->range($i) == 0 and $word = $_; + $i++; +} +close DICT; +print "$word\n"; + diff --git a/t/key.t b/t/key.t new file mode 100644 index 0000000..7a8074f --- /dev/null +++ b/t/key.t @@ -0,0 +1,77 @@ +# -*-mode: perl; comment-column: 68-*- +use Test; +BEGIN { plan tests => 19; } +use Catacomb qw(:const mp); + +sub dumphash { + my ($n, $h) = @_; + print "# $n\n"; + foreach my $k (keys %$h) { + print "# $k -> $h->{$k}\n"; + } +} + +sub checkhash { + my ($t, $r) = @_; + my @t = sort keys(%$t); + my @r = sort keys(%$r); + unless (@t == @r) { + print "# key count: ", scalar(@t), " != ", scalar(@r), "\n"; + dumphash "t", $t; + dumphash "r", $r; + return undef; + } + for (my $i = 0; $i < @t; $i++) { + unless ($t[$i] eq $r[$i] && $t->{$t[$i]} eq $r->{$r[$i]}) { + print "# hash: $t[$i] -> $t->{$t[$i]} != $r[$i] -> $r->{$r[$i]}\n"; + dumphash "t", $t; + dumphash "r", $r; + return undef; + } + } + return 1; +} + +# Simple stuff +$f = Catacomb::Key::File->new("keyring"); ok defined $f; #t 1 +$k = $f->bytag("tux"); ok defined $k; #t 2 +$d = $k->data(); ok defined $d; #t 3 +ok $d->flags() == KENC_STRUCT; #t 4 +$h = $d->structopen(); +ok exists $h->{"p"}; #t 5 +ok !exists $h->{"bogus"}; #t 6 + +($C, undef, $r) = + Catacomb::EC::Curve->getinfo($h->{"curve"}->getstring()); +$p = $C->pt($h->{"p"}->getec()); +ok +($p * $r)->atinfp(); #t 7 + +$h = $k->attrs; +ok checkhash $h, { #t 8 + "hash" => "sha256", + "mac" => "sha256-hmac/128", + "cipher" => "blowfish-cbc" +}; + + +($k, $d, $n) = $f->qtag("rsa.private"); +ok $k->type, "rsa"; #t 9 +ok $d->flags == KENC_ENCRYPT; #t 10 +ok $n, sprintf("%08x:rsa.private", $k->id); #t 11 + +$h = $f->bytag("rsa")->data()->structfind("private") + ->unlock("pass")->structopen(); +ok defined $h; #t 12 + + +# Key data +($kd, $rest) = Catacomb::Key::Data->read + ("struct:[p=integer,public:23,q=integer,public:11],zqzqv"); +ok $rest, ",zqzqv"; #t 13 +ok defined $kd; #t 14 +$h = $kd->structopen(); ok defined $h; #t 15 +ok $h->{"p"}->getmp() == 23; #t 16 +ok $h->{"q"}->getmp() == 11; #t 17 +$pkd = $kd->lock("passphrase"); +ok !defined $pkd->unlock("wrong"); #t 18 +$ukd = $pkd->unlock("passphrase"); ok defined $ukd; #t 19 diff --git a/t/mp.t b/t/mp.t new file mode 100644 index 0000000..39bbaf2 --- /dev/null +++ b/t/mp.t @@ -0,0 +1,208 @@ +# -*-mode: perl; comment-column: 68-*- +use Test; +BEGIN { plan tests => 121; } +use Catacomb qw(:const mp); + +# Addition +ok mp("5") + mp("4") == mp("9"); #t 1 +ok mp("5") + mp("-4") == mp("1"); #t 2 +ok mp("-5") + mp("4") == mp("-1"); #t 3 +ok mp("-5") + mp("-4") == mp("-9"); #t 4 +ok mp("0xffffffff") + mp("1") == mp("0x100000000"); #t 5 + +# Subtraction +ok mp("5") - mp("4") == mp("1"); #t 6 +ok mp("5") - mp("-4") == mp("9"); #t 7 +ok mp("-5") - mp("4") == mp("-9"); #t 8 +ok mp("-5") - mp("-4") == mp("-1"); #t 9 +ok mp("4") - mp("5") == mp("-1"); #t 10 +ok mp("4") - mp("-5") == mp("9"); #t 11 +ok mp("-4") - mp("5") == mp("-9"); #t 12 +ok mp("-4") - mp("-5") == mp("1"); #t 13 + +# Squaring +ok mp("5")->sqr() == mp("25"); #t 14 +ok mp("-5")->sqr() == mp("25"); #t 15 +ok mp("56309812098453")->sqr()==mp("3170794938563083851364993209"); #t 16 + +# Multiplication +ok mp("5") * mp("4") == mp("20"); #t 17 +ok mp("5") * mp("-4") == mp("-20"); #t 18 +ok mp("-5") * mp("4") == mp("-20"); #t 19 +ok mp("-5") * mp("-4") == mp("20"); #t 20 +ok mp("0x10000") * mp("0x10000") == mp("0x100000000"); #t 21 + +# Division +sub divtest { + my ($x, $y, $q, $r) = @_; + my ($qq, $rr) = Catacomb::MP::div($x, $y); + ok $qq == $q && $rr == $r; +} +divtest "9", "4", "2", "1"; #t 22 +divtest "-9", "4", "-3", "3"; #t 23 +divtest "9", "-4", "-3", "-3"; #t 24 +divtest "-9", "-4", "2", "-1"; #t 25 +divtest #t 26 + "-3", "6277101735386680763835789423207666416083908700390324961279", + "-1", "6277101735386680763835789423207666416083908700390324961276"; +divtest #t 27 + "3131675836296406071791252329528905062261497366991742517193", + "1110875761630725856340142297645383444629395595869672555585", + "2", "909924313034954359110967734238138173002706175252397406023"; +divtest #t 28 + "3131675836296406071791252329528905062261497366991742517193", "53", + "59088223326347284373419855274130284193613157867768726739", "26"; +ok mp("-9") / mp("-4") == mp("2"); #t 29 +ok mp("-9") % mp("-4") == mp("-1"); #t 30 + +# Exponentiation +ok mp("4") ** mp("0") == mp("1"); #t 31 +ok mp("4") ** mp("1") == mp("4"); #t 32 +ok mp("7") ** mp("2") == mp("49"); #t 33 +ok mp("3") ** mp("64") == mp("3433683820292512484657849089281"); #t 34 + +# Bit ops tests +ok ~mp("6") == mp("-7"); #t 35 +ok ~mp("-7") == mp("6"); #t 36 + +ok +(mp("5") & mp("3")) == mp("1"); #t 37 +ok +(mp("5") | mp("3")) == mp("7"); #t 38 +ok +(mp("5") ^ mp("3")) == mp("6"); #t 39 +ok +(mp("45") | mp("-7")) == mp("-3"); #t 40 +ok +(mp("0x343cd5") ^ mp("-0x6a49c")) == mp("-0x32984f"); #t 41 + +ok +(mp("-1") >> 5) == mp("-1"); #t 42 +ok +(mp("1") >> 5) == mp("0"); #t 43 +ok +(mp("-6") >> 2) == mp("-2"); #t 44 +ok +(mp("5") >> 0) == mp("5"); #t 45 +ok +(mp("-4") >> 0) == mp("-4"); #t 46 +ok +(mp("7") >> 2) == mp("1"); #t 47 +ok +(mp("-7") >> 2) == mp("-2"); #t 48 +ok +(mp("-7") >> 20) == mp("-1"); #t 49 + +ok +(mp("-1") << 5) == mp("-32"); #t 50 +ok +(mp("5") << 0) == mp("5"); #t 51 +ok +(mp("-4") << 0) == mp("-4"); #t 52 +ok +(mp("7") << 2) == mp("28"); #t 53 +ok +(mp("-7") << 2) == mp("-28"); #t 54 +ok +(mp("0xc0000000") << 1) == mp("0x180000000"); #t 55 +ok +(mp("-0xc0000000") << 1) == mp("-0x180000000"); #t 56 +ok +(mp("-1") << 32) == mp("-0x100000000"); #t 57 + +ok mp("0")->setbit2c(40) == mp("0x10000000000"); #t 58 +ok mp("0x87348")->setbit2c(40) == mp("0x10000087348"); #t 59 +ok mp("5")->setbit2c(1) == mp("7"); #t 60 +ok mp("7")->setbit2c(1) == mp("7"); #t 61 +ok mp("-3")->setbit2c(1) == mp("-1"); #t 62 + +ok mp("0x10000000000")->clearbit2c(40) == mp("0"); #t 63 +ok mp("0x87348")->clearbit2c(40) == mp("0x87348"); #t 64 +ok mp("5")->clearbit2c(1) == mp("5"); #t 65 +ok mp("7")->clearbit2c(1) == mp("5"); #t 66 +ok mp("-1")->clearbit2c(1) == mp("-3"); #t 67 + +# Negation +ok -mp("0") == mp("0"); #t 68 +ok -mp("15") == mp("-15"); #t 69 +ok -mp("-15") == mp("15"); #t 70 + +# Extraction of even powers +sub oddtest { + my ($x, $s, $t) = @_; + my ($ss, $tt) = mp($x)->odd(); + ok $ss == $s && $tt == $t; +} +oddtest "1", 0, "1"; #t 71 +oddtest "2", 1, "1"; #t 72 +oddtest "4", 2, "1"; #t 73 +oddtest "12", 2, "3"; #t 74 +oddtest "0x10000000000000", 52, "1"; #t 75 +oddtest "0x10000000400000", 22, "0x40000001"; #t 76 + +# Integer square root +ok mp("0")->sqrt() == mp("0"); #t 77 +ok mp("1")->sqrt() == mp("1"); #t 78 +ok mp("4")->sqrt() == mp("2"); #t 79 +ok mp("9")->sqrt() == mp("3"); #t 80 +ok mp("16")->sqrt() == mp("4"); #t 81 +ok mp("99")->sqrt() == mp("9"); #t 82 +ok mp("100")->sqrt() == mp("10"); #t 83 +ok mp("101")->sqrt() == mp("10"); #t 84 +ok mp("120")->sqrt() == mp("10"); #t 85 +ok mp("121")->sqrt() == mp("11"); #t 86 +ok mp("10106623487257186586")->sqrt() == mp("3179091613"); #t 87 +ok mp("14565040310136678240")->sqrt() == mp("3816417208"); #t 88 + +# Greatest common divisor + +ok Catacomb::MP::gcd("16", "12") == mp("4"); #t 89 +ok mp("90980984098081324")->modinv("4398082908043") == #t 90 + mp("58497120524729235"); + +sub gcdtest { + my ($u, $v, $g, $x, $y) = @_; + my ($gg, $xx, $yy) = Catacomb::MP::gcd($u, $v); + ok $g == $gg && $x == $xx && $y == $yy; +} +gcdtest "16", "12", "4", "-11", "15"; #t 91 +gcdtest "12", "16", "4", "-1", "1"; #t 92 +gcdtest "693", "609", "21", "-7", "8"; #t 93 +gcdtest #t 94 + "4398082908043", "90980984098081324", + "1", "-32483863573352089", "1570292150447"; + +gcdtest "16", "-12", "4", "-11", "-15"; #t 95 +gcdtest "-16", "12", "4", "11", "15"; #t 96 +gcdtest "-12", "-16", "4", "1", "-1"; #t 97 +gcdtest "-12", "16", "4", "1", "1"; #t 98 +gcdtest "-693", "609", "21", "7", "8"; #t 99 +gcdtest "693", "-609", "21", "-7", "-8"; #t 100 + +gcdtest "15", "0", "15", "1", "0"; #t 101 +gcdtest "0", "15", "15", "0", "1"; #t 102 +gcdtest "-5", "0", "5", "-1", "0"; #t 103 +gcdtest "0", "-5", "5", "0", "-1"; #t 104 +gcdtest "0", "0", "0", "0", "0"; #t 105 + +gcdtest #t 106 + "829561629303257626084392170900075", + "32498098450983560651904114638965", + "5", + "-29340810037249902802634060204608", + "748967211613630574419802053172497"; + +# Jacobi symbol +ok mp("5")->jac("4") == 1; #t 107 +ok mp("7")->jac("6") == -1; #t 108 +ok mp("27")->jac("15") == 0; #t 109 +ok mp("98729378979237498798347932749951") #t 110 + ->jac("2132498039840981") == 1; + +# Modular square-root +sub modsqrttest { + my ($p, $x, $r) = @_; + my $rr = mp($p)->modsqrt($x); + ok $rr == $r || $rr == mp($p) - $r; +} +modsqrttest "3", "1", "1"; #t 111 +modsqrttest "5", "4", "3"; #t 112 +modsqrttest #t 113 + "13391974640168007623", "9775592058107450692", "3264570455655810730"; + +# Factorial +ok +Catacomb::MP->factorial(0) == mp("1"); #t 114 +ok +Catacomb::MP->factorial(5) == mp("120"); #t 115 +ok +Catacomb::MP->factorial(30) == #t 116 + mp("265252859812191058636308480000000"); + +# Parsing +sub parsetest { + my ($str, $rx, $x, $r) = @_; + my ($xx, $rr) = Catacomb::MP->fromstring($str, $rx); + ok defined($x) ? ($xx == $x && $rr eq $r) : !defined($xx); +} +parsetest "0", 10, mp("0"), ""; #t 117 +parsetest "0z", 10, mp("0"), "z"; #t 118 +parsetest "z", 10, undef, ""; #t 119 +parsetest "8_27785", 0, mp("191"), "85"; #t 120 +parsetest "8_27785", 10, mp("8"), "_27785"; #t 121 diff --git a/t/share.t b/t/share.t new file mode 100644 index 0000000..f4c7293 --- /dev/null +++ b/t/share.t @@ -0,0 +1,49 @@ +# -*-mode: perl; comment-column: 68-*- +use Test; +BEGIN { plan tests => 11; } +use Catacomb qw(:const $random); + +$sec = $random->mp(256); +$sh = Catacomb::Share::Prime->new(3); +ok $sh->t == 3; #t 1 +ok !defined $sh->p; #t 2 +@sh = (); +$sh->mkshares($sec); +$p = $sh->p(); +ok defined $p; #t 3 +for (my $i = 0; $i < 5; $i++) { + $sh[$i] = $sh->get($i); +} +$sh = Catacomb::Share::Prime->new(3, $p); +ok $sh->p == $p; #t 4 +$sh->add(2, $sh[2]); +ok $sh->add(4, $sh[4]) == 1; #t 5 +ok $sh->i == 2; #t 6 +$sh->add(1, $sh[1]); +$r = $sh->combine(); +ok $r == $sec; #t 7 +undef $sec; +undef $sh; +undef @sh; +undef $p; +undef $r; + +$sec = $random->fill(16); +$sh = Catacomb::Share::GF->new(3, 16); +ok $sh->t == 3; #t 8 +ok $sh->sz == 16; #t 9 +@sh = (); +$sh->mkshares($sec); +for (my $i = 0; $i < 5; $i++) { + $sh[$i] = $sh->get($i); +} +$sh = Catacomb::Share::GF->new(3, 16); +$sh->add(2, $sh[2]); +ok $sh->add(3, $sh[3]) == 1; #t 10 +$sh->add(0, $sh[0]); +$r = $sh->combine(); +ok $r, $sec; #t 11 +undef $sec; +undef $sh; +undef @sh; +undef $r; diff --git a/test.pl b/test.pl deleted file mode 100644 index 8d7e82c..0000000 --- a/test.pl +++ /dev/null @@ -1,6 +0,0 @@ -use Catacomb qw(:const); - -($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 f18025c..a4f6297 100644 --- a/typemap +++ b/typemap @@ -3,8 +3,6 @@ const char * T_PV mp * T_MP gf * T_MP -GE * T_CATSTRUCT -EC_Point * T_CATSTRUCT EC_Curve * T_CATSTRUCT EC_Info * T_CATSTRUCT Field * T_CATSTRUCT @@ -18,9 +16,19 @@ gMAC * T_GALG grand * T_GALG keysize * T_KEYSZ +fe * T_FIELDELT +ec * T_ECPT +ge * T_GROUPELT + Rand_True * T_CATSTRUCT Rand_DSA * T_CATSTRUCT +Share_GF * T_CATSTRUCT +Share_Prime * T_CATSTRUCT + +PRP * T_CATSTRUCT +PRPClass * T_CATSTRUCT + MP_Mont * T_CATSTRUCT MP_Barrett * T_CATSTRUCT MP_Mul * T_CATSTRUCT @@ -38,16 +46,30 @@ MP_Prime_Gen_JumpStepper * T_CATSTRUCT MP_Prime_Gen_RabinTester * T_CATSTRUCT Key_File * T_CATSTRUCT -Key_Data * T_CATSTRUCT +Key_DataImpl * T_CATSTRUCT +Key_AttrIter * T_CATSTRUCT +Key_StructIter * T_CATSTRUCT +Key_FileIter * T_CATSTRUCT +Key_Filter * T_CATSTRUCTUNDEF Key * T_CATSTRUCT - KeyErr T_KEYERR +RSA_Public * T_CATSTRUCT +RSA_Private * T_CATSTRUCT + INPUT T_MP - $var = mp_fromsv($arg, \"$var\", \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::\U$1/; $ntt =~ s/_/::/g; \$ntt}\", 0, 0) + $var = mp_fromsv($arg, \"$var\", 0, 0) T_CATSTRUCT $var = ptrfromsv($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\", \"$var\") +T_CATSTRUCTUNDEF + $var = SvOK($arg) ? ptrfromsv($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\", \"$var\") : 0 +T_FIELDELT + $var = fieldelt($arg, \"$var\") +T_GROUPELT + $var = groupelt($arg, \"$var\") +T_ECPT + $var = ecpt($arg, \"$var\") T_GALG $var = ptrfromsv($arg, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\", \"$var\") T_GCALG @@ -71,10 +93,18 @@ T_MP ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::\U$1/; $ntt =~ s/_/::/g; \$ntt}\"); T_CATSTRUCT ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\"); +T_CATSTRUCTUNDEF + ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\"); +T_FIELDELT + ptrtosv(&$arg, $var, \"Catacomb::MP\"); +T_GROUPELT + ptrtosv(&$arg, $var, \"Catacomb::Group::Element\"); +T_ECPT + ptrtosv(&$arg, $var, \"Catacomb::EC::Point\"); T_GALG ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\"); T_GCALG - ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\"); + ptrtosv(&$arg, $var, \"${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\"); T_KEYSZ ptrtosv(&$arg, (octet *)$var, \"Catacomb::KeySize\"); T_PGENPROC diff --git a/utils.c b/utils.c index e5b49f0..d57bc98 100644 --- a/utils.c +++ b/utils.c @@ -32,8 +32,65 @@ #include #include #include +#include +#include +#include -/*----- 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;