X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/blobdiff_plain/f9952aec1cf6c64a5681308eea817b6113a37433..fcd15e0b7a3d0f0ca2f30953573f8d1f6b8e8bd2:/Catacomb/EC.pm

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 ----------------------------------------------------