File Coverage

blib/lib/Net/SSH/Perl/Key/RSA1.pm
Criterion Covered Total %
statement 24 75 32.0
branch 0 14 0.0
condition 0 18 0.0
subroutine 8 19 42.1
pod 8 10 80.0
total 40 136 29.4


line stmt bran cond sub pod time code
1             package Net::SSH::Perl::Key::RSA1;
2 1     1   7 use strict;
  1         1  
  1         28  
3 1     1   4 use warnings;
  1         2  
  1         27  
4              
5 1     1   5 use Net::SSH::Perl::Util qw( :ssh1mp :authfile );
  1         2  
  1         27  
6              
7 1     1   5 use Net::SSH::Perl::Key;
  1         2  
  1         20  
8 1     1   5 use base qw( Net::SSH::Perl::Key );
  1         3  
  1         90  
9              
10 1     1   6 use Carp qw( croak );
  1         3  
  1         39  
11 1     1   5 use Math::GMP;
  1         1  
  1         5  
12 1     1   25 use Digest::MD5 qw( md5 );
  1         2  
  1         836  
13              
14             sub init {
15 0     0 0   my $key = shift;
16 0           $key->{rsa} = {};
17              
18 0           my($blob) = @_;
19 0 0         return unless $blob;
20 0           my($bits, $e, $n) = split /\s+/, $blob, 3;
21 0           $key->{rsa}{bits} = $bits;
22 0           $key->{rsa}{e} = $e;
23 0           $key->{rsa}{n} = $n;
24             }
25              
26 0     0 1   sub size { $_[0]->{rsa}{bits} }
27              
28             sub keygen {
29 0     0 1   my $class = shift;
30 0           my($bits) = @_;
31              
32 0           eval {
33 0           require Crypt::RSA;
34 0           require Crypt::RSA::DataFormat;
35 0           Crypt::RSA::DataFormat->import('bitsize');
36             };
37 0 0         if ($@) {
38 0           croak "rsa1 key generation is unavailable without Crypt::RSA";
39             }
40 0     0     my $gmp = sub { Math::GMP->new("$_[0]") };
  0            
41              
42 0           my $rsa = Crypt::RSA->new;
43 0           my $key = $class->new;
44 0           my($pub, $priv) = $rsa->keygen(
45             Size => $bits,
46             Password => 'ssh',
47             Verbosity => 1,
48             Identity => 'Net::SSH::Perl',
49             );
50 0 0 0       die $rsa->errstr unless $pub && $priv;
51              
52 0           $key->{rsa}{e} = $gmp->($pub->e);
53 0           $key->{rsa}{n} = $gmp->($pub->n);
54 0           $key->{rsa}{bits} = $gmp->(bitsize($pub->n));
55 0           $key->{rsa}{d} = $gmp->($priv->d);
56 0           $key->{rsa}{u} = $gmp->($priv->u);
57 0           $key->{rsa}{p} = $gmp->($priv->p);
58 0           $key->{rsa}{q} = $gmp->($priv->q);
59              
60 0           $key;
61             }
62              
63             sub read_private {
64 0     0 1   my $class = shift;
65 0           my($keyfile, $passphrase) = @_;
66 0           my($key, $comment);
67 0           eval {
68 0           ($key, $comment) = _load_private_key($keyfile, $passphrase);
69             };
70 0 0         if (wantarray) {
71 0 0 0       return $key && !$@ ? ($key, $comment) : ();
72             }
73             else {
74 0 0 0       return $key && !$@ ? $key : undef;
75             }
76             }
77              
78             sub write_private {
79 0     0 1   my $key = shift;
80 0           my($keyfile, $passphrase, $comment) = @_;
81 0           _save_private_key($keyfile, $key, $passphrase, $comment);
82             }
83              
84             sub extract_public {
85 0     0 1   my $class = shift;
86 0           $class->new(@_);
87             }
88              
89 0     0 1   sub dump_public { $_[0]->as_blob }
90              
91             sub equal {
92 0     0 1   my($keyA, $keyB) = @_;
93             $keyA->{rsa} && $keyB->{rsa} &&
94             $keyA->{rsa}{bits} == $keyB->{rsa}{bits} &&
95             $keyA->{rsa}{n} == $keyB->{rsa}{n} &&
96 0 0 0       $keyA->{rsa}{e} == $keyB->{rsa}{e};
      0        
      0        
97             }
98              
99             sub as_blob {
100 0     0 1   my $key = shift;
101 0           join ' ', $key->{rsa}{bits}, $key->{rsa}{e}, $key->{rsa}{n};
102             }
103              
104             sub fingerprint_raw {
105 0     0 0   my $key = shift;
106 0           _mp_linearize($key->{rsa}->{n}) . _mp_linearize($key->{rsa}->{e});
107             }
108              
109             1;
110             __END__