File Coverage

blib/lib/Crypt/SRP.pm
Criterion Covered Total %
statement 237 340 69.7
branch 62 150 41.3
condition 49 142 34.5
subroutine 47 58 81.0
pod 20 20 100.0
total 415 710 58.4


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 5     5   47878 use strict;
  5         11  
  5         160  
6 5     5   29 use warnings;
  5         12  
  5         255  
7              
8             our $VERSION = '0.018';
9              
10 5     5   6100 use Math::BigInt lib => 'LTM'; # Math::BigInt::LTM is part of CryptX-0.029+
  5         146386  
  5         39  
11 5     5   64797 use Crypt::Mac::HMAC qw(hmac);
  5         17617  
  5         473  
12 5     5   53 use Crypt::Digest qw(digest_data);
  5         17  
  5         334  
13 5     5   3105 use Crypt::Misc qw(encode_b64 decode_b64 encode_b64u decode_b64u);
  5         48945  
  5         609  
14 5     5   62 use Crypt::PRNG;
  5         16  
  5         224  
15 5     5   40 use Config;
  5         14  
  5         248  
16 5     5   34 use Carp;
  5         18  
  5         425  
17              
18 5     5   55 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) ];
  5         13  
  5         612  
19 5     5   40 use constant _static_vars => [ qw(HASH INTERLEAVED GROUP FORMAT SALTLEN SRPTOOLS APPLETV) ];
  5         14  
  5         1275  
20              
21             ### predefined parameters - see http://tools.ietf.org/html/rfc5054 appendix A
22              
23 5         23247 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 5     5   45 };
  5         12  
180              
181             ### class constructor
182              
183             sub new {
184 6     6 1 10544 my $class = shift;
185 6         21 my $self = bless {}, $class;
186 6         36 $self->_parse_args(1, @_); # 1 = use defaults
187 6         28 $self->_initialize();
188 6         28 return $self;
189             }
190              
191             ### class PUBLIC methods
192              
193             sub reset {
194 0     0 1 0 my $self = shift;
195 0         0 delete $self->{$_} for (@{_state_vars()});
  0         0  
196 0         0 $self->_parse_args(0, @_); # 0 = do not use defaults
197 0         0 $self->_initialize();
198 0         0 return $self;
199             }
200              
201             sub dump {
202 0     0 1 0 my $self = shift;
203 0         0 my $state = { map { $_ => $self->{$_} } (@{_state_vars()}, @{_static_vars()}) };
  0         0  
  0         0  
  0         0  
204 0         0 $state->{__VER__} = $VERSION;
205 0 0       0 eval { require Storable } or croak "FATAL: dump() requires Storable";
  0         0  
206 0         0 return encode_b64(Storable::nfreeze($state));
207             }
208              
209             sub load {
210 0     0 1 0 my ($self, $state) = @_;
211 0         0 $self->reset;
212 0 0       0 eval { require Storable } or croak "FATAL: load() requires Storable";
  0         0  
213 0         0 my $s = Storable::thaw(decode_b64($state));
214 0 0 0     0 croak "FATAL: load() invalid data" if ref($s) ne 'HASH' || !defined $s->{__VER__};
215 0 0       0 croak "FATAL: load() version mismatch" if $s->{__VER__} ne $VERSION;
216 0         0 my @list = (@{_state_vars()}, @{_static_vars()});
  0         0  
  0         0  
217 0         0 $self->{$_} = $s->{$_} for (@list);
218 0         0 $self->_initialize();
219 0         0 return $self;
220             }
221              
222             sub client_init {
223 4     4 1 33 my ($self, $Bytes_I, $Bytes_P, $Bytes_s, $Bytes_B, $Bytes_A, $Bytes_a) = @_;
224             # do not unformat $Bytes_I, $Bytes_P
225 4         15 $self->{Bytes_I} = $Bytes_I;
226 4         14 $self->{Bytes_P} = $Bytes_P;
227 4         20 $self->{Bytes_s} = $self->_unformat($Bytes_s);
228 4         22 $self->{Num_x} = $self->_calc_x(); # x = HASH(s | HASH(I | ":" | P))
229             #optional params
230 4 100       26 $self->{Num_B} = _bytes2bignum($self->_unformat($Bytes_B)) if defined $Bytes_B;
231 4 50       243 $self->{Num_A} = _bytes2bignum($self->_unformat($Bytes_A)) if defined $Bytes_A;
232 4 100       21 $self->{Num_a} = _bytes2bignum($self->_unformat($Bytes_a)) if defined $Bytes_a;
233 4 100 66     108 if (defined $Bytes_a && !defined $Bytes_A) {
234 1         7 $self->{Num_A} = $self->_calc_A;
235             }
236 4         14 return $self;
237             }
238              
239             sub server_init {
240 2     2 1 20 my ($self, $Bytes_I, $Bytes_v, $Bytes_s, $Bytes_A, $Bytes_B, $Bytes_b) = @_;
241             # do not unformat $Bytes_I
242 2         9 $self->{Bytes_I} = $Bytes_I;
243 2         9 $self->{Num_v} = _bytes2bignum($self->_unformat($Bytes_v));
244 2         184 $self->{Bytes_s} = $self->_unformat($Bytes_s);
245             #optional params
246 2 100       10 $self->{Num_A} = _bytes2bignum($self->_unformat($Bytes_A)) if defined $Bytes_A;
247 2 100       109 $self->{Num_B} = _bytes2bignum($self->_unformat($Bytes_B)) if defined $Bytes_B;
248 2 100       78 $self->{Num_b} = _bytes2bignum($self->_unformat($Bytes_b)) if defined $Bytes_b;
249 2 50 66     57 if (defined $Bytes_b && !defined $Bytes_B) {
250 0         0 $self->{Num_B} = $self->_calc_B;
251             }
252 2         6 return $self;
253             }
254              
255             sub client_compute_A {
256 1     1 1 66 my ($self, $a_len) = @_;
257 1         6 $self->{Num_a} = $self->_generate_SRP_a($a_len); # a = random() // a has min 256 bits, a < N
258 1         6 $self->{Num_A} = $self->_calc_A; # A = g^a % N
259 1         4 my $Bytes_A = _bignum2bytes($self->{Num_A});
260 1         3 my $Bytes_a = _bignum2bytes($self->{Num_a});
261 1         5 return ($self->_format($Bytes_A), $self->_format($Bytes_a));
262             }
263              
264             sub client_compute_M1 {
265 2     2 1 18 my ($self) = @_;
266 2         11 $self->{Num_u} = $self->_calc_u; # u = HASH(PAD(A) | PAD(B))
267 2         14 $self->{Num_k} = $self->_calc_k; # k = HASH(N | PAD(g))
268 2         11 $self->{Num_S} = $self->_calc_S_client; # S = (B - (k * ((g^x)%N) )) ^ (a + (u * x)) % N
269 2         18 $self->{Bytes_K} = $self->_calc_K; # K = HASH( PAD(S) )
270 2         11 $self->{Bytes_M1} = $self->_calc_M1; # M1 = HASH( HASH(N) XOR HASH(PAD(g)) | HASH(I) | s | PAD(A) | PAD(B) | K )
271 2         12 return $self->_format($self->{Bytes_M1});
272             }
273              
274             sub client_verify_M2 {
275 1     1 1 6 my ($self, $Bytes_M2) = @_;
276 1         4 $Bytes_M2 = $self->_unformat($Bytes_M2);
277 1         5 my $M2 = $self->_calc_M2; # M2 = HASH( PAD(A) | M1 | K )
278 1 50 33     10 return 0 unless defined $Bytes_M2 && defined $M2 && $Bytes_M2 eq $M2;
      33        
279 1         3 $self->{Bytes_M2} = $M2;
280 1         3 return 1;
281             }
282              
283             sub server_compute_B {
284 1     1 1 58 my ($self, $b_len) = @_;
285 1         7 $self->{Num_b} = $self->_generate_SRP_b($b_len); # b = random() // b has min 256 bits, b < N
286 1         7 $self->{Num_k} = $self->_calc_k; # k = HASH(N | PAD(g))
287 1         5 $self->{Num_B} = $self->_calc_B; # B = ( k*v + (g^b % N) ) % N
288 1         6 my $Bytes_B = _bignum2bytes($self->{Num_B});
289 1         6 my $Bytes_b = _bignum2bytes($self->{Num_b});
290 1         5 return ($self->_format($Bytes_B), $self->_format($Bytes_b));
291             }
292              
293             sub server_fake_B_s {
294 0     0 1 0 my ($self, $I, $nonce, $s_len) = @_;
295 0 0       0 return unless $I;
296 0   0     0 $s_len ||= $self->{SALTLEN};
297             # default $nonce should be fixed for repeated invocation on the same machine (in different processes)
298 0   0     0 $nonce ||= join(":", @INC, $Config{archname}, $Config{myuname}, $^X, $^V, $<, $(, $ENV{PATH}, $ENV{HOSTNAME}, $ENV{HOME});
299 0         0 my $b = _bytes2bignum(_random_bytes(6)); #NOTE: maybe too short but we do not want to waste too much CPU on modpow
300 0         0 my $B = _bignum2bytes($self->{Num_g}->copy->bmodpow($b, $self->{Num_N}));
301 0         0 my $s = '';
302 0         0 my $i = 1;
303 0         0 $s .= hmac('SHA256', $nonce.$i++, $I) while length($s) < $s_len;
304 0         0 $s = substr($s, 0, $s_len);
305 0         0 return ($self->_format($B), $self->_format($s));
306             }
307              
308             sub server_verify_M1 {
309 1     1 1 8 my ($self, $Bytes_M1) = @_;
310 1         3 $Bytes_M1 = $self->_unformat($Bytes_M1);
311 1         4 $self->{Num_u} = $self->_calc_u; # u = HASH(PAD(A) | PAD(B))
312 1         5 $self->{Num_S} = $self->_calc_S_server; # S = ( (A * ((v^u)%N)) ^ b) % N
313 1         4 $self->{Bytes_K} = $self->_calc_K; # K = HASH( PAD(S) )
314 1         4 my $M1 = $self->_calc_M1; # M1 = HASH( HASH(N) XOR HASH(PAD(g)) | HASH(I) | s | PAD(A) | PAD(B) | K )
315 1 50       7 return 0 unless $Bytes_M1 eq $M1;
316 1         3 $self->{Bytes_M1} = $M1;
317 1         3 return 1;
318             }
319              
320             sub server_compute_M2 {
321 1     1 1 7 my ($self) = @_;
322 1         4 $self->{Bytes_M2} = $self->_calc_M2; # M2 = HASH( PAD(A) | M1 | K )
323 1         3 return $self->_format($self->{Bytes_M2});
324             }
325              
326             sub get_secret_K {
327 5     5 1 24 my ($self, $format) = @_;
328 5         19 return $self->_format($self->{Bytes_K}, $format);
329             }
330              
331             sub get_secret_S {
332 4     4 1 13 my ($self, $format) = @_;
333 4         10 return $self->_format(_bignum2bytes($self->{Num_S}), $format);
334             }
335              
336             sub compute_verifier {
337 2     2 1 11 my ($self, $Bytes_I, $Bytes_P, $salt) = @_;
338             # do not unformat: $Bytes_I, $Bytes_P
339 2         16 $self->client_init($Bytes_I, $Bytes_P, $salt);
340 2         10 return $self->_format($self->_calc_v);
341             }
342              
343             sub compute_verifier_and_salt {
344 0     0 1 0 my ($self, $Bytes_I, $Bytes_P, $salt_len) = @_;
345             # do not unformat $Bytes_I, $Bytes_P
346 0   0     0 $salt_len ||= $self->{SALTLEN};
347 0         0 my $Bytes_s = _random_bytes($salt_len);
348 0         0 $self->client_init($Bytes_I, $Bytes_P, $self->_format($Bytes_s));
349 0         0 return ($self->_format($self->_calc_v), $self->_format($Bytes_s));
350             }
351              
352             sub server_verify_A {
353 0     0 1 0 my ($self, $Bytes_A) = @_;
354 0         0 $Bytes_A = $self->_unformat($Bytes_A);
355 0 0       0 return 0 unless $self->_validate_A_or_B($Bytes_A);
356 0         0 $self->{Num_A} = _bytes2bignum($Bytes_A);
357 0         0 return 1;
358             }
359              
360             sub client_verify_B {
361 0     0 1 0 my ($self, $Bytes_B) = @_;
362 0         0 $Bytes_B = $self->_unformat($Bytes_B);
363 0 0       0 return 0 unless $self->_validate_A_or_B($Bytes_B);
364 0         0 $self->{Num_B} = _bytes2bignum($Bytes_B);
365 0         0 return 1;
366             }
367              
368             sub random_bytes {
369 0     0 1 0 my ($self, $len) = @_;
370 0 0       0 return _random_bytes($len) unless ref $self; # Crypt::SRP->random_bytes(32);
371 0         0 return $self->_format(_random_bytes($len)); # $srp->random_bytes(32);
372             }
373              
374             ### class PRIVATE methods
375              
376             sub _parse_args {
377 6     6   18 my ($self, $use_defaults) = (shift, shift);
378              
379 6         21 my %args = ();
380 6 100 66     41 if (@_ == 1 && ref $_[0] eq 'HASH') {
381             # new interface
382 1         5 %args = %{$_[0]};
  1         7  
383             }
384             else {
385             # old interface
386 5         29 ($args{group}, $args{hash}, $args{format}, $args{interleaved}, $args{saltlen}) = @_;
387             }
388              
389 6 50       20 if ($use_defaults) {
390 6   50     267 $self->{GROUP} = $args{group} || 'RFC5054-2048bit';
391 6   50     35 $self->{HASH} = $args{hash} || 'SHA256';
392 6   100     41 $self->{FORMAT} = $args{format} || 'raw';
393 6   50     45 $self->{INTERLEAVED} = $args{interleaved} || 0;
394 6   50     36 $self->{SALTLEN} = $args{saltlen} || 32;
395 6   100     35 $self->{APPLETV} = $args{appletv} || 0;
396 6   50     35 $self->{SRPTOOLS} = $args{srptools} || 0;
397             }
398             else {
399 0 0       0 $self->{GROUP} = $args{group} if defined $args{group};
400 0 0       0 $self->{HASH} = $args{hash} if defined $args{hash};
401 0 0       0 $self->{FORMAT} = $args{format} if defined $args{format};
402 0 0       0 $self->{INTERLEAVED} = $args{interleaved} if defined $args{interleaved};
403 0 0       0 $self->{SALTLEN} = $args{saltlen} if defined $args{saltlen};
404 0 0       0 $self->{APPLETV} = $args{appletv} if defined $args{appletv};
405 0 0       0 $self->{SRPTOOLS} = $args{srptools} if defined $args{srptools};
406             }
407              
408 6         23 return $self;
409             }
410              
411             sub _initialize {
412 6     6   138 my $self = shift;
413              
414             # setup N and g values
415 6 50       62 if ($self->{GROUP} =~ /RFC5054-(1024|1536|2048|3072|4096|6144|8192)bit$/) {
416 6         31 my $str = _predefined_groups->{$self->{GROUP}}->{N};
417 6         949 $str =~ s/[\r\n\s]*//sg;
418 6 50       47 $str = "0x$str" unless $str =~ /^0x/;
419 6         70 $self->{Num_N} = Math::BigInt->from_hex($str);
420 6         957 $self->{Num_g} = Math::BigInt->new(_predefined_groups->{$self->{GROUP}}->{g});
421 6         301 $self->{N_LENGTH} = length(_bignum2bytes($self->{Num_N}));
422             }
423             else {
424 0         0 croak "FATAL: invalid group_params '$self->{GROUP}'";
425             }
426              
427             # test hash function
428 6 50       27 croak "FATAL: invalid hash '$self->{HASH}'" unless defined $self->_HASH("test");
429 6         492 return $self;
430             }
431              
432             sub _HASH {
433 38     38   539 my ($self, $data) = @_;
434 38 50       277 return digest_data($self->{HASH}, $data) if $self->{HASH} =~ /^SHA(1|256|384|512)$/;
435 0         0 return undef;
436             }
437              
438             sub _HASH_Interleaved { #implemented according to http://tools.ietf.org/html/rfc2945 (3.1 Interleaved SHA)
439 0     0   0 my ($self, $data) = @_;
440             #we assume no leading zero bytes in $data
441 0         0 my @all_bytes = split(//, $data);
442             #if the length of the $data is odd, remove the first byte
443 0 0       0 shift @all_bytes if @all_bytes % 2;
444 0         0 my @E = map { $all_bytes[2*($_-1)] } 1 .. @all_bytes/2; # even bytes
  0         0  
445 0         0 my @F = map { $all_bytes[2*($_-1)+1] } 1 .. @all_bytes/2; # odd bytes
  0         0  
446 0         0 my @G = split //, $self->_HASH(@E);
447 0         0 my @H = split //, $self->_HASH(@F);
448 0         0 my @result;
449 0         0 $result[2*$_] = $G[$_] for 0 .. $#G;
450 0         0 $result[2*$_+1] = $H[$_] for 0 .. $#H;
451 0         0 return join('', @result);
452             }
453              
454             sub _PAD {
455 19     19   46 my ($self, $data) = @_;
456 19 100       88 return $data if length($data) >= $self->{N_LENGTH};
457 5         52 return (chr(0) x ($self->{N_LENGTH} - length($data))) . $data;
458             }
459              
460             sub _calc_x {
461 4     4   10 my $self = shift;
462 4 50 33     49 return undef unless defined $self->{Bytes_s} && defined $self->{Bytes_I} && defined $self->{Bytes_P};
      33        
463             # x = HASH(s | HASH(I | ":" | P))
464 4         33 my $Bytes_x = $self->_HASH( $self->{Bytes_s} . $self->_HASH($self->{Bytes_I} . ':' . $self->{Bytes_P}) );
465 4         262 my $Num_x = _bytes2bignum($Bytes_x);
466 4         505 return $Num_x;
467             }
468              
469             sub _calc_v {
470 2     2   6 my $self = shift;
471 2 50 33     29 return undef unless defined $self->{Num_x} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
472             # v = g^x % N
473 2         13 my $Num_v = $self->{Num_g}->copy->bmodpow($self->{Num_x}, $self->{Num_N});
474 2         1014 my $Bytes_v = _bignum2bytes($Num_v);
475 2         26 return $Bytes_v;
476             }
477              
478             sub _calc_A {
479 2     2   8 my $self = shift;
480 2 50 33     38 return undef unless defined $self->{Num_a} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
481             # A = g^a % N
482 2         14 my $Num_A = $self->{Num_g}->copy->bmodpow($self->{Num_a}, $self->{Num_N});
483 2         3398 return $Num_A;
484             }
485              
486             sub _calc_u {
487 3     3   8 my $self = shift;
488 3 50 33     28 return undef unless defined $self->{Num_A} && defined $self->{Num_B};
489             # u = HASH(PAD(A) | PAD(B)) [the same for SRPTOOLS & APPLETV]
490 3         11 my $Bytes_u = $self->_HASH( $self->_PAD(_bignum2bytes($self->{Num_A})) . $self->_PAD(_bignum2bytes($self->{Num_B})) );
491 3         194 my $Num_u = _bytes2bignum($Bytes_u);
492 3         223 return $Num_u;
493             }
494              
495             sub _calc_k {
496 3     3   10 my $self = shift;
497 3 50 33     74 return undef unless defined $self->{Num_N} && defined $self->{Num_g};
498             # k = HASH(N | PAD(g)) [the same for SRPTOOLS & APPLETV]
499 3         17 my $Num_k = _bytes2bignum( $self->_HASH(_bignum2bytes($self->{Num_N}) . $self->_PAD(_bignum2bytes($self->{Num_g}))) );
500 3         224 return $Num_k;
501             }
502              
503             sub _calc_S_client {
504 2     2   8 my $self = shift;
505 2 50 33     41 return undef unless defined $self->{Num_B} && defined $self->{Num_a} && defined $self->{Num_u} && defined $self->{Num_k};
      33        
      33        
506 2 50 33     26 return undef unless defined $self->{Num_x} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
507             # S = (B - (k * ((g^x)%N) )) ^ (a + (u * x)) % N
508             # <--- tmp1 -----> <--- tmp2 -->
509             # <--- tmp3 ----------->
510 2         13 my $tmp1 = $self->{Num_g}->copy->bmodpow($self->{Num_x}, $self->{Num_N})->bmul($self->{Num_k})->bmod($self->{Num_N});
511 2         2613 my $tmp2 = $self->{Num_u}->copy->bmul($self->{Num_x})->badd($self->{Num_a})->bmod($self->{Num_N} - 1); # optimized version
512             #my $tmp2 = $self->{Num_u}->copy->bmul($self->{Num_x})->badd($self->{Num_a});
513 2         1191 my $tmp3 = $self->{Num_B}->copy->bsub($tmp1);
514 2 50       228 $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
515 2         560 my $Num_S = $tmp3->bmodpow($tmp2, $self->{Num_N});
516 2         3940 return $Num_S;
517             }
518              
519             sub _calc_S_server {
520 1     1   2 my $self = shift;
521 1 50 33     11 return undef unless defined $self->{Num_A} && defined $self->{Num_b} && defined $self->{Num_u};
      33        
522 1 50 33     6 return undef unless defined $self->{Num_v} && defined $self->{Num_N};
523             # S = ( (A * ((v^u)%N)) ^ b) % N
524 1         5 my $Num_S = $self->{Num_v}->copy->bmodpow($self->{Num_u}, $self->{Num_N});
525 1         397 $Num_S->bmul($self->{Num_A})->bmodpow($self->{Num_b}, $self->{Num_N});
526 1         588 return $Num_S;
527             }
528              
529             sub _calc_K {
530 3     3   8 my $self = shift;
531 3 50       22 return undef unless defined $self->{Num_S};
532 3         23 my $Bytes_S = _bignum2bytes($self->{Num_S});
533 3         10 my $Bytes_K;
534 3 50       20 if ($self->{SRPTOOLS}) {
    100          
535             # K = HASH(S) or K = HASH_Interleaved(S)
536 0 0       0 $Bytes_K = $self->{INTERLEAVED} ? $self->_HASH_Interleaved($Bytes_S) : $self->_HASH($Bytes_S);
537             }
538             elsif ($self->{APPLETV}) {
539             # K = H(S | 0000) | H(S | 0001) ... (where 0000 means 4 NULL bytes)
540 1         10 $Bytes_K = $self->_HASH($Bytes_S . "\x00\x00\x00\x00") . $self->_HASH($Bytes_S . "\x00\x00\x00\x01");
541             }
542             else {
543             # K = HASH(PAD(S)) or K = HASH_Interleaved(PAD(S))
544 2 50       9 $Bytes_K = $self->{INTERLEAVED} ? $self->_HASH_Interleaved($self->_PAD($Bytes_S)) : $self->_HASH($self->_PAD($Bytes_S));
545             }
546 3         145 return $Bytes_K
547             }
548              
549             sub _calc_M1 {
550 3     3   7 my $self = shift;
551 3 50 33     47 return undef unless defined $self->{Num_A} && defined $self->{Num_B} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
      33        
552 3 50 33     35 return undef unless defined $self->{Bytes_K} && defined $self->{Bytes_I} && defined $self->{Bytes_s};
      33        
553 3         23 my $Bytes_M1;
554 3 100 66     35 if ($self->{SRPTOOLS} || $self->{APPLETV}) {
555             # M1 = HASH( HASH(N) XOR HASH(g) | HASH(I) | s | A | B | K )
556 1         7 my $data1 = ($self->_HASH(_bignum2bytes($self->{Num_N})) ^ $self->_HASH(_bignum2bytes($self->{Num_g}))) . $self->_HASH($self->{Bytes_I});
557 1         54 my $data2 = $self->{Bytes_s} . _bignum2bytes($self->{Num_A}) . _bignum2bytes($self->{Num_B}) . $self->{Bytes_K};
558 1         8 $Bytes_M1 = $self->_HASH( $data1 . $data2 );
559             }
560             else {
561             # M1 = HASH( HASH(N) XOR HASH(PAD(g)) | HASH(I) | s | PAD(A) | PAD(B) | K )
562 2         7 my $data1 = ($self->_HASH(_bignum2bytes($self->{Num_N})) ^ $self->_HASH($self->_PAD(_bignum2bytes($self->{Num_g})))) . $self->_HASH($self->{Bytes_I});
563 2         70 my $data2 = $self->{Bytes_s} . $self->_PAD(_bignum2bytes($self->{Num_A})) . $self->_PAD(_bignum2bytes($self->{Num_B})) . $self->{Bytes_K};
564 2         8 $Bytes_M1 = $self->_HASH( $data1 . $data2 );
565             }
566 3         149 return $Bytes_M1;
567             }
568              
569             sub _calc_M2 {
570 2     2   4 my $self = shift;
571 2 50 33     20 return undef unless defined $self->{Bytes_K} && defined $self->{Num_A} && defined $self->{Bytes_M1};
      33        
572 2         4 my $Bytes_M2;
573 2 50 33     13 if ($self->{SRPTOOLS} || $self->{APPLETV}) {
574             # M2 = HASH( A | M1 | K )
575 0         0 $Bytes_M2 = $self->_HASH( _bignum2bytes($self->{Num_A}) . $self->{Bytes_M1} . $self->{Bytes_K} );
576             }
577             else {
578             # M2 = HASH( PAD(A) | M1 | K )
579 2         10 $Bytes_M2 = $self->_HASH( $self->_PAD(_bignum2bytes($self->{Num_A})) . $self->{Bytes_M1} . $self->{Bytes_K} );
580             }
581 2         73 return $Bytes_M2;
582             }
583              
584             sub _calc_B {
585 1     1   3 my $self = shift;
586 1 50 33     14 return undef unless defined $self->{Num_k} && defined $self->{Num_b} && defined $self->{Num_N} && defined $self->{Num_g};
      33        
      33        
587             # B = ( k*v + (g^b % N) ) % N
588 1         4 my $tmp = $self->{Num_g}->copy->bmodpow($self->{Num_b}, $self->{Num_N});
589 1         578 my $Num_B = $self->{Num_k}->copy->bmul($self->{Num_v})->badd($tmp)->bmod($self->{Num_N});
590 1         350 return $Num_B;
591             }
592              
593             sub _generate_SRP_a_or_b {
594 2     2   4 my ($self, $len, $pre) = @_;
595 2         7 my $min = Math::BigInt->new(256)->bpow(31); # we require minimum 256bits (=32bytes)
596 2         419 my $max = $self->{Num_N}->copy->bsub(1); # $max = N-1
597 2 50       480 if (defined $pre) {
598 2         6 my $result = $pre;
599 2 50       10 croak "Invalid (too short) prefefined value" unless $result->bcmp($min) >= 0;
600 2 50       79 croak "Invalid (too big) prefefined value" unless $result->bcmp($max) <= 0;
601 2         57 return $result;
602             }
603 0   0     0 $len ||= $self->{N_LENGTH};
604 0 0       0 return undef if $len<32;
605 0         0 for(1..100) {
606 0         0 my $result = _bytes2bignum($self->random_bytes($len));
607 0         0 $result->bmod($max)->badd(1); # 1 <= $result <= N-1
608 0 0       0 return $result if $result->bcmp($min) >= 0 # $min <= $result <= N-1
609             }
610 0         0 return undef;
611             }
612              
613             sub _generate_SRP_a {
614 1     1   3 my ($self, $a_len) = @_;
615 1         6 $self->_generate_SRP_a_or_b($a_len, $self->{predefined_a});
616             }
617              
618             sub _generate_SRP_b {
619 1     1   4 my ($self, $b_len) = @_;
620 1         4 $self->_generate_SRP_a_or_b($b_len, $self->{predefined_b});
621             }
622              
623             sub _validate_A_or_B {
624 0     0   0 my ($self, $bytes) = @_;
625 0 0 0     0 return 0 unless $bytes && $self->{Num_N};
626 0         0 my $num = _bytes2bignum($bytes);
627 0 0       0 return 0 unless $num;
628 0 0       0 return 0 if $num->bmod($self->{Num_N}) == 0; # num % N == 0
629 0         0 return 1;
630             }
631              
632             ### helper functions - NOT METHODS!!!
633              
634             sub _random_bytes {
635 0   0 0   0 my $length = shift || 32;
636 0         0 return Crypt::PRNG::random_bytes($length);
637             }
638              
639             sub _bignum2bytes {
640 54     54   443 my $bignum = shift;
641 54 50 33     336 return undef unless defined $bignum && ref($bignum) eq 'Math::BigInt';
642 54         266 return _unhex($bignum->as_hex);
643             }
644              
645             sub _bytes2bignum {
646 19     19   354 my $bytes = shift;
647 19 50       63 return undef unless defined $bytes;
648 19         173 return Math::BigInt->from_hex('0x'.unpack("H*", $bytes));
649             }
650              
651             sub _format {
652 18     18   41 my ($self, $bytes, $format) = @_;
653 18   33     92 $format ||= $self->{FORMAT};
654 18 50       53 return undef unless defined $bytes;
655 18 100       92 return $bytes if $format eq 'raw';
656 1 50       14 return unpack("H*", $bytes) if $format eq 'hex';
657 0 0       0 return encode_b64($bytes) if $format eq 'base64';
658 0 0       0 return encode_b64u($bytes) if $format eq 'base64url';
659 0         0 return undef;
660             }
661              
662             sub _unformat {
663 16     16   45 my ($self, $input, $format) = @_;
664 16   33     115 $format ||= $self->{FORMAT};
665 16 50       47 return undef unless defined $input;
666 16 100       76 return $input if $format eq 'raw';
667 1 50       8 return _unhex($input) if $format eq 'hex';
668 0 0       0 return decode_b64($input) if $format eq 'base64';
669 0 0       0 return decode_b64u($input) if $format eq 'base64url';
670 0         0 return undef;
671             }
672              
673             sub _unhex {
674 55     55   3685 my $hex = shift;
675 55         226 $hex =~ s/^0x//; # strip leading '0x...'
676 55 100       181 $hex = "0$hex" if length($hex) % 2; # add leading '0' if necessary
677 55         388 return pack("H*", $hex);
678             }
679              
680             1;
681              
682             __END__