File Coverage

blib/lib/Parse/SSH2/PublicKey.pm

Criterion	Covered	Total	%
statement	97	124	78.2
branch	9	26	34.6
condition	3	10	30.0
subroutine	15	15	100.0
pod	6	6	100.0
total	130	181	71.8

package Parse::SSH2::PublicKey;

use strict;
use warnings;
use autodie qw/open close/;
use Moo;
use MIME::Base64;
use Carp qw/confess/;
no warnings qw/substr uninitialized/;

our $VERSION = 0.01;

=head1 NAME

Parse::SSH2::PublicKey - Parse SSH2 public keys in either SECSH or OpenSSH format.

=head1 VERSION

Version 0.01

=cut

=head1 PURPOSE

Different implementations of SSH (OpenSSH, SSH Tectia, PuTTY, etc) use different key formats. For example, for public key authentication, OpenSSH will accept an authorized_keys file that holds all keys, whereas the ssh.com proprietary implementation wants an authorized_keys/ *directory* with a file for each key!

This module was created to assist sysadmins in converting from one SSH implementation to another.

=head1 SYNOPSIS

    use Parse::SSH2::PublicKey;

    my $auth_key = "$ENV{HOME}/.ssh/authorized_keys";
    my @keys = Parse::SSH2::PublicKey->parse_file($auth_key);

    for my $k ( @keys ) {
        print $k->secsh();
        # or ->openssh()
    }

    ...

    my $dir  = "$ENV{HOME}/.ssh2/authorized_keys/";
    my @files = glob("$dir/*pub");
    my @keys = map { Parse::SSH2::PublicKey->parse_file($_) } @files;

    for my $k ( @keys ) {
        print $k->openssh();
    }

=cut

has key => (
    is  => 'ro',
    isa => sub {},
    default => sub { '' },
);

has type => (
    is  => 'ro',
    isa => sub {
        my $t = shift;
        confess "type must be 'public' or 'private'"
            unless grep { $t eq $_ } qw (public private);
    },
    default => sub { '' },
);

has encryption => (
    is  => 'ro',
    isa => sub {
        my $enc = shift;
        confess "must be 'ssh-rsa' or 'ssh-dss'"
            unless grep { $enc eq $_ } qw/ssh-rsa ssh-dss/;
    },
    default => sub { '' },
);

has headers => (
    is => 'ro',
    isa => sub { die "'headers' attribute must be a hashref." unless (ref $_[0] eq 'HASH'); },
    default => sub { return {} },
);

has header_order => (
    is => 'ro',
    isa => sub { die "'header_order' attribute must be an arrayref." unless (ref $_[0] eq 'ARRAY'); },
    default => sub { return [] },
);

=head1 METHODS

=head2 new()

Creates an Parse::SSH2::PublicKey object. Not intended to be used directly.
Instead, this is called internally by parse(),
which returns an array of objects.

=head2 parse()

Accepts a block of text and parses out SSH2 public keys in both OpenSSH and SECSH format.
Returns an *array* of Parse::SSH2::PublicKey objects. Class method to be used instead of new().

=cut

sub parse {
    my $class = shift;
    my $data  = shift;

    my @objs;

    while ( length($data) > 0 ) {

        my $entire_key;

        # OpenSSH format -- all on one line.
        if ( $data =~ m%((ssh-rsa|ssh-dss)\ ([A-Z0-9a-z/+=]+)\s*([^\n]*))%gsmx ) {
            $entire_key = $1;

            # TODO: pull encryption from base64 key data, not here... just to be safe.
            my $encryption = $2;
            my $key = $3;
            my $comment = $4;
            my $type   = 'public';

            my ($headers, $header_order);
            if ( defined $comment ) {
                push @$header_order, 'Comment';
                $headers->{ 'Comment' } = $comment;
            }

            push @objs, $class->new( key     => $key,
                                     #comment => $headers->{Comment} || '',
                                     type    => $type,
                                     #subject => '',
                                     header_order => $header_order,
                                     headers => $headers,
                                     encryption => $encryption );

        }

        # SECSH pubkey format
        elsif ( $data =~ m/(----\ BEGIN\ SSH2\ PUBLIC\ KEY\ ----(?:\n|\r|\f)
                           (.*?)(?:\n|\r|\f)
                           ----\ END\ SSH2\ PUBLIC\ KEY\ ----)/gsmx ) {
            $entire_key = $1;
            my $type = 'public';
            my $keydata = $2;

            my ($key, $header_order, $headers) = _extract_secsh_key_headers( $keydata );

            # ==================================================================
            # TODO: this needs to be factored out into a separate subroutine
            # which decodes ALL the base64 key data (modulus and exponent also)
            my $octets = decode_base64( $key );
            my $dlen = unpack("N4", substr($octets,0,4));
            my $encryption = unpack("A" . $dlen, substr($octets, 4, $dlen));
            # ==================================================================

            push @objs, $class->new( key     => $key,
                                     #comment => $headers->{Comment} || '',
                                     type    => $type,
                                     #subject => $headers->{Subject} || '',
                                     header_order => $header_order,
                                     headers => $headers,
                                     encryption => $encryption );
        }

        # note: OpenSSH private keys are parsed & removed from $data,
        # but objects are not created
        elsif ( $data =~ m/(-+BEGIN\ (DSA|RSA)\ PRIVATE\ KEY-+(?:\n|\r|\f)
                           (.*?)(?:\n|\r|\f)
                           -+END\ (DSA|RSA)\ PRIVATE\ KEY-+)/gsmx ) {
            $entire_key = $1;
            my $encryption = $2;
            my $keydata = $3;
            my $type = 'private';

            my ($key, $header_order, $headers) = _extract_secsh_key_headers( $keydata );

            $encryption = ($encryption eq 'RSA') ? 'ssh-rsa' :
                          ($encryption eq 'DSA') ? 'ssh-dss' : '';
            # Because the regex match requires RSA or DSA for this value,
            # $encryption should never get set to the empty string here.
        }
        else {
            # no keys found and/or invalid key data
            last;
        }

        $data =~ s/\Q$entire_key\E(?:\n|\f|\r)?//gsmx;
    }

    return @objs;
}

=head2 parse_file()

Convenience method which opens a file and calls C on the contents.

=cut

sub parse_file {
    my $class  = shift;
    my $infile = shift;

    open (my $in , '<', $infile);
    # now handled by autodie

    my $data = do { local $/; <$in> };
    close $in;
    return $class->parse( $data );
}

=head2 secsh()

Returns an SSH public key in SECSH format (as specified in RFC4716).
Preserves headers and the order of headers.

See L.

=cut

sub secsh {
    my $self = shift;

    my $str;
    if ( $self->type eq 'public' ) {
        $str = "---- BEGIN SSH2 PUBLIC KEY ----\n";
        my @headers = @{$self->header_order()};
        if ( scalar(@headers) ) {
            for my $h ( @headers ) {
                $str .= join("\\\n", split(/\n/, _chop_long_string(
                        $h . ': ' . $self->headers->{$h}, 70 ))) . "\n";
            }
        }
        $str .= _chop_long_string( $self->key, 70 ) . "\n";
        $str .= "---- END SSH2 PUBLIC KEY ----\n";
    }

    # TODO: remove support for private keys...
    elsif ( $self->type eq 'private' ) {
        $str = "---- BEGIN SSH2 ENCRYPTED PRIVATE KEY ----\n";

        # Not sure if 'Proc-Type' and 'DEK-Info' are valid headers
        # for Tectia private keys...

        my @headers = @{$self->header_order()};
        @headers = grep { !/Proc-Type/ && !/DEK-Info/ } @headers;
        if ( scalar(@headers) ) {
            for my $h ( @headers ) {
                $str .= join("\\\n", split(/\n/, _chop_long_string(
                        $h . ': ' . $self->headers->{$h}, 70 ))) . "\n";
            }
        }

        $str .= _chop_long_string( $self->key, 70 ) . "\n";
        $str .= "---- END SSH2 ENCRYPTED PRIVATE KEY ----\n";
    }

    return $str;
}


=head2 openssh()

Returns an SSH public key in OpenSSH format. Preserves 'comment' field
parsed from either SECSH or OpenSSH.

=cut

sub openssh {
    my $self = shift;

    my $str;

    if ( $self->type eq 'public' ) {
        $str  = $self->encryption . ' ' .
                $self->key        . ' ' .
                $self->comment    . "\n";
    }

    # TODO: remove support for private keys...
    elsif ( $self->type eq 'private' ) {
        $str = "-----BEGIN " . $self->encryption . " PRIVATE KEY-----\n";

        # Not sure if 'Comment' and 'Subject' are valid headers
        # for OpenSSH private keys...

        my @headers = @{$self->header_order()};
        @headers = grep { !/Comment/ && !/Subject/ } @headers;
        if ( scalar(@headers) ) {
            for my $h ( @headers ) {
                $str .= join("\\\n", split(/\n/, _chop_long_string(
                        $h . ': ' . $self->headers->{$h}, 64 ))) . "\n";
            }
            $str .= "\n";
        }
        $str .= _chop_long_string( $self->key, 64 ) . "\n";
        $str .= "-----END " . $self->encryption . " PRIVATE KEY-----\n";
    }

    return $str;
}

=head2 comment()

Convenience method for $k->headers->{Comment}. Returns the Comment header value or the empty string.

=cut

sub comment {
    my $self = shift;
    return $self->headers->{Comment} || '';
}

=head2 subject()

Convenience method for $k->headers->{Subject}. Returns the Subject header value or the empty string.

=cut

sub subject {
    my $self = shift;
    return $self->headers->{Subject} || '';
}

=head1 ATTRIBUTES

=head2 encryption

Either 'ssh-rsa' or 'ssh-dss', for RSA and DSA keys, respectively.

=head2 header_order

Order of headers parsed from SECSH-format keys. See also
L.

=head2 headers

Hashref containing headers parsed from SECSH-format keys.
See also L.

=head2 key

The actual base64-encoded key data.

=head2 type

Either 'public' or 'private', but private keys aren't currently
supported. Obsolete. (Or perhaps ahead of it's time.)

=cut

# internal method, not intended for use outside this module
# Breaks long string into chunks of MAXLEN length,
# separated by "\n"
sub _chop_long_string {
    my $string = shift;
    my $maxlen = shift;

    my @lines;
    my $index = 0;
    while ( my $line = substr($string, $index, $maxlen) ) {
        push @lines, $line;
        $index += $maxlen;
    }
    return join("\n", @lines);
}


# internal method, not intended for use outside this module
sub _extract_secsh_key_headers {
    my $data = shift;
    my %headers;
    my @header_order;

    # Match all up to a "\n" not prefixed with a '\' char
    # -- a "\\\n" sequence should be ignored/slurped.
    # This regex uses negative look-behind.
    while ( $data =~ m/^((?:\w|-)+):\ (.*?)(?
    {
        my $header_tag = $1;
        my $header_val = $2;

        # Don't change \\\n to '' here, because we need this
        # to match the header for stripping it from the key
        # data below.
        $headers{ $header_tag } = $header_val;
        push @header_order, $header_tag;
    }

    for my $h ( keys %headers ) {
        # strip headers from main key data,
        # now that they have been saved in %headers
        $data =~ s/\Q$h: $headers{$h}\E(?:\n|\f|\r)//gsm;
    }

    # NOW strip the '\\\n' from the header values
    $_ =~ s/\\(\n|\f|\r)//g for values %headers;

    (my $key = $data) =~ s/\n|\f|\r//g;

    return ($key, \@header_order, \%headers);
}


1;

__END__