chiark - git - mdw - catacomb-perl/blob - Catacomb/EC.pm

   1 # -*-perl-*-
   2 #
   3 # $Id$
   4 #
   5 # Elliptic curves
   6 #
   7 # (c) 2004 Straylight/Edgeware
   8 #
   9
  10 #----- Licensing notice -----------------------------------------------------
  11 #
  12 # This file is part of the Perl interface to Catacomb.
  13 #
  14 # Catacomb/Perl is free software; you can redistribute it and/or modify
  15 # it under the terms of the GNU General Public License as published by
  16 # the Free Software Foundation; either version 2 of the License, or
  17 # (at your option) any later version.
  18 #
  19 # Catacomb/Perl is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with Catacomb/Perl; if not, write to the Free Software Foundation,
  26 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27
  28 #----- Elliptic curves ------------------------------------------------------
  29
  30 package Catacomb::EC::Curve;
  31 use Carp;
  32 use Catacomb::Base;
  33 use Catacomb::Cache;
  34 use Catacomb::Field;
  35
  36 $cache = Catacomb::Cache->new();
  37
  38 sub intern {
  39   croak("Usage: Catacomb::EC::Curve::intern(c)") unless @_ == 1;
  40   my ($c) = @_;
  41   return $cache->intern($c);
  42 }
  43
  44 sub pt {
  45   croak("Usage: Catacomb::EC::Curve::pt(c, [x, y | p])")
  46     unless @_ >= 1 && @_ <= 3;
  47   return Catacomb::EC::Pt->new(@_);
  48 }
  49
  50 sub a {
  51   croak("Usage: Catacomb::EC::Curve::a(c)") unless @_ == 1;
  52   my ($c) = @_;
  53   return $c->field()->elt($c->_a());
  54 }
  55
  56 sub b {
  57   croak("Usage: Catacomb::EC::Curve::b(c)") unless @_ == 1;
  58   my ($c) = @_;
  59   return $c->field()->elt($c->_b());
  60 }
  61
  62 sub inf {
  63   croak("Usage: Catacomb::EC::Curve::inf(c)") unless @_ == 1;
  64   return Catacomb::EC::Pt->new($_[0]);
  65 }
  66
  67 sub getraw {
  68   croak("Usage: Catacomb::EC::Curve::getraw(c, s)") unless @_ == 2;
  69   my ($c, $s) = @_;
  70   my ($p, $rest) = $c->_getraw($s);
  71   $p = Catacomb::EC::Pt->new($c, $p);
  72   return !wantarray() ? $p : ($p, $rest);
  73 }
  74
  75 sub find {
  76   croak("Usage: Catacomb::EC::Curve::find(c, x)") unless @_ == 2;
  77   my ($c, $x) = @_;
  78   my $p = $c->_find($x);
  79   return undef unless defined $p;
  80   return Catacomb::EC::Pt->new($c, $p);
  81 }
  82
  83 sub rand {
  84   croak("Usage: Catacomb::EC::Curve::rand(c, [rng])")
  85     unless @_ >= 1 && @_ <= 2;
  86   my ($c, $rng) = @_;
  87   $rng ||= $Catacomb::random;
  88   my $p = $c->_rand($rng);
  89   return Catacomb::EC::Pt->new($c, $p);
  90 }
  91
  92 sub mmul {
  93   croak("Usage: Catacomb::EC::Curve::mmul(c, p_0, x_0, p_1, x_1, ...)")
  94     unless @_ >= 3 && @_ % 2 == 1;
  95   my $c = pop(@_);
  96   my $i;
  97   my @v = ();
  98   my @r = ();
  99   for ($i = 0; $i < @_; $i += 2) {
 100     my $p = $_[$i];
 101     my $n = $_[$i + 1];
 102     if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) {
 103       $p->[1] == $c or croak("curve mismatch");
 104       @r or @r = @$p[1, 2, 3, 4];
 105       $p = $p->[0];
 106     } elsif (UNIVERSAL::isa($p, Catacomb::EC::Point)) {
 107       $p = $c->in($p);
 108     } else {
 109       croak("not a curve point");
 110     }
 111     push(@v, $p, $n);
 112   }
 113   unless (@r) {
 114     my ($cr, $f, $fr);
 115     ($c, $cr) = $c->intern();
 116     ($f, $fr) = $c->field()->intern();
 117     @r = ($c, $cr, $f, $fr);
 118   }
 119   return Catacomb::EC::Pt::_pt(immul($c, @v), $c, $cr, $f, $fr);
 120 }
 121
 122 sub getinfo {
 123   croak("Usage: Catacomb::EC::Curve::getinfo(me, spec)") unless @_ == 2;
 124   my ($me, $spec) = @_;
 125   my ($c, $p, $r, $h) = _getinfo($me, $spec);
 126   my $cr;
 127   ($c, $cr) = $c->intern();
 128   return $c, $c->pt($p), $r, $h;
 129 }
 130
 131 sub ecgroup {
 132   croak("Usage: Catacomb::EC::Curve::ecgroup(c, p, r, h)") unless @_ == 4;
 133   return Catacomb::Group->ec(@_);
 134 }
 135
 136 #----- Elliptic curve points ------------------------------------------------
 137
 138 package Catacomb::EC::Point;
 139
 140 sub tostring {
 141   croak("Usage: Catacomb::EC::Point::tostring(p)") unless @_ == 1;
 142   my ($p) = @_;
 143   if ($p->atinfp()) {
 144     return "inf";
 145   } else {
 146     return "0x" . $p->x()->tostring(16) . ", 0x" . $p->y()->tostring(16);
 147   }
 148 }
 149
 150 package Catacomb::EC::Pt;
 151 use Carp;
 152 use Catacomb::Base;
 153 use Catacomb::Field;
 154
 155 sub _pt { bless [@_], Catacomb::EC::Pt; }
 156
 157 sub _convert {
 158   my ($c, $cr, $f, $fr, $x) = @_;
 159   if (UNIVERSAL::isa($x, Catacomb::EC::Pt)) {
 160     croak("curve mismatch") unless $c == $x->[1];
 161     return $x;
 162   }
 163   if (UNIVERSAL::isa($x, Catacomb::EC::Point)) {
 164     return _pt($x, $c, $cr, $f, $fr);
 165   }
 166   croak("can't convert to curve point");
 167 }
 168
 169 sub new {
 170   croak("Usage: Catacomb::EC::Pt::new(me, c, [x, y | p])")
 171     unless @_ >= 2 && @_ <= 4;
 172   my ($me, $c, $p);
 173   if (@_ == 2) {
 174     ($me, $c) = @_;
 175     $p = Catacomb::EC::Point->new();
 176   } elsif (@_ == 3) {
 177     ($me, $c, $p) = @_;
 178     if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) {
 179       $p = $p->point();
 180     } elsif (!UNIVERSAL::isa($p, Catacomb::EC::Point)) {
 181       croak("not a curve point");
 182     }
 183   } else {
 184     my ($x, $y);
 185     ($me, $c, $x, $y) = @_;
 186     $p = Catacomb::EC::Point->new($x, $y);
 187   }
 188   my ($cr, $f, $fr);
 189   ($c, $cr) = $c->intern();
 190   ($f, $fr) = $c->field()->intern();
 191   return _pt($c->in($p), $c, $cr, $f, $fr);
 192 }
 193
 194 sub point {
 195   croak("Usage: Catacomb::EC::Pt::point(p)") unless @_ == 1;
 196   return $_[0][1]->out($_[0][0]);
 197 }
 198
 199 sub curve {
 200   croak("Usage: Catacomb::EC::Pt::curve(p)") unless @_ == 1;
 201   return $_[0][1];
 202 }
 203
 204 sub field {
 205   croak("Usage: Catacomb::EC::Pt::field(p)") unless @_ == 1;
 206   return $_[0][3];
 207 }
 208
 209 sub atinfp {
 210   croak("Usage: Catacomb::EC::Pt::atinfp(p)") unless @_ == 1;
 211   return $_[0]->point()->atinfp();
 212 }
 213
 214 sub x {
 215   croak("Usage: Catacomb::EC::Pt::x(p)") unless @_ == 1;
 216   return $_[0][3]->elt($_[0]->point()->x());
 217 }
 218
 219 sub y {
 220   croak("Usage: Catacomb::EC::Pt::y(p)") unless @_ == 1;
 221   return $_[0][3]->elt($_[0]->point()->y());
 222 }
 223
 224 sub check {
 225   croak("Usage: Catacomb::EC::Curve::check(c)") unless @_ == 1;
 226   return $_[0][1]->check($_[0][0]);
 227 }
 228
 229 sub pt {
 230   croak("Usage: Catacomb::EC::Pt::pt(pp, [x, y | p])")
 231     unless @_ >= 1 && @_ <= 3;
 232   my ($pp, $p);
 233   if (@_ == 1) {
 234     ($pp) = @_;
 235     $p = Catacomb::EC::Point->new();
 236   } elsif (@_ == 2) {
 237     ($pp, $p) = @_;
 238     if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) {
 239       $p = $p->point();
 240     } elsif (!UNIVERSAL::isa($p, Catacomb::EC::Point)) {
 241       croak("not a curve point");
 242     }
 243   } else {
 244     my ($x, $y);
 245     ($pp, $x, $y) = @_;
 246     $p = Catacomb::EC::Point->new($x, $y);
 247   }
 248   my (undef, $c, $cr, $f, $fr) = @$pp;
 249   return _pt($c->in($p), $c, $cr, $f, $fr);
 250 }
 251
 252 sub _binop {
 253   my ($op, $x, $y, $swap) = @_;
 254   my (undef, $c, $cr, $f, $fr) = @$x;
 255   $y = _convert($c, $cr, $f, $fr, $y);
 256   my $z = $swap ?
 257     &$op($c, $x->[0], $y->[0]) :
 258     &$op($c, $y->[0], $x->[0]);
 259   return _pt($z, $c, $cr, $f, $fr);
 260 }
 261
 262 sub _unop {
 263   my ($op, $x) = @_;
 264   my (undef, $c, $cr, $f, $fr) = @$x;
 265   my $z =  &$op($c, $x->[0]);
 266   return _pt($z, $c, $cr, $f, $fr);
 267 }
 268
 269 sub _eq {
 270   my ($x, $y) = @_;
 271   my (undef, $c, $cr, $f, $fr) = @$x;
 272   $y = _convert($c, $cr, $f, $fr, $y);
 273   return Catacomb::EC::Point::eq($c->out($x), $c->out($y));
 274 }
 275
 276 sub mul {
 277   croak("Usage: Catacomb::EC::Pt::mul(p, n)") unless @_ == 2;
 278   my ($p, $x) = @_;
 279   my ($pp, $c, $cr, $f, $fr) = @$p;
 280   return _pt($c->imul($pp, $x), $c, $cr, $f, $fr);
 281 }
 282
 283 use overload
 284   '+' => sub { _binop(\&Catacomb::EC::Curve::iadd, @_); },
 285   '-' => sub { _binop(\&Catacomb::EC::Curve::isub, @_); },
 286   '*' => sub { mul($_[0], $_[1]); },
 287   '==' => sub { _eq(@_); },
 288   '!=' => sub { !_eq(@_); },
 289   'eq' => sub { _eq(@_); },
 290   'ne' => sub { !_eq(@_); },
 291   '""' => sub { $_[0]->point()->tostring(); },
 292   '0+' => sub { $_[0]->point()->x()->toint(); },
 293   'neg' => sub { _unop(\&Catacomb::EC::Curve::ineg, @_); };
 294
 295 #----- That's all, folks ----------------------------------------------------