1# $Id: Key.pm,v 1.20 2008/10/02 20:46:17 turnstep Exp $
2
3package Net::SSH::Perl::Key;
4use strict;
5use warnings;
6
7use Crypt::Digest::SHA256 qw( sha256 );
8use Crypt::Digest::MD5 qw( md5 );
9use Crypt::Misc qw( encode_b64 decode_b64 );
10use Net::SSH::Perl::Buffer;
11
12sub new {
13    my $class = shift;
14    if ($class eq __PACKAGE__) {
15        $class .= "::" . shift();
16        eval "use $class;";
17        die "Key class '$class' is unsupported: $@" if $@;
18    }
19    my $key = bless {}, $class;
20    $key->init(@_);
21    $key;
22}
23
24use vars qw( %KEY_TYPES );
25%KEY_TYPES = (
26    'ssh-dss' => 'DSA',
27    'ssh-rsa' => 'RSA',
28    'ssh-ed25519' => 'Ed25519',
29    'ecdsa-sha2-nistp256' => 'ECDSA256',
30    'ecdsa-sha2-nistp384' => 'ECDSA384',
31    'ecdsa-sha2-nistp521' => 'ECDSA521',
32);
33
34sub new_from_blob {
35    my $class = shift;
36    my($blob) = @_;
37    my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH1' );
38    $b->append($blob);
39    my $ssh_name = $b->get_str;
40    my $type = $KEY_TYPES{$ssh_name} or return;
41    __PACKAGE__->new($type, @_);
42}
43
44sub extract_public {
45    my $class = shift;
46    my($blob) = pop @_;
47    my $expected_type = @_ ? shift : undef;
48
49    my $type;
50    my $options;
51    foreach my $t (keys %KEY_TYPES) {
52        if ((my $type_offset = index($blob,$t)) >= 0) {
53            $type = $t;
54            $options = substr($blob,0,$type_offset,'') if $type_offset > 0;
55            last;
56        }
57    }
58
59    # TODO do something with ssh options $options
60
61    if (!defined $type) {
62        warn "Invalid public key line";
63        return;
64    }
65    substr($blob,0,length($type)+1,'');
66    my($data, $comment) = split /\s+/, $blob, 2;
67    if (defined $expected_type && $expected_type ne $type) {
68        warn "Requested type '$expected_type' mismatches actual type '$type'";
69        return;
70    }
71    $type = $KEY_TYPES{$type};
72    my $key = __PACKAGE__->new($type, decode_b64($data));
73    $key->comment($comment);
74    $key;
75}
76
77BEGIN {
78    no strict 'refs'; ## no critic
79    for my $meth (qw( read_private keygen )) {
80        *$meth = sub {
81            my $class = shift;
82            if ($class eq __PACKAGE__) {
83                $class .= "::" . shift();
84                eval "use $class;";
85                die "Key class '$class' is unsupported: $@" if $@;
86            }
87            $class->$meth(@_);
88        };
89    }
90}
91
92use vars qw( %OBJ_MAP );
93%OBJ_MAP = (
94    'DSA PRIVATE KEY'  => [ 'DSA' ],
95    'SSH2 ENCRYPTED PRIVATE KEY' => [ 'DSA', [ 'SSH2' ] ],
96    'RSA PRIVATE KEY'  => [ 'RSA' ],
97    'OPENSSH PRIVATE KEY'  => [ 'Ed25519' ],
98    'EC PRIVATE KEY' => [ 'ECDSA' ],
99);
100
101sub read_private_pem {
102    my $class = shift;
103    my $keyfile = $_[0];
104    open my $fh, '<', $keyfile or return;
105    chomp(my $desc = <$fh>);
106    close $fh or warn qq{Could not close "$keyfile": $!\n};
107    return unless $desc;
108    my($object) = $desc =~ /^-----?\s?BEGIN ([^\n\-]+)\s?-?----\s*$/;
109    $object =~ s/\s*$//;
110    my $rec = $OBJ_MAP{$object} or return;
111    $class = __PACKAGE__ . "::" . $rec->[0];
112    eval "use $class;";
113    die "Key class '$class' is unsupported: $@" if $@;
114    my @args = $rec->[1] ? @{ $rec->[1] } : ();
115    $class->read_private(@_, @args);
116}
117
118sub init;
119sub extract_public;
120sub as_blob;
121sub equal;
122sub size;
123
124sub fingerprint {
125    my $key = shift;
126    my($type) = @_;
127    my $data = $key->fingerprint_raw;
128    $type && $type eq 'bubblebabble' ?
129        _fp_bubblebabble($data) :
130        $type && $type eq 'md5' ?
131          _fp_md5($data) :
132          _fp_sha256($data);
133}
134
135sub _fp_bubblebabble {
136    eval "use Digest::BubbleBabble qw( bubblebabble )";
137    die "Can't load BubbleBabble implementation: $@" if $@;
138    eval "use Crypt::Digest::SHA1 qw( sha1 )";
139    die "Can't load SHA1: $@" if $@;
140    bubblebabble( Digest => sha1($_[0]) )
141}
142
143sub _fp_sha256 { "SHA256:" . encode_b64(sha256(shift)) }
144sub _fp_md5 { join ':', map { sprintf "%02x", ord } split //, md5($_[0]) }
145
146sub comment {
147    my $key = shift;
148    my $comment = shift;
149    $key->{comment} = $comment if defined $comment;
150    $key->{comment};
151}
152
153sub dump_public { join ' ', grep { defined } $_[0]->ssh_name, encode_b64( $_[0]->as_blob ), $_[0]->comment }
154
1551;
156__END__
157
158=head1 NAME
159
160Net::SSH::Perl::Key - Public or private key abstraction
161
162=head1 SYNOPSIS
163
164    use Net::SSH::Perl::Key;
165    my $key = Net::SSH::Perl::Key->new;
166
167=head1 DESCRIPTION
168
169I<Net::SSH::Perl::Key> implements an abstract base class interface
170to key objects (either DSA, RSA, ECDSA, or Ed25519 keys, currently).
171The underlying implementation for RSA, DSA, an ECDSA keys is the
172CryptX module.  The Ed25519 implementation uses bundled XS and C code
173from the SUPERCOP ref10 implementation.
174
175=head1 USAGE
176
177=head2 Net::SSH::Perl::Key->new($key_type [, $blob [, $compat_flag_ref ]])
178
179Creates a new object of type I<Net::SSH::Perl::Key::$key_type>,
180after loading the class implementing I<$key_type>.
181should be C<DSA>, C<RSA1>, C<RSA>, C<ECDSA256>, C<ECDSA384>, C<ECDSA521>,
182or C<Ed25519>.
183
184I<$blob>, if present, should be a string representation of the key,
185from which the key object can be initialized. In fact, it should
186be the representation that is returned from the I<as_blob> method,
187below.
188
189I<$compat_flag_ref> should be a reference to the SSH compatibility
190flag, which is generally stored inside of the I<Net::SSH::Perl>
191object. This flag is used by certain key implementations (C<DSA>)
192to work around differences between SSH2 protocol implementations.
193
194Returns the new key object, which is blessed into the subclass.
195
196=head2 Net::SSH::Perl::Key->read_private($key_type, $file [, $pass])
197
198Reads a private key of type I<$key_type> out of the key file
199I<$file>. If the private key is encrypted, an attempt will be
200made to decrypt it using the passphrase I<$pass>; if I<$pass>
201is not provided, the empty string will be used. An empty
202passphrase can be a handy way of providing password-less access
203using publickey authentication.
204
205If for any reason loading the key fails, returns I<undef>; most
206of the time, if loading the key fails, it's because the passphrase
207is incorrect. If you first tried to read the key using an empty
208passphrase, this might be a good time to ask the user for the
209actual passphrase. :)
210
211Returns the new key object, which is blessed into the subclass
212denoted by I<$key_type> (C<DSA>, C<RSA1>, C<ECDSA> or C<Ed25519>).
213
214=head2 Net::SSH::Perl::Key->keygen($key_type, $bits)
215
216$key_type is one of RSA, DSA, or ECDSA256/ECDSA384/ECDSA521.
217Generates a new key and returns that key. The key returned is the
218private key, which (presumably) contains all of the public key
219data, as well. I<$bits> is the number of bits in the key.
220
221Your I<$key_type> implementation may not support key generation;
222if not, calling this method is a fatal error.
223
224Returns the new key object, which is blessed into the subclass
225denoted by I<$key_type>
226
227=head2 Net::SSH::Perl::Key->keygen('Ed25519')
228
229Generates a new Ed25519 key.  Ed25519 keys have fixed key length.
230
231Returns the new key object, which is bless into the Ed25519
232subclass.
233
234=head2 Net::SSH::Perl::Key->extract_public($key_type, $key_string)
235
236Given a key string I<$key_string>, which should be a textual
237representation of the public portion of a key of I<$key_type>,
238extracts the key attributes out of that string. This is used to
239extract public keys out of entries in F<known_hosts> and public
240identity files.
241
242Returns the new key object, which is blessed into the subclass
243denoted by I<$key_type>
244
245=head2 $key->write_private([ $file [, $pass, $ciphername, $rounds] ])
246
247Writes out the private key I<$key> to I<$file>, and encrypts
248it using the passphrase I<$pass>. If I<$pass> is not provided,
249the key is unencrypted, and the only security protection is
250through filesystem protections.  For Ed25519 keys, optional
251parameters ciphername and rounds can be passed to specify the
252desired cipher to encrypt the key with and how many rounds of
253encryption to employ, respectively.
254
255If I<$file> is not provided, returns the content that would
256have been written to the key file.
257
258=head2 $key->dump_public
259
260Performs the inverse of I<extract_public>: takes a key I<$key>
261and dumps out a textual representation of the public portion
262of the key. This is used when writing public key entries to
263F<known_hosts> and public identity files.
264
265Returns the textual representation.
266
267=head2 $key->as_blob
268
269Returns a string representation of the public portion of the
270key; this is I<not> the same as I<dump_public>, which is
271intended to match the format used in F<known_hosts>, etc.
272The return value of I<as_blob> is used as an intermediary in
273computing other values: the key fingerprint, the known hosts
274representation, etc.
275
276=head2 $key->equal($key2)
277
278Returns true if the public portions of I<$key> are equal to
279those of I<$key2>, and false otherwise. This is used when
280comparing server host keys to keys in F<known_hosts>.
281
282=head2 $key->size
283
284Returns the size (in bits) of the key I<$key>.
285
286=head2 $key->fingerprint([ I<$type> ])
287
288Returns a fingerprint of I<$key>. The default fingerprint is
289a SHA256 representation.  If I<$type> is equal to C<bubblebabble>,
290the Bubble Babble representation of the fingerprint is used.
291If I<$type> is equal to C<hex>, a traditional hex representation
292is returned.
293
294The hex representation uses an I<MD5> digest of the public key,
295and the bubblebabble uses a I<SHA-1> digest.
296
297=head1 AUTHOR & COPYRIGHTS
298
299Please see the Net::SSH::Perl manpage for author, copyright,
300and license information.
301
302=cut
303