--- /dev/null
+# -*-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 ----------------------------------------------------
~mdw / catacomb-perl / blobdiff