File Coverage

blib/lib/Crypt/SRP.pm
Criterion Covered Total %
statement 213 307 69.3
branch 49 124 39.5
condition 37 120 30.8
subroutine 46 57 80.7
pod 20 20 100.0
total 365 628 58.1


line stmt bran cond sub pod time code
1             package Crypt::SRP;
2              
3             # Copyright (c) 2012+ DCIT, a.s. [http://www.dcit.cz] - Miko
4              
5 4     4   40475 use strict;
  4         6  
  4         109  
6 4     4   15 use warnings;
  4         5  
  4         167  
7              
8             our $VERSION = '0.017';
9              
10 4     4   3872 use Math::BigInt lib => 'LTM'; # Math::BigInt::LTM is part of CryptX-0.029+
  4         91085  
  4         19  
11 4     4   45339 use Crypt::Mac::HMAC qw(hmac);
  4         11082  
  4         216  
12 4     4   23 use Crypt::Digest qw(digest_data);
  4         5  
  4         170  
13 4     4   1755 use Crypt::Misc qw(encode_b64 decode_b64 encode_b64u decode_b64u);
  4         31627  
  4         286  
14 4     4   28 use Crypt::PRNG;
  4         4  
  4         115  
15 4     4   16 use Config;
  4         6  
  4         147  
16 4     4   14 use Carp;
  4         5  
  4         250  
17              
18 4     4   41 use constant _state_vars => [ qw(Bytes_I Bytes_K Bytes_M1 Bytes_M2 Bytes_P Bytes_s Num_a Num_A Num_b Num_B Num_k Num_S Num_u Num_v Num_x) ];
  4         5  
  4         380  
19 4     4   20 use constant _static_vars => [ qw(HASH INTERLEAVED GROUP FORMAT SALT_LEN) ];
  4         4  
  4         824  
20              
21             ### predefined parameters - see http://tools.ietf.org/html/rfc5054 appendix A
22              
23 4         15336 use constant _predefined_groups => {
24             'RFC5054-1024bit' => {
25             g => 2,
26             N => q[
27             EEAF0AB9 ADB38DD6 9C33F80A FA8FC5E8 60726187 75FF3C0B 9EA2314C
28             9C256576 D674DF74 96EA81D3 383B4813 D692C6E0 E0D5D8E2 50B98BE4
29             8E495C1D 6089DAD1 5DC7D7B4 6154D6B6 CE8EF4AD 69B15D49 82559B29
30             7BCF1885 C529F566 660E57EC 68EDBC3C 05726CC0 2FD4CBF4 976EAA9A
31             FD5138FE 8376435B 9FC61D2F C0EB06E3
32             ],
33             },
34             'RFC5054-1536bit' => {
35             g => 2,
36             N => q[
37             9DEF3CAF B939277A B1F12A86 17A47BBB DBA51DF4 99AC4C80 BEEEA961
38             4B19CC4D 5F4F5F55 6E27CBDE 51C6A94B E4607A29 1558903B A0D0F843
39             80B655BB 9A22E8DC DF028A7C EC67F0D0 8134B1C8 B9798914 9B609E0B
40             E3BAB63D 47548381 DBC5B1FC 764E3F4B 53DD9DA1 158BFD3E 2B9C8CF5
41             6EDF0195 39349627 DB2FD53D 24B7C486 65772E43 7D6C7F8C E442734A
42             F7CCB7AE 837C264A E3A9BEB8 7F8A2FE9 B8B5292E 5A021FFF 5E91479E
43             8CE7A28C 2442C6F3 15180F93 499A234D CF76E3FE D135F9BB
44             ],
45             },
46             'RFC5054-2048bit' => {
47             g => 2,
48             N => q[
49             AC6BDB41 324A9A9B F166DE5E 1389582F AF72B665 1987EE07 FC319294
50             3DB56050 A37329CB B4A099ED 8193E075 7767A13D D52312AB 4B03310D
51             CD7F48A9 DA04FD50 E8083969 EDB767B0 CF609517 9A163AB3 661A05FB
52             D5FAAAE8 2918A996 2F0B93B8 55F97993 EC975EEA A80D740A DBF4FF74
53             7359D041 D5C33EA7 1D281E44 6B14773B CA97B43A 23FB8016 76BD207A
54             436C6481 F1D2B907 8717461A 5B9D32E6 88F87748 544523B5 24B0D57D
55             5EA77A27 75D2ECFA 032CFBDB F52FB378 61602790 04E57AE6 AF874E73
56             03CE5329 9CCC041C 7BC308D8 2A5698F3 A8D0C382 71AE35F8 E9DBFBB6
57             94B5C803 D89F7AE4 35DE236D 525F5475 9B65E372 FCD68EF2 0FA7111F
58             9E4AFF73
59             ],
60             },
61             'RFC5054-3072bit' => {
62             g => 5,
63             N => q[
64             FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1 29024E08
65             8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD EF9519B3 CD3A431B
66             302B0A6D F25F1437 4FE1356D 6D51C245 E485B576 625E7EC6 F44C42E9
67             A637ED6B 0BFF5CB6 F406B7ED EE386BFB 5A899FA5 AE9F2411 7C4B1FE6
68             49286651 ECE45B3D C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8
69             FD24CF5F 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D
70             670C354E 4ABC9804 F1746C08 CA18217C 32905E46 2E36CE3B E39E772C
71             180E8603 9B2783A2 EC07A28F B5C55DF0 6F4C52C9 DE2BCBF6 95581718
72             3995497C EA956AE5 15D22618 98FA0510 15728E5A 8AAAC42D AD33170D
73             04507A33 A85521AB DF1CBA64 ECFB8504 58DBEF0A 8AEA7157 5D060C7D
74             B3970F85 A6E1E4C7 ABF5AE8C DB0933D7 1E8C94E0 4A25619D CEE3D226
75             1AD2EE6B F12FFA06 D98A0864 D8760273 3EC86A64 521F2B18 177B200C
76             BBE11757 7A615D6C 770988C0 BAD946E2 08E24FA0 74E5AB31 43DB5BFC
77             E0FD108E 4B82D120 A93AD2CA FFFFFFFF FFFFFFFF
78             ],
79             },
80             'RFC5054-4096bit' => {
81             g => 5,
82             N => q[
83             FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1 29024E08
84             8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD EF9519B3 CD3A431B
85             302B0A6D F25F1437 4FE1356D 6D51C245 E485B576 625E7EC6 F44C42E9
86             A637ED6B 0BFF5CB6 F406B7ED EE386BFB 5A899FA5 AE9F2411 7C4B1FE6
87             49286651 ECE45B3D C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8
88             FD24CF5F 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D
89             670C354E 4ABC9804 F1746C08 CA18217C 32905E46 2E36CE3B E39E772C
90             180E8603 9B2783A2 EC07A28F B5C55DF0 6F4C52C9 DE2BCBF6 95581718
91             3995497C EA956AE5 15D22618 98FA0510 15728E5A 8AAAC42D AD33170D
92             04507A33 A85521AB DF1CBA64 ECFB8504 58DBEF0A 8AEA7157 5D060C7D
93             B3970F85 A6E1E4C7 ABF5AE8C DB0933D7 1E8C94E0 4A25619D CEE3D226
94             1AD2EE6B F12FFA06 D98A0864 D8760273 3EC86A64 521F2B18 177B200C
95             BBE11757 7A615D6C 770988C0 BAD946E2 08E24FA0 74E5AB31 43DB5BFC
96             E0FD108E 4B82D120 A9210801 1A723C12 A787E6D7 88719A10 BDBA5B26
97             99C32718 6AF4E23C 1A946834 B6150BDA 2583E9CA 2AD44CE8 DBBBC2DB
98             04DE8EF9 2E8EFC14 1FBECAA6 287C5947 4E6BC05D 99B2964F A090C3A2
99             233BA186 515BE7ED 1F612970 CEE2D7AF B81BDD76 2170481C D0069127
100             D5B05AA9 93B4EA98 8D8FDDC1 86FFB7DC 90A6C08F 4DF435C9 34063199
101             FFFFFFFF FFFFFFFF
102             ],
103             },
104             'RFC5054-6144bit' => {
105             g => 5,
106             N => q[
107             FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1 29024E08
108             8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD EF9519B3 CD3A431B
109             302B0A6D F25F1437 4FE1356D 6D51C245 E485B576 625E7EC6 F44C42E9
110             A637ED6B 0BFF5CB6 F406B7ED EE386BFB 5A899FA5 AE9F2411 7C4B1FE6
111             49286651 ECE45B3D C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8
112             FD24CF5F 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D
113             670C354E 4ABC9804 F1746C08 CA18217C 32905E46 2E36CE3B E39E772C
114             180E8603 9B2783A2 EC07A28F B5C55DF0 6F4C52C9 DE2BCBF6 95581718
115             3995497C EA956AE5 15D22618 98FA0510 15728E5A 8AAAC42D AD33170D
116             04507A33 A85521AB DF1CBA64 ECFB8504 58DBEF0A 8AEA7157 5D060C7D
117             B3970F85 A6E1E4C7 ABF5AE8C DB0933D7 1E8C94E0 4A25619D CEE3D226
118             1AD2EE6B F12FFA06 D98A0864 D8760273 3EC86A64 521F2B18 177B200C
119             BBE11757 7A615D6C 770988C0 BAD946E2 08E24FA0 74E5AB31 43DB5BFC
120             E0FD108E 4B82D120 A9210801 1A723C12 A787E6D7 88719A10 BDBA5B26
121             99C32718 6AF4E23C 1A946834 B6150BDA 2583E9CA 2AD44CE8 DBBBC2DB
122             04DE8EF9 2E8EFC14 1FBECAA6 287C5947 4E6BC05D 99B2964F A090C3A2
123             233BA186 515BE7ED 1F612970 CEE2D7AF B81BDD76 2170481C D0069127
124             D5B05AA9 93B4EA98 8D8FDDC1 86FFB7DC 90A6C08F 4DF435C9 34028492
125             36C3FAB4 D27C7026 C1D4DCB2 602646DE C9751E76 3DBA37BD F8FF9406
126             AD9E530E E5DB382F 413001AE B06A53ED 9027D831 179727B0 865A8918
127             DA3EDBEB CF9B14ED 44CE6CBA CED4BB1B DB7F1447 E6CC254B 33205151
128             2BD7AF42 6FB8F401 378CD2BF 5983CA01 C64B92EC F032EA15 D1721D03
129             F482D7CE 6E74FEF6 D55E702F 46980C82 B5A84031 900B1C9E 59E7C97F
130             BEC7E8F3 23A97A7E 36CC88BE 0F1D45B7 FF585AC5 4BD407B2 2B4154AA
131             CC8F6D7E BF48E1D8 14CC5ED2 0F8037E0 A79715EE F29BE328 06A1D58B
132             B7C5DA76 F550AA3D 8A1FBFF0 EB19CCB1 A313D55C DA56C9EC 2EF29632
133             387FE8D7 6E3C0468 043E8F66 3F4860EE 12BF2D5B 0B7474D6 E694F91E
134             6DCC4024 FFFFFFFF FFFFFFFF
135             ],
136             },
137             'RFC5054-8192bit' => {
138             g => 19,
139             N => q[
140             FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1 29024E08
141             8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD EF9519B3 CD3A431B
142             302B0A6D F25F1437 4FE1356D 6D51C245 E485B576 625E7EC6 F44C42E9
143             A637ED6B 0BFF5CB6 F406B7ED EE386BFB 5A899FA5 AE9F2411 7C4B1FE6
144             49286651 ECE45B3D C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8
145             FD24CF5F 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D
146             670C354E 4ABC9804 F1746C08 CA18217C 32905E46 2E36CE3B E39E772C
147             180E8603 9B2783A2 EC07A28F B5C55DF0 6F4C52C9 DE2BCBF6 95581718
148             3995497C EA956AE5 15D22618 98FA0510 15728E5A 8AAAC42D AD33170D
149             04507A33 A85521AB DF1CBA64 ECFB8504 58DBEF0A 8AEA7157 5D060C7D
150             B3970F85 A6E1E4C7 ABF5AE8C DB0933D7 1E8C94E0 4A25619D CEE3D226
151             1AD2EE6B F12FFA06 D98A0864 D8760273 3EC86A64 521F2B18 177B200C
152             BBE11757 7A615D6C 770988C0 BAD946E2 08E24FA0 74E5AB31 43DB5BFC
153             E0FD108E 4B82D120 A9210801 1A723C12 A787E6D7 88719A10 BDBA5B26
154             99C32718 6AF4E23C 1A946834 B6150BDA 2583E9CA 2AD44CE8 DBBBC2DB
155             04DE8EF9 2E8EFC14 1FBECAA6 287C5947 4E6BC05D 99B2964F A090C3A2
156             233BA186 515BE7ED 1F612970 CEE2D7AF B81BDD76 2170481C D0069127
157             D5B05AA9 93B4EA98 8D8FDDC1 86FFB7DC 90A6C08F 4DF435C9 34028492
158             36C3FAB4 D27C7026 C1D4DCB2 602646DE C9751E76 3DBA37BD F8FF9406
159             AD9E530E E5DB382F 413001AE B06A53ED 9027D831 179727B0 865A8918
160             DA3EDBEB CF9B14ED 44CE6CBA CED4BB1B DB7F1447 E6CC254B 33205151
161             2BD7AF42 6FB8F401 378CD2BF 5983CA01 C64B92EC F032EA15 D1721D03
162             F482D7CE 6E74FEF6 D55E702F 46980C82 B5A84031 900B1C9E 59E7C97F
163             BEC7E8F3 23A97A7E 36CC88BE 0F1D45B7 FF585AC5 4BD407B2 2B4154AA
164             CC8F6D7E BF48E1D8 14CC5ED2 0F8037E0 A79715EE F29BE328 06A1D58B
165             B7C5DA76 F550AA3D 8A1FBFF0 EB19CCB1 A313D55C DA56C9EC 2EF29632
166             387FE8D7 6E3C0468 043E8F66 3F4860EE 12BF2D5B 0B7474D6 E694F91E
167             6DBE1159 74A3926F 12FEE5E4 38777CB6 A932DF8C D8BEC4D0 73B931BA
168             3BC832B6 8D9DD300 741FA7BF 8AFC47ED 2576F693 6BA42466 3AAB639C
169             5AE4F568 3423B474 2BF1C978 238F16CB E39D652D E3FDB8BE FC848AD9
170             22222E04 A4037C07 13EB57A8 1A23F0C7 3473FC64 6CEA306B 4BCBC886
171             2F8385DD FA9D4B7F A2C087E8 79683303 ED5BDD3A 062B3CF5 B3A278A6
172             6D2A13F8 3F44F82D DF310EE0 74AB6A36 4597E899 A0255DC1 64F31CC5
173             0846851D F9AB4819 5DED7EA1 B1D510BD 7EE74D73 FAF36BC3 1ECFA268
174             359046F4 EB879F92 4009438B 481C6CD7 889A002E D5EE382B C9190DA6
175             FC026E47 9558E447 5677E9AA 9E3050E2 765694DF C81F56E8 80B96E71
176             60C980DD 98EDD3DF FFFFFFFF FFFFFFFF
177             ],
178             },
179 4     4   19 };
  4         6  
180              
181             ### class constructor
182              
183             sub new {
184 5     5 1 4944 my ($class, $group, $hash, $format, $interleaved, $default_salt_len) = @_;
185 5         8 my $self = bless {}, $class;
186              
187 5   50     16 $self->{GROUP} = $group || 'RFC5054-2048bit';
188 5   50     11 $self->{HASH} = $hash || 'SHA256';
189 5   100     15 $self->{FORMAT} = $format || 'raw';
190 5   50     14 $self->{INTERLEAVED} = $interleaved || 0;
191 5   50     18 $self->{SALT_LEN} = $default_salt_len || 32;
192              
193 5         7 $self->_initialize();
194 5         13 return $self;
195             }
196              
197             ### class PUBLIC methods
198              
199             sub reset {
200 0     0 1 0 my ($self, $group, $hash, $format, $interleaved, $default_salt_len) = @_;
201              
202 0 0       0 $self->{GROUP} = $group if defined $group;
203 0 0       0 $self->{HASH} = $hash if defined $hash;
204 0 0       0 $self->{FORMAT} = $format if defined $format;
205 0 0       0 $self->{INTERLEAVED} = $interleaved if defined $interleaved;
206 0 0       0 $self->{SALT_LEN} = $default_salt_len if defined $default_salt_len;
207              
208 0         0 delete $self->{$_} for (@{_state_vars()});
  0         0  
209              
210 0         0 $self->_initialize();
211 0         0 return $self;
212             }
213              
214             sub dump {
215 0     0 1 0 my $self = shift;
216 0         0 my $state = [ map {$self->{$_}} (@{_state_vars()}, @{_static_vars()}) ];
  0         0  
  0         0  
  0         0  
217 0 0       0 eval { require Storable } or croak "FATAL: dump() requires Storable";
  0         0  
218 0         0 return encode_b64(Storable::nfreeze($state));
219             }
220              
221             sub load {
222 0     0 1 0 my ($self, $state) = @_;
223 0         0 $self->reset;
224 0 0       0 eval { require Storable } or croak "FATAL: load() requires Storable";
  0         0  
225 0         0 my $s = Storable::thaw(decode_b64($state));
226 0         0 my @list = (@{_state_vars()}, @{_static_vars()});
  0         0  
  0         0  
227 0         0 $self->{$list[$_]} = $s->[$_] for 0..$#list;
228 0         0 $self->_initialize();
229 0         0 return $self;
230             }
231              
232             sub client_init {
233 3     3 1 5 my ($self, $Bytes_I, $Bytes_P, $Bytes_s, $Bytes_B, $Bytes_A, $Bytes_a) = @_;
234             # do not unformat $Bytes_I, $Bytes_P
235 3         5 $self->{Bytes_I} = $Bytes_I;
236 3         4 $self->{Bytes_P} = $Bytes_P;
237 3         6 $self->{Bytes_s} = $self->_unformat($Bytes_s);
238 3         8 $self->{Num_x} = $self->_calc_x(); # x = HASH(s | HASH(I | ":" | P))
239             #optional params
240 3 100       10 $self->{Num_B} = _bytes2bignum($self->_unformat($Bytes_B)) if defined $Bytes_B;
241 3 50       52 $self->{Num_A} = _bytes2bignum($self->_unformat($Bytes_A)) if defined $Bytes_A;
242 3 50       5 $self->{Num_a} = _bytes2bignum($self->_unformat($Bytes_a)) if defined $Bytes_a;
243 3         4 return $self;
244             }
245              
246             sub server_init {
247 2     2 1 9 my ($self, $Bytes_I, $Bytes_v, $Bytes_s, $Bytes_A, $Bytes_B, $Bytes_b) = @_;
248             # do not unformat $Bytes_I
249 2         3 $self->{Bytes_I} = $Bytes_I;
250 2         4 $self->{Num_v} = _bytes2bignum($self->_unformat($Bytes_v));
251 2         105 $self->{Bytes_s} = $self->_unformat($Bytes_s);
252             #optional params
253 2 100       7 $self->{Num_A} = _bytes2bignum($self->_unformat($Bytes_A)) if defined $Bytes_A;
254 2 100       52 $self->{Num_B} = _bytes2bignum($self->_unformat($Bytes_B)) if defined $Bytes_B;
255 2 100       57 $self->{Num_b} = _bytes2bignum($self->_unformat($Bytes_b)) if defined $Bytes_b;
256 2         29 return $self;
257             }
258              
259             sub client_compute_A {
260 1     1 1 40 my ($self, $a_len) = @_;
261 1         3 $self->{Num_a} = $self->_generate_SRP_a($a_len); # a = random() // a has min 256 bits, a < N
262 1         4 $self->{Num_A} = $self->_calc_A; # A = g^a % N
263 1         2 my $Bytes_A = _bignum2bytes($self->{Num_A});
264 1         3 my $Bytes_a = _bignum2bytes($self->{Num_a});
265 1         3 return ($self->_format($Bytes_A), $self->_format($Bytes_a));
266             }
267              
268             sub client_compute_M1 {
269 1     1 1 3 my ($self) = @_;
270 1         3 $self->{Num_u} = $self->_calc_u; # u = HASH(PAD(A) | PAD(B))
271 1         3 $self->{Num_k} = $self->_calc_k; # k = HASH(N | PAD(g))
272 1         3 $self->{Num_S} = $self->_calc_S_client; # S = (B - (k * ((g^x)%N) )) ^ (a + (u * x)) % N
273 1         4 $self->{Bytes_K} = $self->_calc_K; # K = HASH( PAD(S) )
274 1         4 $self->{Bytes_M1} = $self->_calc_M1; # M1 = HASH( HASH(N) XOR HASH(PAD(g)) | HASH(I) | s | PAD(A) | PAD(B) | K )
275 1         3 return $self->_format($self->{Bytes_M1});
276             }
277              
278             sub client_verify_M2 {
279 1     1 1 3 my ($self, $Bytes_M2) = @_;
280 1         3 $Bytes_M2 = $self->_unformat($Bytes_M2);
281 1         2 my $M2 = $self->_calc_M2; # M2 = HASH( PAD(A) | M1 | K )
282 1 50 33     7 return 0 unless defined $Bytes_M2 && defined $M2 && $Bytes_M2 eq $M2;
      33        
283 1         1 $self->{Bytes_M2} = $M2;
284 1         2 return 1;
285             }
286              
287             sub server_compute_B {
288 1     1 1 36 my ($self, $b_len) = @_;
289 1         3 $self->{Num_b} = $self->_generate_SRP_b($b_len); # b = random() // b has min 256 bits, b < N
290 1         3 $self->{Num_k} = $self->_calc_k; # k = HASH(N | PAD(g))
291 1         4 $self->{Num_B} = $self->_calc_B; # B = ( k*v + (g^b % N) ) % N
292 1         3 my $Bytes_B = _bignum2bytes($self->{Num_B});
293 1         3 my $Bytes_b = _bignum2bytes($self->{Num_b});
294 1         3 return ($self->_format($Bytes_B), $self->_format($Bytes_b));
295             }
296              
297             sub server_fake_B_s {
298 0     0 1 0 my ($self, $I, $nonce, $s_len) = @_;
299 0 0       0 return unless $I;
300 0   0     0 $s_len ||= $self->{SALT_LEN};
301             # default $nonce should be fixed for repeated invocation on the same machine (in different processes)
302 0   0     0 $nonce ||= join(":", @INC, $Config{archname}, $Config{myuname}, $^X, $^V, $<, $(, $ENV{PATH}, $ENV{HOSTNAME}, $ENV{HOME});
303 0         0 my $b = _bytes2bignum(_random_bytes(6)); #NOTE: maybe too short but we do not want to waste too much CPU on modpow
304 0         0 my $B = _bignum2bytes($self->{Num_g}->copy->bmodpow($b, $self->{Num_N}));
305 0         0 my $s = '';
306 0         0 my $i = 1;
307 0         0 $s .= hmac('SHA256', $nonce.$i++, $I) while length($s) < $s_len;
308 0         0 $s = substr($s, 0, $s_len);
309 0         0 return ($self->_format($B), $self->_format($s));
310             }
311              
312             sub server_verify_M1 {
313 1     1 1 5 my ($self, $Bytes_M1) = @_;
314 1         2 $Bytes_M1 = $self->_unformat($Bytes_M1);
315 1         3 $self->{Num_u} = $self->_calc_u; # u = HASH(PAD(A) | PAD(B))
316 1         3 $self->{Num_S} = $self->_calc_S_server; # S = ( (A * ((v^u)%N)) ^ b) % N
317 1         3 $self->{Bytes_K} = $self->_calc_K; # K = HASH( PAD(S) )
318 1         2 my $M1 = $self->_calc_M1; # M1 = HASH( HASH(N) XOR HASH(PAD(g)) | HASH(I) | s | PAD(A) | PAD(B) | K )
319 1 50       4 return 0 unless $Bytes_M1 eq $M1;
320 1         1 $self->{Bytes_M1} = $M1;
321 1         2 return 1;
322             }
323              
324             sub server_compute_M2 {
325 1     1 1 3 my ($self) = @_;
326 1         3 $self->{Bytes_M2} = $self->_calc_M2; # M2 = HASH( PAD(A) | M1 | K )
327 1         3 return $self->_format($self->{Bytes_M2});
328             }
329              
330             sub get_secret_K {
331 4     4 1 8 my ($self, $format) = @_;
332 4         6 return $self->_format($self->{Bytes_K}, $format);
333             }
334              
335             sub get_secret_S {
336 4     4 1 8 my ($self, $format) = @_;
337 4         5 return $self->_format(_bignum2bytes($self->{Num_S}), $format);
338             }
339              
340             sub compute_verifier {
341 2     2 1 3 my ($self, $Bytes_I, $Bytes_P, $salt) = @_;
342             # do not unformat: $Bytes_I, $Bytes_P
343 2         5 $self->client_init($Bytes_I, $Bytes_P, $salt);
344 2         6 return $self->_format($self->_calc_v);
345             }
346              
347             sub compute_verifier_and_salt {
348 0     0 1 0 my ($self, $Bytes_I, $Bytes_P, $salt_len) = @_;
349             # do not unformat $Bytes_I, $Bytes_P
350 0   0     0 $salt_len ||= $self->{SALT_LEN};
351 0         0 my $Bytes_s = _random_bytes($salt_len);
352 0         0 $self->client_init($Bytes_I, $Bytes_P, $self->_format($Bytes_s));
353 0         0 return ($self->_format($self->_calc_v), $self->_format($Bytes_s));
354             }
355              
356             sub server_verify_A {
357 0     0 1 0 my ($self, $Bytes_A) = @_;
358 0         0 $Bytes_A = $self->_unformat($Bytes_A);
359 0 0       0 return 0 unless $self->_validate_A_or_B($Bytes_A);
360 0         0 $self->{Num_A} = _bytes2bignum($Bytes_A);
361 0         0 return 1;
362             }
363              
364             sub client_verify_B {
365 0     0 1 0 my ($self, $Bytes_B) = @_;
366 0         0 $Bytes_B = $self->_unformat($Bytes_B);
367 0 0       0 return 0 unless $self->_validate_A_or_B($Bytes_B);
368 0         0 $self->{Num_B} = _bytes2bignum($Bytes_B);
369 0         0 return 1;
370             }
371              
372             sub random_bytes {
373 0     0 1 0 my ($self, $len) = @_;
374 0 0       0 return _random_bytes($len) unless ref $self; # Crypt::SRP->random_bytes(32);
375 0         0 return $self->_format(_random_bytes($len)); # $srp->random_bytes(32);
376             }
377              
378             ### class PRIVATE methods
379              
380             sub _initialize {
381 5     5   3 my $self = shift;
382              
383             # setup N and g values
384 5 50       24 if ($self->{GROUP} =~ /RFC5054-(1024|1536|2048|3072|4096|6144|8192)bit$/) {
385 5         10 my $str = _predefined_groups->{$self->{GROUP}}->{N};
386 5         439 $str =~ s/[\r\n\s]*//sg;
387 5 50       15 $str = "0x$str" unless $str =~ /^0x/;
388 5         17 $self->{Num_N} = Math::BigInt->from_hex($str);
389 5         367 $self->{Num_g} = Math::BigInt->new(_predefined_groups->{$self->{GROUP}}->{g});
390 5         123 $self->{N_LENGTH} = length(_bignum2bytes($self->{Num_N}));
391             }
392             else {
393 0         0 croak "FATAL: invalid group_params '$self->{GROUP}'";
394             }
395              
396             # test hash function
397 5 50       8 croak "FATAL: invalid hash '$self->{HASH}'" unless defined $self->_HASH("test");
398 5         145 return $self;
399             }
400              
401             sub _HASH {
402 27     27   119 my ($self, $data) = @_;
403 27 50       112 return digest_data($self->{HASH}, $data) if $self->{HASH} =~ /^SHA(1|256|384|512)$/;
404 0         0 return undef;
405             }
406              
407             sub _HASH_Interleaved { #implemented according to http://tools.ietf.org/html/rfc2945 (3.1 Interleaved SHA)
408 0     0   0 my ($self, $data) = @_;
409             #we assume no leading zero bytes in $data
410 0         0 my @all_bytes = split(//, $data);
411             #if the length of the $data is odd, remove the first byte
412 0 0       0 shift @all_bytes if @all_bytes % 2;
413 0         0 my @E = map { $all_bytes[2*($_-1)] } 1 .. @all_bytes/2; # even bytes
  0         0  
414 0         0 my @F = map { $all_bytes[2*($_-1)+1] } 1 .. @all_bytes/2; # odd bytes
  0         0  
415 0         0 my @G = split //, $self->_HASH(@E);
416 0         0 my @H = split //, $self->_HASH(@F);
417 0         0 my @result;
418 0         0 $result[2*$_] = $G[$_] for 0 .. $#G;
419 0         0 $result[2*$_+1] = $H[$_] for 0 .. $#H;
420 0         0 return join('', @result);
421             }
422              
423             sub _PAD {
424 16     16   17 my ($self, $data) = @_;
425 16 100       39 return $data if length($data) >= $self->{N_LENGTH};
426 4         14 return (chr(0) x ($self->{N_LENGTH} - length($data))) . $data;
427             }
428              
429             sub _calc_x {
430 3     3   2 my $self = shift;
431 3 50 33     20 return undef unless defined $self->{Bytes_s} && defined $self->{Bytes_I} && defined $self->{Bytes_P};
      33        
432             # x = HASH(s | HASH(I | ":" | P))
433 3         9 my $Bytes_x = $self->_HASH( $self->{Bytes_s} . $self->_HASH($self->{Bytes_I} . ':' . $self->{Bytes_P}) );
434 3         50 my $Num_x = _bytes2bignum($Bytes_x);
435 3         98 return $Num_x;
436             }
437              
438             sub _calc_v {
439 2     2   2 my $self = shift;
440 2 50 33     13 return undef unless defined $self->{Num_x} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
441             # v = g^x % N
442 2         8 my $Num_v = $self->{Num_g}->copy->bmodpow($self->{Num_x}, $self->{Num_N});
443 2         733 my $Bytes_v = _bignum2bytes($Num_v);
444 2         13 return $Bytes_v;
445             }
446              
447             sub _calc_A {
448 1     1   2 my $self = shift;
449 1 50 33     9 return undef unless defined $self->{Num_a} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
450             # A = g^a % N
451 1         2 my $Num_A = $self->{Num_g}->copy->bmodpow($self->{Num_a}, $self->{Num_N});
452 1         473 return $Num_A;
453             }
454              
455             sub _calc_u {
456 2     2   3 my $self = shift;
457 2 50 33     9 return undef unless defined $self->{Num_A} && defined $self->{Num_B};
458             # u = HASH(PAD(A) | PAD(B))
459 2         4 my $Bytes_u = $self->_HASH( $self->_PAD(_bignum2bytes($self->{Num_A})) . $self->_PAD(_bignum2bytes($self->{Num_B})) );
460 2         43 my $Num_u = _bytes2bignum($Bytes_u);
461 2         58 return $Num_u;
462             }
463              
464             sub _calc_k {
465 2     2   3 my $self = shift;
466 2 50 33     11 return undef unless defined $self->{Num_N} && defined $self->{Num_g};
467             # k = HASH(N | PAD(g))
468 2         5 my $Num_k = _bytes2bignum( $self->_HASH(_bignum2bytes($self->{Num_N}) . $self->_PAD(_bignum2bytes($self->{Num_g}))) );
469 2         64 return $Num_k;
470             }
471              
472             sub _calc_S_client {
473 1     1   2 my $self = shift;
474 1 50 33     11 return undef unless defined $self->{Num_B} && defined $self->{Num_a} && defined $self->{Num_u} && defined $self->{Num_k};
      33        
      33        
475 1 50 33     11 return undef unless defined $self->{Num_x} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
476             # S = (B - (k * ((g^x)%N) )) ^ (a + (u * x)) % N
477             # <--- tmp1 -----> <--- tmp2 -->
478             # <--- tmp3 ----------->
479 1         3 my $tmp1 = $self->{Num_g}->copy->bmodpow($self->{Num_x}, $self->{Num_N})->bmul($self->{Num_k})->bmod($self->{Num_N});
480 1         406 my $tmp2 = $self->{Num_u}->copy->bmul($self->{Num_x})->badd($self->{Num_a})->bmod($self->{Num_N} - 1); # optimized version
481             #my $tmp2 = $self->{Num_u}->copy->bmul($self->{Num_x})->badd($self->{Num_a});
482 1         176 my $tmp3 = $self->{Num_B}->copy->bsub($tmp1);
483 1 50       45 $tmp3->badd($self->{Num_N}) if $tmp3 < 0; # $tmp3 might be negative which is not correctly handled by bmodpow in Math-BigInt before 1.991
484 1         132 my $Num_S = $tmp3->bmodpow($tmp2, $self->{Num_N});
485 1         553 return $Num_S;
486             }
487              
488             sub _calc_S_server {
489 1     1   2 my $self = shift;
490 1 50 33     31 return undef unless defined $self->{Num_A} && defined $self->{Num_b} && defined $self->{Num_u};
      33        
491 1 50 33     7 return undef unless defined $self->{Num_v} && defined $self->{Num_N};
492             # S = ( (A * ((v^u)%N)) ^ b) % N
493 1         3 my $Num_S = $self->{Num_v}->copy->bmodpow($self->{Num_u}, $self->{Num_N});
494 1         349 $Num_S->bmul($self->{Num_A})->bmodpow($self->{Num_b}, $self->{Num_N});
495 1         511 return $Num_S;
496             }
497              
498             sub _calc_K {
499 2     2   2 my $self = shift;
500 2 50       6 return undef unless defined $self->{Num_S};
501 2         4 my $Bytes_S = _bignum2bytes($self->{Num_S});
502             # K = HASH(PAD(S)) or K = HASH_Interleaved(PAD(S))
503 2 50       8 my $Bytes_K = $self->{INTERLEAVED} ? $self->_HASH_Interleaved($self->_PAD($Bytes_S)) : $self->_HASH($self->_PAD($Bytes_S));
504 2         46 return $Bytes_K
505             }
506              
507             sub _calc_M1 {
508 2     2   1 my $self = shift;
509 2 50 33     16 return undef unless defined $self->{Num_A} && defined $self->{Num_B} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
      33        
510 2 50 33     12 return undef unless defined $self->{Bytes_K} && defined $self->{Bytes_I} && defined $self->{Bytes_s};
      33        
511             # M1 = HASH( HASH(N) XOR HASH(PAD(g)) | HASH(I) | s | PAD(A) | PAD(B) | K )
512 2         3 my $data1 = ($self->_HASH(_bignum2bytes($self->{Num_N})) ^ $self->_HASH($self->_PAD(_bignum2bytes($self->{Num_g})))) . $self->_HASH($self->{Bytes_I});
513 2         33 my $data2 = $self->{Bytes_s} . $self->_PAD(_bignum2bytes($self->{Num_A})) . $self->_PAD(_bignum2bytes($self->{Num_B})) . $self->{Bytes_K};
514 2         6 my $Bytes_M1 = $self->_HASH( $data1 . $data2 );
515 2         61 return $Bytes_M1;
516             }
517              
518             sub _calc_M2 {
519 2     2   2 my $self = shift;
520 2 50 33     13 return undef unless defined $self->{Bytes_K} && defined $self->{Num_A} && defined $self->{Bytes_M1};
      33        
521             # M2 = HASH( PAD(A) | M1 | K )
522 2         4 my $Bytes_M2 = $self->_HASH( $self->_PAD(_bignum2bytes($self->{Num_A})) . $self->{Bytes_M1} . $self->{Bytes_K});
523 2         37 return $Bytes_M2;
524             }
525              
526             sub _calc_B {
527 1     1   1 my $self = shift;
528 1 50 33     13 return undef unless defined $self->{Num_k} && defined $self->{Num_b} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
      33        
529             # B = ( k*v + (g^b % N) ) % N
530 1         3 my $tmp = $self->{Num_g}->copy->bmodpow($self->{Num_b}, $self->{Num_N});
531 1         489 my $Num_B = $self->{Num_k}->copy->bmul($self->{Num_v})->badd($tmp)->bmod($self->{Num_N});
532 1         131 return $Num_B;
533             }
534              
535             sub _generate_SRP_a_or_b {
536 2     2   3 my ($self, $len, $pre) = @_;
537 2         5 my $min = Math::BigInt->new(256)->bpow(31); # we require minimum 256bits (=32bytes)
538 2         204 my $max = $self->{Num_N}->copy->bsub(1); # $max = N-1
539 2 50       185 if (defined $pre) {
540 2         2 my $result = $pre;
541 2 50       6 croak "Invalid (too short) prefefined value" unless $result->bcmp($min) >= 0;
542 2 50       33 croak "Invalid (too big) prefefined value" unless $result->bcmp($max) <= 0;
543 2         25 return $result;
544             }
545 0   0     0 $len ||= $self->{N_LENGTH};
546 0 0       0 return undef if $len<32;
547 0         0 for(1..100) {
548 0         0 my $result = _bytes2bignum($self->random_bytes($len));
549 0         0 $result->bmod($max)->badd(1); # 1 <= $result <= N-1
550 0 0       0 return $result if $result->bcmp($min) >= 0 # $min <= $result <= N-1
551             }
552 0         0 return undef;
553             }
554              
555             sub _generate_SRP_a {
556 1     1   2 my ($self, $a_len) = @_;
557 1         4 $self->_generate_SRP_a_or_b($a_len, $self->{predefined_a});
558             }
559              
560             sub _generate_SRP_b {
561 1     1   2 my ($self, $b_len) = @_;
562 1         2 $self->_generate_SRP_a_or_b($b_len, $self->{predefined_b});
563             }
564              
565             sub _validate_A_or_B {
566 0     0   0 my ($self, $bytes) = @_;
567 0 0 0     0 return 0 unless $bytes && $self->{Num_N};
568 0         0 my $num = _bytes2bignum($bytes);
569 0 0       0 return 0 unless $num;
570 0 0       0 return 0 if $num->bmod($self->{Num_N}) == 0; # num % N == 0
571 0         0 return 1;
572             }
573              
574             ### helper functions - NOT METHODS!!!
575              
576             sub _random_bytes {
577 0   0 0   0 my $length = shift || 32;
578 0         0 return Crypt::PRNG::random_bytes($length);
579             }
580              
581             sub _bignum2bytes {
582 44     44   226 my $bignum = shift;
583 44 50 33     222 return undef unless defined $bignum && ref($bignum) eq 'Math::BigInt';
584 44         76 return _unhex($bignum->as_hex);
585             }
586              
587             sub _bytes2bignum {
588 14     14   65 my $bytes = shift;
589 14 50       24 return undef unless defined $bytes;
590 14         59 return Math::BigInt->from_hex('0x'.unpack("H*", $bytes));
591             }
592              
593             sub _format {
594 16     16   15 my ($self, $bytes, $format) = @_;
595 16   33     38 $format ||= $self->{FORMAT};
596 16 50       22 return undef unless defined $bytes;
597 16 100       60 return $bytes if $format eq 'raw';
598 1 50       7 return unpack("H*", $bytes) if $format eq 'hex';
599 0 0       0 return encode_b64($bytes) if $format eq 'base64';
600 0 0       0 return encode_b64u($bytes) if $format eq 'base64url';
601 0         0 return undef;
602             }
603              
604             sub _unformat {
605 13     13   11 my ($self, $input, $format) = @_;
606 13   33     38 $format ||= $self->{FORMAT};
607 13 50       19 return undef unless defined $input;
608 13 100       28 return $input if $format eq 'raw';
609 1 50       6 return _unhex($input) if $format eq 'hex';
610 0 0       0 return decode_b64($input) if $format eq 'base64';
611 0 0       0 return decode_b64u($input) if $format eq 'base64url';
612 0         0 return undef;
613             }
614              
615             sub _unhex {
616 45     45   1654 my $hex = shift;
617 45         114 $hex =~ s/^0x//; # strip leading '0x...'
618 45 100       78 $hex = "0$hex" if length($hex) % 2; # add leading '0' if necessary
619 45         196 return pack("H*", $hex);
620             }
621              
622             1;
623              
624             __END__