File Coverage

lib/Crypt/Perl/RSA/Generate.pm
Criterion Covered Total %
statement 21 52 40.3
branch 0 12 0.0
condition 0 6 0.0
subroutine 7 9 77.7
pod 0 1 0.0
total 28 80 35.0


line stmt bran cond sub pod time code
1             package Crypt::Perl::RSA::Generate;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Crypt::Perl::RSA::Generate - RSA key generation
8              
9             =head1 SYNOPSIS
10              
11             use Crypt::Perl::RSA::Generate ();
12              
13             #$prkey is a Crypt::Perl::RSA::PrivateKey instance.
14             my $prkey = Crypt::Perl::RSA::Generate::create(2048);
15              
16             =head1 DISCUSSION
17              
18             Unfortunately, this is quite slow in Perl—too slow, in fact, if you
19             don’t have either L or L.
20             The logic here will still run under pure Perl, but it’ll take too long
21             to be practical.
22              
23             The current L backend is slated to be replaced
24             with L; once that happens, pure-Perl operation should
25             be much more feasible.
26              
27             =head1 ALTERNATIVES
28              
29             =over 4
30              
31             =item L - probably the fastest way to generate RSA
32             keys in perl. (It relies on XS, so this project can’t use it.)
33              
34             =item Use the C binary L directly,
35             e.g., C. Most *NIX systems can do this.
36              
37             =back
38              
39             NOTE: As of December 2016, L is NOT suitable for key
40             generation because it can only generate keys with up to a 512-bit modulus.
41              
42             =cut
43              
44 1     1   487 use strict;
  1         2  
  1         29  
45 1     1   4 use warnings;
  1         2  
  1         21  
46              
47 1     1   549 use Math::ProvablePrime ();
  1         14444  
  1         28  
48              
49 1     1   12 use Crypt::Perl::BigInt ();
  1         4  
  1         26  
50 1     1   532 use Crypt::Perl::RSA::PrivateKey ();
  1         3  
  1         22  
51 1     1   5 use Crypt::Perl::X ();
  1         2  
  1         17  
52              
53 1     1   3 use constant PUBLIC_EXPONENTS => ( 65537, 3 );
  1         2  
  1         356  
54              
55             sub create {
56 0     0 0   my ($mod_bits, $exp) = @_;
57              
58 0 0         die Crypt::Perl::X::create('Generic', "Need modulus length!") if !$mod_bits;
59              
60 0   0       $exp ||= (PUBLIC_EXPONENTS())[0];
61              
62 0 0         if (!grep { $exp eq $_ } PUBLIC_EXPONENTS()) {
  0            
63 0           my @allowed = PUBLIC_EXPONENTS();
64 0           die Crypt::Perl::X::create('Generic', "Invalid public exponent ($exp); should be one of: [@allowed]");
65             }
66              
67 0           my $qs = $mod_bits >> 1;
68 0 0         (ref $exp) or $exp = Crypt::Perl::BigInt->new($exp);
69              
70 0           while (1) {
71 0           my ($p, $q, $p1, $q1);
72              
73             #Create a random number, ($mod_bits - $qs) bits long.
74             {
75 0           $p = _get_random_prime($mod_bits - $qs);
76 0           $p1 = $p->copy()->bdec();
77              
78             #($p - 1) needs not to be a multiple of $exp
79 0 0         redo if $p1->copy()->bmod($exp)->is_zero();
80             }
81              
82             {
83 0           $q = _get_random_prime($qs);
  0            
  0            
84 0           $q1 = $q->copy()->bdec();
85              
86             #Same restriction as on $p applies to $q.
87             #Let’s also make sure these are two different numbers!
88 0 0 0       redo if $q1->copy()->bmod($exp)->is_zero() || $q->beq($p);
89             }
90              
91             #$p should be > $q
92 0 0         if ($p->blt($q)) {
93 0           my $t = $p;
94 0           $p = $q;
95 0           $q = $t;
96              
97 0           $t = $p1;
98 0           $p1 = $q1;
99 0           $q1 = $t;
100             }
101              
102 0           my $phi = $p1->copy()->bmul($q1);
103              
104 0           my $d = $exp->copy()->bmodinv($phi);
105              
106 0           my $obj = Crypt::Perl::RSA::PrivateKey->new(
107             {
108             version => 0,
109             modulus => $p->copy()->bmul($q),
110             publicExponent => $exp,
111             privateExponent => $d,
112             prime1 => $p,
113             prime2 => $q,
114             exponent1 => $d->copy()->bmod($p1),
115             exponent2 => $d->copy()->bmod($q1),
116             coefficient => $q->copy()->bmodinv($p),
117             },
118             );
119              
120 0           return $obj;
121             }
122             }
123              
124             sub _get_random_prime {
125 0     0     return Crypt::Perl::BigInt->new( Math::ProvablePrime::find(@_) );
126             }
127              
128             1;