Much wider support for Catacomb in all its glory.
[catacomb-perl] / 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 ----------------------------------------------------