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