File Coverage

blib/lib/Net/SSH/Perl/Key/Ed25519.pm
Criterion Covered Total %
statement 185 255 72.5
branch 24 64 37.5
condition 7 28 25.0
subroutine 28 32 87.5
pod 7 12 58.3
total 251 391 64.1


line stmt bran cond sub pod time code
1             package Net::SSH::Perl::Key::Ed25519;
2 1     1   8 use strict;
  1         2  
  1         32  
3              
4 1     1   5 use Net::SSH::Perl::Buffer;
  1         2  
  1         38  
5 1     1   455 use Crypt::Digest::SHA512 qw( sha512 );
  1         662  
  1         57  
6              
7 1     1   8 use base qw( Net::SSH::Perl::Key );
  1         3  
  1         87  
8              
9 1     1   5 use Crypt::PRNG qw( random_bytes );
  1         2  
  1         40  
10 1     1   6 use Crypt::Misc qw( decode_b64 encode_b64 );
  1         1  
  1         38  
11 1     1   6 use Carp qw( croak );
  1         2  
  1         44  
12              
13 1     1   6 use constant MARK_BEGIN => "-----BEGIN OPENSSH PRIVATE KEY-----\n";
  1         2  
  1         54  
14 1     1   6 use constant MARK_END => "-----END OPENSSH PRIVATE KEY-----\n";
  1         3  
  1         68  
15 1     1   7 use constant AUTH_MAGIC => "openssh-key-v1\0";
  1         2  
  1         48  
16 1     1   5 use constant ED25519_SK_SZ => 64;
  1         2  
  1         51  
17 1     1   13 use constant ED25519_PK_SZ => 32;
  1         3  
  1         44  
18 1     1   6 use constant SALT_LEN => 16;
  1         10  
  1         53  
19 1     1   7 use constant DEFAULT_ROUNDS => 16;
  1         2  
  1         52  
20 1     1   6 use constant DEFAULT_CIPHERNAME => 'aes256-cbc';
  1         2  
  1         50  
21 1     1   5 use constant KDFNAME => 'bcrypt';
  1         2  
  1         96  
22              
23             unless (grep /^Net::SSH::Perl$/, @DynaLoader::dl_modules) {
24 1     1   6 use XSLoader;
  1         2  
  1         490  
25             XSLoader::load('Net::SSH::Perl');
26             }
27              
28 3     3 0 15 sub ssh_name { 'ssh-ed25519' }
29              
30             sub init {
31 3     3 0 7 my $key = shift;
32 3         7 my($blob) = @_;
33              
34 3 50       11 if ($blob) {
35 0         0 my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
36 0         0 $b->append($blob);
37 0         0 my $ktype = $b->get_str;
38 0 0       0 croak __PACKAGE__, "->init: cannot handle type '$ktype'"
39             unless $ktype eq $key->ssh_name;
40 0         0 $key->{pub} = $b->get_str;
41             }
42             }
43              
44             sub keygen {
45 1     1 1 4 my $class = shift;
46 1         5 my $key = __PACKAGE__->new(undef);
47 1         3 my $secret = random_bytes(ED25519_PK_SZ);
48 1         409 ($key->{pub},$key->{priv}) = ed25519_generate_keypair($secret);
49 1         11 $key;
50             }
51              
52             sub read_private {
53 1     1 1 3 my $class = shift;
54 1         3 my($key_file, $passphrase) = @_;
55              
56 1         2 local *FH;
57 1 50       38 open FH, $key_file or return;
58 1         3 my $content = do { local $/; };
  1         4  
  1         35  
59 1         11 close FH;
60 1         4 $content = substr($content,length(MARK_BEGIN),
61             length($content)-length(MARK_END)-length(MARK_BEGIN));
62 1         7 my $blob = decode_b64($content);
63 1         3 my $str = AUTH_MAGIC;
64 1 50       18 croak "Invalid key format" unless $blob =~ /^${str}/;
65              
66 1         7 my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
67 1         4 $b->append($blob);
68 1         3 $b->consume(length(AUTH_MAGIC));
69              
70 1         3 my $ciphername = $b->get_str;
71 1         3 my $kdfname = $b->get_str;
72 1         2 my $kdfoptions = $b->get_str;
73 1         3 my $nkeys = $b->get_int32;
74 1         3 my $pub_key = $b->get_str;
75 1         4 my $encrypted = $b->get_str;
76              
77 1 50 33     7 croak 'Wrong passphrase'
78             if !$passphrase && $ciphername ne 'none';
79              
80 1 50 33     7 croak 'Unknown cipher'
81             if $kdfname ne 'none' && $kdfname ne KDFNAME;
82              
83 1 50 33     17 croak 'Invalid format'
84             if $kdfname ne 'none' && $ciphername eq 'none';
85              
86 1 50       3 croak 'Invalid format: nkeys > 1'
87             if $nkeys != 1;
88              
89 1         2 my $decrypted;
90 1 50       3 if ($ciphername eq 'none') {
91 0         0 $decrypted = $encrypted;
92             } else {
93 1 50       3 if ($kdfname eq KDFNAME) {
94 1     1   465 use Net::SSH::Perl::Cipher;
  1         2  
  1         437  
95 1         3 my $cipher = eval { Net::SSH::Perl::Cipher->new($ciphername) };
  1         6  
96 1 50       7 croak "Cannot load cipher $ciphername" unless $cipher;
97 1 50 33     6 croak 'Invalid format'
98             if length($encrypted) < $cipher->blocksize ||
99             length($encrypted) % $cipher->blocksize;
100              
101 1         4 my $keylen = $cipher->keysize;
102 1         5 my $ivlen = $cipher->ivlen;
103 1         6 my $authlen = $cipher->authlen;
104 1         3 my $tag = $b->bytes($b->offset,$authlen);
105 1 50       4 croak 'Invalid format'
106             if length($tag) != $authlen;
107              
108 1         4 $b->empty;
109 1         3 $b->append($kdfoptions);
110 1         4 my $salt = $b->get_str;
111 1 50       4 croak "Invalid format"
112             if length($salt) != SALT_LEN;
113 1         3 my $rounds = $b->get_int32;
114              
115 1         4 my $km = bcrypt_pbkdf($passphrase, $salt, $keylen+$ivlen, $rounds);
116 1         6 my $key = substr($km,0,$keylen);
117 1         5 my $iv = substr($km,$keylen,$ivlen);
118 1         54 $cipher->init($key,$iv);
119 1         11 $decrypted = $cipher->decrypt($encrypted . $tag);
120             }
121             }
122              
123 1         10 $b->empty;
124 1         5 $b->append($decrypted);
125 1         5 my $check1 = $b->get_int32;
126 1         5 my $check2 = $b->get_int32;
127 1 50 33     9 croak 'Wrong passphrase (check mismatch)'
128             if $check1 != $check2 || ! defined $check1;
129              
130 1         5 my $type = $b->get_str;
131 1 50       10 croak 'Wrong key type'
132             unless $type eq $class->ssh_name;
133 1         4 $pub_key = $b->get_str;
134 1         4 my $priv_key = $b->get_str;
135 1 50 33     9 croak 'Invalid format'
136             if length($pub_key) != ED25519_PK_SZ ||
137             length($priv_key) != ED25519_SK_SZ;
138 1         3 my $comment = $b->get_str;
139              
140             # check padding
141 1         3 my $padnum = 0;
142 1         5 while ($b->offset < $b->length) {
143 15 50       30 croak "Invalid format"
144             if ord($b->get_char) != ++$padnum;
145             }
146              
147 1         12 my $key = __PACKAGE__->new(undef);
148 1         10 $key->comment($comment);
149 1         3 $key->{pub} = $pub_key;
150 1         4 $key->{priv} = $priv_key;
151 1         21 $key;
152             }
153              
154             sub write_private {
155 0     0 1 0 my $key = shift;
156 0         0 my($key_file, $passphrase, $ciphername, $rounds) = @_;
157 0         0 my ($kdfoptions, $kdfname, $blocksize, $cipher, $authlen, $tag);
158              
159 0 0       0 if ($passphrase) {
160 0   0     0 $ciphername ||= DEFAULT_CIPHERNAME;
161 1     1   8 use Net::SSH::Perl::Cipher;
  1         2  
  1         1020  
162 0         0 $cipher = eval { Net::SSH::Perl::Cipher->new($ciphername) };
  0         0  
163 0 0       0 croak "Cannot load cipher $ciphername"
164             unless $cipher;
165              
166             # cipher init params
167 0         0 $kdfname = KDFNAME;
168 0         0 $blocksize = $cipher->blocksize;
169 0         0 my $keylen = $cipher->keysize;
170 0         0 my $ivlen = $cipher->ivlen;
171 0   0     0 $rounds ||= DEFAULT_ROUNDS;
172 0         0 my $salt = random_bytes(SALT_LEN);
173              
174 0         0 my $kdf = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
175 0         0 $kdf->put_str($salt);
176 0         0 $kdf->put_int32($rounds);
177 0         0 $kdfoptions = $kdf->bytes;
178              
179             # get key material
180 0         0 my $km = bcrypt_pbkdf($passphrase, $salt, $keylen+$ivlen, $rounds);
181 0         0 my $key = substr($km,0,$keylen);
182 0         0 my $iv = substr($km,$keylen,$ivlen);
183 0         0 $cipher->init($key,$iv);
184 0         0 $authlen = $cipher->authlen;
185             } else {
186 0         0 $ciphername = 'none';
187 0         0 $kdfname = 'none';
188 0         0 $blocksize = 8;
189             }
190 0         0 my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
191 0         0 $b->put_char(AUTH_MAGIC);
192 0         0 $b->put_str($ciphername);
193 0         0 $b->put_str($kdfname);
194 0         0 $b->put_str($kdfoptions);
195 0         0 $b->put_int32(1); # one key
196              
197             # public key
198 0         0 my $pub = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
199 0         0 $pub->put_str($key->ssh_name);
200 0         0 $pub->put_str($key->{pub});
201 0         0 $b->put_str($pub->bytes);
202              
203             # create private key blob
204 0         0 my $kb = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
205 0         0 my $checkint = int(rand(0xffffffff));
206 0         0 $kb->put_int32($checkint);
207 0         0 $kb->put_int32($checkint);
208 0         0 $kb->put_str($key->ssh_name);
209 0         0 $kb->put_str($key->{pub});
210 0         0 $kb->put_str($key->{priv});
211 0         0 $kb->put_str($key->comment);
212 0 0       0 if (my $r = length($kb->bytes) % $blocksize) {
213 0         0 $kb->put_char(chr($_)) foreach (1..$blocksize-$r);
214             }
215 0 0       0 my $bytes = $cipher ? $cipher->encrypt($kb->bytes) : $kb->bytes;
216 0 0       0 $tag = substr($bytes,-$authlen,$authlen,'') if $authlen;
217 0         0 $b->put_str($bytes);
218 0 0       0 $b->put_chars($tag) if $tag;
219              
220 0         0 local *FH;
221 0 0       0 open FH, ">$key_file" or die "Cannot write key file";
222 0         0 print FH MARK_BEGIN;
223 0         0 print FH encode_b64($b->bytes),"\n";
224 0         0 print FH MARK_END;
225 0         0 close FH;
226             }
227              
228             sub sign {
229 1     1 1 381 my $key = shift;
230 1         2 my $data = shift;
231 1         279 my $sig = ed25519_sign_message($data, $key->{priv});
232              
233 1         8 my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
234 1         17 $b->put_str($key->ssh_name);
235 1         4 $b->put_str($sig);
236 1         4 $b->bytes;
237             }
238              
239             sub verify {
240 1     1 1 356 my $key = shift;
241 1         3 my($signature, $data) = @_;
242 1         2 my $sigblob;
243              
244 1         4 my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
245 1         5 $b->append($signature);
246 1         3 my $ktype = $b->get_str;
247 1 50       3 croak "Can't verify type ", $ktype unless $ktype eq $key->ssh_name;
248 1         3 $sigblob = $b->get_str;
249 1 50       3 croak "Invalid format" unless length($sigblob) == 64;
250              
251 1         708 ed25519_verify_message($data,$key->{pub},$sigblob);
252             }
253              
254             sub equal {
255 0     0 1 0 my($keyA, $keyB) = @_;
256             $keyA->{pub} && $keyB->{pub} &&
257 0 0 0     0 $keyA->{pub} eq $keyB->{pub};
258             }
259              
260             sub as_blob {
261 0     0 1 0 my $key = shift;
262 0         0 my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
263 0         0 $b->put_str($key->ssh_name);
264 0         0 $b->put_str($key->{pub});
265 0         0 $b->bytes;
266             }
267              
268 0     0 0 0 sub fingerprint_raw { $_[0]->as_blob }
269              
270             sub bcrypt_hash {
271 32     32 0 84 my ($sha2pass, $sha2salt) = @_;
272 32         56 my $ciphertext = 'OxychromaticBlowfishSwatDynamite';
273              
274 32         656 my $ctx = bf_init();
275 32         4436 bf_expandstate($ctx,$sha2salt,$sha2pass);
276 32         89 for (my $i=0; $i<64; $i++) {
277 2048         224256 bf_expand0state($ctx,$sha2salt);
278 2048         225571 bf_expand0state($ctx,$sha2pass);
279             }
280             # iterate 64 times
281 32         2113 bf_encrypt_iterate($ctx,$ciphertext,64);
282             }
283              
284             sub bcrypt_pbkdf {
285 1     1 0 3 my ($pass, $salt, $keylen, $rounds) = @_;
286 1         1 my $out;
287 1     1   8 use constant BCRYPT_HASHSIZE => 32;
  1         3  
  1         317  
288 1         3 my $key = "\0" x $keylen;
289 1         2 my $origkeylen = $keylen;
290              
291 1 50       3 return if $rounds < 1;
292 1 50 33     5 return unless $pass && $salt;
293              
294 1         5 my $stride = int(($keylen + BCRYPT_HASHSIZE - 1) / BCRYPT_HASHSIZE);
295 1         3 my $amt = int(($keylen + $stride - 1) / $stride);
296              
297 1         3 my $sha2pass = sha512($pass);
298              
299 1         12 for (my $count = 1; $keylen > 1; $count++) {
300 2         12 my $countsalt = pack('N',$count & 0xffffffff);
301             # first round, salt is salt
302 2         9 my $sha2salt = sha512($salt . $countsalt);
303              
304 2         17 my $tmpout = $out = bcrypt_hash($sha2pass, $sha2salt);
305              
306 2         8 for (my $i=1; $i < $rounds; $i++) {
307             # subsequent rounds, salt is previous output
308 30         167 $sha2salt = sha512($tmpout);
309 30         304 $tmpout = bcrypt_hash($sha2pass,$sha2salt);
310 30         141 $out ^= $tmpout;
311             }
312              
313             # pbkdf2 deviation: output the key material non-linearly.
314 2 100       16 $amt = $amt<$keylen ? $amt : $keylen;
315 2         5 my $i;
316 2         11 for ($i=0; $i<$amt; $i++) {
317 48         70 my $dest = $i * $stride + ($count - 1);
318 48 50       94 last if $dest >= $origkeylen;
319 48         98 substr($key,$dest,1,substr($out,$i,1));
320             }
321 2         10 $keylen -= $i;
322             }
323 1         7 return $key;
324             }
325              
326             1;
327             __END__