File Coverage

blib/lib/Crypt/Perl/ECDSA/EC/DB.pm
Criterion Covered Total %
statement 71 80 88.7
branch 16 20 80.0
condition 2 3 66.6
subroutine 14 15 93.3
pod 0 4 0.0
total 103 122 84.4


line stmt bran cond sub pod time code
1             package Crypt::Perl::ECDSA::EC::DB;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Crypt::Perl::ECDSA::EC::DB - Interface to this module’s CurvesDB datastore
8              
9             =head1 SYNOPSIS
10              
11             my $oid = Crypt::Perl::ECDSA::EC::DB::get_oid_for_curve_name('prime256v1');
12              
13             my $data_hr = Crypt::Perl::ECDSA::EC::DB::get_curve_data_by_oid('1.2.840.10045.3.1.7');
14              
15             my $name = Crypt::Perl::ECDSA::EC::DB::get_curve_name_by_data(
16             p => ..., #isa Crypt::Perl::BigInt
17             a => ..., #isa Crypt::Perl::BigInt
18             b => ..., #isa Crypt::Perl::BigInt
19             n => ..., #isa Crypt::Perl::BigInt
20             h => ..., #isa Crypt::Perl::BigInt
21             gx => ..., #isa Crypt::Perl::BigInt
22             gy => ..., #isa Crypt::Perl::BigInt
23             seed => ..., #isa Crypt::Perl::BigInt, optional
24             );
25              
26             #The opposite query from the preceding.
27             my $data_hr = Crypt::Perl::ECDSA::EC::DB::get_curve_data_by_name('prime256v1');
28              
29             =head1 DISCUSSION
30              
31             This interface is undocumented for now.
32              
33             =cut
34              
35 7     7   279608 use strict;
  7         31  
  7         174  
36 7     7   28 use warnings;
  7         15  
  7         158  
37              
38 7     7   30 use Try::Tiny;
  7         11  
  7         332  
39              
40 7     7   1076 use Crypt::Perl::BigInt ();
  7         13  
  7         124  
41 7     7   32 use Crypt::Perl::X ();
  7         17  
  7         210  
42              
43             #----------------------------------------------------------------------
44             # p = prime
45             # generator (uncompressed) = \x04 . gx . gy
46             # n = order
47             # h = cofactor
48             #
49             # a and b fit into the general form for an elliptic curve:
50             #
51             # y^2 = x^3 + ax + b
52             #----------------------------------------------------------------------
53              
54             #“h” is determinable from the other curve parameters
55             #and should not be considered necessary to match.
56 7     7   37 use constant CURVE_EQUIVALENCY => qw( p a b n gx gy );
  7         16  
  7         497  
57              
58 7     7   37 use constant GETTER_CURVE_ORDER => ( CURVE_EQUIVALENCY(), 'h', 'seed' );
  7         27  
  7         5536  
59              
60             sub get_oid_for_curve_name {
61 298     298 0 792 my ($name) = @_;
62              
63 298         590 my $name_alt = $name;
64 298         683 $name_alt =~ tr<-><_>;
65              
66 298         4463 require Crypt::Perl::ECDSA::EC::CurvesDB;
67              
68 298         3248 my $translator_cr = Crypt::Perl::ECDSA::EC::CurvesDB->can("OID_$name_alt");
69 298 50       967 die Crypt::Perl::X::create('ECDSA::NoCurveForName', $name) if !$translator_cr;
70              
71 298         2123 return $translator_cr->();
72             }
73              
74             sub get_curve_name_by_data {
75 39     39 0 121 my ($data_hr) = @_;
76              
77 39         507 my %hex_data = map { $_ => substr( $data_hr->{$_}->as_hex(), 2 ) } keys %$data_hr;
  304         251747  
78              
79 39         30422 require Crypt::Perl::ECDSA::EC::CurvesDB;
80              
81 39         151 my $ns = \%Crypt::Perl::ECDSA::EC::CurvesDB::;
82              
83             NS_KEY:
84 39         7614 for my $key ( sort keys %$ns ) {
85 3560 100       5773 next if substr($key, 0, 4) ne 'OID_';
86              
87 1416         1554 my $oid;
88 1416 100       3173 if ('SCALAR' eq ref $ns->{$key}) {
    50          
89 1353         1629 $oid = ${ $ns->{$key} };
  1353         2864  
90             }
91 63         529 elsif ( *{$ns->{$key}}{'CODE'} ) {
92 63         279 $oid = $ns->{$key}->();
93             }
94             else {
95 0         0 next;
96             }
97              
98             #Avoid creating extra BigInt objects.
99 1416         1752 my $db_hex_data_hr;
100             try {
101 1416     1416   58248 $db_hex_data_hr = _get_curve_hex_data_by_oid($oid);
102             }
103             catch {
104 528 50   528   6677 if ( !try { $_->isa('Crypt::Perl::X::ECDSA::NoCurveForOID') } ) {
  528         13054  
105 0         0 local $@ = $_;
106 0         0 die;
107             }
108 1416         5773 };
109              
110 1416 100       15800 next if !$db_hex_data_hr; #i.e., if we have no params for the OID
111              
112 888         1749 for my $k ( CURVE_EQUIVALENCY() ) {
113 1083 100       3381 next NS_KEY if $hex_data{$k} ne $db_hex_data_hr->{$k};
114             }
115              
116             #We got a match!
117              
118 39         139 my $name = substr($key, 4); # strip leading “OID_”
119              
120             #We store dashes as underscores so we can use the namespace.
121             #Hopefully no curve OID name will ever contain an underscore!!
122 39         104 $name =~ tr<_><->;
123              
124             #… but let’s make sure the extras (cofactor and seed) are correct,
125             #if given. Note that all curves have cofactor == 1 except secp112r2 and
126             #secp128r2, both of which have cofactor == 4.
127             #
128 39         105 for my $k ( qw( h seed ) ) {
129 78 50 66     363 if ( defined $hex_data{$k} && $hex_data{$k} ne $db_hex_data_hr->{$k} ) {
130 0         0 die Crypt::Perl::X::create('Generic', "Curve parameters match “$name”, but “$k” ($hex_data{$k}) does not match expected value ($db_hex_data_hr->{$k})!");
131             }
132             }
133              
134 39         507 return $name;
135             }
136              
137 0         0 die Crypt::Perl::X::create('ECDSA::NoCurveForParameters', %hex_data);
138             }
139              
140             sub get_curve_data_by_name {
141 215     215 0 143579 my ($name) = @_;
142              
143 215         697 my $oid = get_oid_for_curve_name($name);
144              
145 215         544 return get_curve_data_by_oid( $oid );
146             }
147              
148             #This returns the same information as
149             #Crypt::Perl::ECDSA::ECParameters::normalize().
150             sub get_curve_data_by_oid {
151 530     530 0 1360 my ($oid) = @_;
152              
153 530         2086 my $data_hr = _get_curve_hex_data_by_oid($oid);
154              
155 330         2362 $_ = Crypt::Perl::BigInt->from_hex($_) for values %$data_hr;
156              
157 330         1573870 return $data_hr;
158             }
159              
160             sub _get_curve_hex_data_by_oid {
161 1946     1946   3566 my ($oid) = @_;
162              
163 1946         3822 my $const = "CURVE_$oid";
164 1946         3213 $const =~ tr<.><_>;
165              
166 1946         9251 require Crypt::Perl::ECDSA::EC::CurvesDB;
167              
168 1946         11881 my $getter_cr = Crypt::Perl::ECDSA::EC::CurvesDB->can($const);
169 1946 100       5715 die Crypt::Perl::X::create('ECDSA::NoCurveForOID', $oid) if !$getter_cr;
170              
171 1218         1662 my %data;
172 1218         11942 @data{ GETTER_CURVE_ORDER() } = $getter_cr->();
173              
174 1218 100       3465 delete $data{'seed'} if !$data{'seed'};
175              
176 1218         3006 return \%data;
177             }
178              
179             sub _upgrade_hex_to_bigint {
180 0     0     my ($data_hr) = @_;
181              
182 0           $_ = Crypt::Perl::BigInt->from_hex($_) for @{$data_hr}{ GETTER_CURVE_ORDER() };
  0            
183              
184 0           return;
185             }
186              
187             1;