# $Id: Key.pm,v 1.20 2008/10/02 20:46:17 turnstep Exp $
package Net::SSH::Perl::Key;
use strict;
use Digest::MD5 qw( md5 );
use Net::SSH::Perl::Buffer;
sub new {
my $class = shift;
if ($class eq __PACKAGE__) {
$class .= "::" . shift();
eval "use $class;";
die "Key class '$class' is unsupported: $@" if $@;
}
my $key = bless {}, $class;
$key->init(@_);
$key;
}
use vars qw( %KEY_TYPES );
%KEY_TYPES = (
'ssh-dss' => 'DSA',
'ssh-rsa' => 'RSA',
);
sub new_from_blob {
my $class = shift;
my($blob) = @_;
my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH1' );
$b->append($blob);
my $ssh_name = $b->get_str;
my $type = $KEY_TYPES{$ssh_name};
__PACKAGE__->new($type, @_);
}
sub extract_public {
my $class = shift;
my($blob) = @_;
my($ssh_name, $data) = split /\s+/, $blob;
my $type = $KEY_TYPES{$ssh_name};
eval "use MIME::Base64";
die $@ if $@;
__PACKAGE__->new($type, decode_base64($data));
}
BEGIN {
no strict 'refs'; ## no critic
for my $meth (qw( read_private keygen )) {
*$meth = sub {
my $class = shift;
if ($class eq __PACKAGE__) {
$class .= "::" . shift();
eval "use $class;";
die "Key class '$class' is unsupported: $@" if $@;
}
$class->$meth(@_);
};
}
}
use vars qw( %OBJ_MAP );
%OBJ_MAP = (
'DSA PRIVATE KEY' => [ 'DSA' ],
'SSH2 ENCRYPTED PRIVATE KEY' => [ 'DSA', [ 'SSH2' ] ],
'RSA PRIVATE KEY' => [ 'RSA' ],
);
sub read_private_pem {
my $class = shift;
my $keyfile = $_[0];
open my $fh, '<', $keyfile or return;
chomp(my $desc = <$fh>);
close $fh or warn qq{Could not close "$keyfile": $!\n};
return unless $desc;
my($object) = $desc =~ /^-----?\s?BEGIN ([^\n\-]+)\s?-?----$/;
$object =~ s/\s*$//;
my $rec = $OBJ_MAP{$object} or return;
$class = __PACKAGE__ . "::" . $rec->[0];
eval "use $class;";
die "Key class '$class' is unsupported: $@" if $@;
my @args = $rec->[1] ? @{ $rec->[1] } : ();
$class->read_private(@_, @args);
}
sub init;
sub extract_public;
sub dump_public;
sub as_blob;
sub equal;
sub size;
sub fingerprint {
my $key = shift;
my($type) = @_;
my $data = $key->fingerprint_raw;
$type && $type eq 'bubblebabble' ?
_fp_bubblebabble($data) : _fp_hex($data);
}
sub _fp_bubblebabble {
eval "use Digest::BubbleBabble qw( bubblebabble )";
die "Can't load BubbleBabble implementation: $@" if $@;
eval "use Digest::SHA1 qw( sha1 )";
die "Can't load SHA1: $@" if $@;
bubblebabble( Digest => sha1($_[0]) )
}
sub _fp_hex { join ':', map { sprintf "%02x", ord } split //, md5($_[0]) }
1;
__END__
=head1 NAME
Net::SSH::Perl::Key - Public or private key abstraction
=head1 SYNOPSIS
use Net::SSH::Perl::Key;
my $key = Net::SSH::Perl::Key->new;
=head1 DESCRIPTION
I<Net::SSH::Perl::Key> implements an abstract base class interface
to key objects (either DSA or RSA keys, currently). The underlying
implementation for RSA is an internal, hash-reference implementation;
the DSA implementation uses I<Crypt::DSA>.
=head1 USAGE
=head2 Net::SSH::Perl::Key->new($key_type [, $blob [, $compat_flag_ref ]])
Creates a new object of type I<Net::SSH::Perl::Key::$key_type>,
after loading the class implementing I<$key_type>. I<$key_type>
should be either C<DSA> or C<RSA1>, currently; these are the
only supported key implementations at the moment.
I<$blob>, if present, should be a string representation of the key,
from which the key object can be initialized. In fact, it should
be the representation that is returned from the I<as_blob> method,
below.
I<$compat_flag_ref> should be a reference to the SSH compatibility
flag, which is generally stored inside of the I<Net::SSH::Perl>
object. This flag is used by certain key implementations (C<DSA>)
to work around differences between SSH2 protocol implementations.
Returns the new key object, which is blessed into the subclass.
=head2 Net::SSH::Perl::Key->read_private($key_type, $file [, $pass])
Reads a private key of type I<$key_type> out of the key file
I<$file>. If the private key is encrypted, an attempt will be
made to decrypt it using the passphrase I<$pass>; if I<$pass>
is not provided, the empty string will be used. An empty
passphrase can be a handy way of providing password-less access
using publickey authentication.
If for any reason loading the key fails, returns I<undef>; most
of the time, if loading the key fails, it's because the passphrase
is incorrect. If you first tried to read the key using an empty
passphrase, this might be a good time to ask the user for the
actual passphrase. :)
Returns the new key object, which is blessed into the subclass
denoted by I<$key_type> (either C<DSA> or C<RSA1>).
=head2 Net::SSH::Perl::Key->keygen($key_type, $bits)
Generates a new key and returns that key. The key returned is
the private key, which (presumably) contains all of the public
key data, as well. I<$bits> is the number of bits in the key.
Your I<$key_type> implementation may not support key generation;
if not, calling this method is a fatal error.
Returns the new key object, which is blessed into the subclass
denoted by I<$key_type> (either C<DSA> or C<RSA1>).
=head2 Net::SSH::Perl::Key->extract_public($key_type, $key_string)
Given a key string I<$key_string>, which should be a textual
representation of the public portion of a key of I<$key_type>,
extracts the key attributes out of that string. This is used to
extract public keys out of entries in F<known_hosts> and public
identity files.
Returns the new key object, which is blessed into the subclass
denoted by I<$key_type> (either C<DSA> or C<RSA1>).
=head2 $key->write_private([ $file [, $pass] ])
Writes out the private key I<$key> to I<$file>, and encrypts
it using the passphrase I<$pass>. If I<$pass> is not provided,
the key is unencrypted, and the only security protection is
through filesystem protections.
If I<$file> is not provided, returns the content that would
have been written to the key file.
=head2 $key->dump_public
Performs the inverse of I<extract_public>: takes a key I<$key>
and dumps out a textual representation of the public portion
of the key. This is used when writing public key entries to
F<known_hosts> and public identity files.
Returns the textual representation.
=head2 $key->as_blob
Returns a string representation of the public portion of the
key; this is I<not> the same as I<dump_public>, which is
intended to match the format used in F<known_hosts>, etc.
The return value of I<as_blob> is used as an intermediary in
computing other values: the key fingerprint, the known hosts
representation, etc.
=head2 $key->equal($key2)
Returns true if the public portions of I<$key> are equal to
those of I<$key2>, and false otherwise. This is used when
comparing server host keys to keys in F<known_hosts>.
=head2 $key->size
Returns the size (in bits) of the key I<$key>.
=head2 $key->fingerprint([ I<$type> ])
Returns a fingerprint of I<$key>. The default fingerprint is
a hex representation; if I<$type> is equal to C<bubblebabble>,
the Bubble Babble representation of the fingerprint is used
instead. The former uses an I<MD5> digest of the public key,
and the latter uses a I<SHA-1> digest.
=head1 AUTHOR & COPYRIGHTS
Please see the Net::SSH::Perl manpage for author, copyright,
and license information.
=cut