File Coverage

blib/lib/Data/SSHPubkey.pm

Criterion	Covered	Total	%
statement	84	89	94.3
branch	36	52	69.2
condition			n/a
subroutine	10	10	100.0
pod	2	2	100.0
total	132	153	86.2

# -*- Perl -*-
#
# utility function to parse SSH public keys with
#
# run perldoc(1) on this file for documentation

package Data::SSHPubkey;

use 5.010;
use strict;
use warnings;

use Carp qw(croak);
use File::Temp ();

our ( $max_keys, $max_lines, %ssh_pubkey_types );

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(&convert_pubkeys &pubkeys %ssh_pubkey_types);

our $VERSION = '0.06';

# rsa or ecdsa or ed25519 with the upper case forms presumably some
# other encoding of one of these, so set very low by default
$max_keys = 3;

# a 4096-bit RSA key is 16 lines in RFC4716, though this may need to be
# set higher if you allow long comments, or
$max_lines = 100;

@ssh_pubkey_types{qw(ecdsa ed25519 rsa PEM PKCS8 RFC4716)} = ();
# NOTE these are taken from the ssh-keygen(1) -t or -m options which
# differ from the strings present in the SSH key data
#
#   type        public key prefix
#   -----------------------------------
#   ecdsa       ecdsa-sha2-nistp256 ...
#   ed25519     ssh-ed25519 ...
#   rsa         ssh-rsa ...
#
# those responsible for the confusion between these two different bits
# of data in versions of this module prior to 0.05 have been sacked

sub convert_pubkeys {
    my ($list) = @_;
    my @pubkeys;
    for my $ref (@$list) {
        if ( $ref->[0] =~ m/^(?:PEM|PKCS8|RFC4716)$/ ) {
            # TODO perl (or CPAN module) conversion of these so don't
            # need to call out to this ssh-keygen which is not portable
            # to olden versions of ssh-keygen
            my $tmp = File::Temp->new;
            print $tmp $ref->[1];
            my $tfile = $tmp->filename;
            open my $fh, '-|', qw(ssh-keygen -i -m), $ref->[0], '-f', $tfile
              or die "could not exec ssh-keygen: $!";
            binmode $fh;
            push @pubkeys, do { local $/; readline $fh };
            close $fh or die "ssh-keygen failed with exit status $?";
        } elsif ( $ref->[0] =~ m/^(?:ecdsa|ed25519|rsa)$/ ) {
            push @pubkeys, $ref->[1];
        } else {
            croak 'unknown public key type ' . $ref->[0];
        }
    }
    chomp @pubkeys;
    return \@pubkeys;
}

sub pubkeys {
    my ($input) = @_;
    croak "input must be string, GLOB, or scalar ref" if !defined $input;
    my $fh;
    if ( ref $input eq 'GLOB' ) {
        $fh = $input;
    } else {
        open $fh, '<', $input or croak "could not open $input: $!";
        binmode $fh;
    }
    my @keys;
    while ( my $line = readline $fh ) {
        croak "too many input lines" if $. > $max_lines;
        if ( $line =~ m{^(-----BEGIN RSA PUBLIC KEY-----)} ) {
            my $key = $1;
            my ( $ok, $data ) = _until_end( $fh, '-----END RSA PUBLIC KEY-----' );
            croak "could not parse PEM pubkey: $data" unless defined $ok;
            push @keys, [ 'PEM', $key . $/ . $data ];
        } elsif ( $line =~ m{^(-----BEGIN PUBLIC KEY-----)} ) {
            my $key = $1;
            my ( $ok, $data ) = _until_end( $fh, '-----END PUBLIC KEY-----' );
            croak "could not parse PKCS8 pubkey: $data" unless defined $ok;
            push @keys, [ 'PKCS8', $key . $/ . $data ];

        } elsif ( $line =~ m{^(---- BEGIN SSH2 PUBLIC KEY ----)} ) {
            my $key = $1;
            my ( $ok, $data ) = _until_end( $fh, '---- END SSH2 PUBLIC KEY ----' );
            croak "could not parse RFC4716 pubkey: $data" unless defined $ok;
            push @keys, [ 'RFC4716', $key . $/ . $data ];
        } elsif (
            # long enough for a RSA 4096-bit key, a bit too genereous
            # for ed25519 so probably should instead be done for each
            # key type
            $line =~ m{
              (?(?ecdsa)-sha2-nistp256|ssh-(?ed25519|rsa)) [\t ]+?
              (?[A-Za-z0-9+/=]{64,717}) (?:[\t ]|$) }x
        ) {
            push @keys, [ $+{type}, $+{prefix} . ' ' . $+{key} ];
        }
        croak "too many keys" if @keys > $max_keys;
    }
    return \@keys;
}

# this (probably incorrectly) enforces RFC 4716 parsing on all of the
# multiline formats so may not be correct for the other two formats,
# though attempts are made at supporting them
sub _until_end {
    my ( $fh, $fin ) = @_;
    my $ok;
    my $ret = '';
    while ( my $line = readline $fh ) {
        die "too many input lines" if $. > $max_lines;
        if ( $line =~ m/^($fin)/ ) {
            $ret .= $1;
            $ok = 1;
            last;
        }

        # RFC 4716 "implementations SHOULD be prepared to read files
        # using any of the common line termination sequence[s]"
        $line =~ s/(\012|\015|\015\012)$//;

        # RFC 4716 "line[s] ... MUST NOT be longer than 72 8-bit bytes
        # excluding line termination characters" (TODO bytes vs. characters)
        return undef, "line $. too long" if length $line > 72;

        # RFC 4716 ignore "key file header" fields as this code pretends
        # that it cannot recognize any
        if ( $line =~ m/:/ ) {
            if ( $line =~ m/\\$/ ) {    # backslash continues a line
                do {
                    $line = readline $fh;
                    return undef, "continued to EOF" if eof $fh;
                    $line =~ s/(\012|\015|\015\012)$//;
                    return undef, "line $. too long" if length $line > 72;
                } until $line !~ m/\\$/;
            }
            next;
        }

        # RFC 4253 section 6.6 indicates there can be a "signature
        # format identifier"; those are KLUGE not supported by this
        # module as I don't know what that specific encoding looks like.
        # go with a sloppy Base64ish match, meanwhile, as that is what
        # OpenSSH generates as output
        if ( $line =~ m{^([A-Za-z0-9+/=]{1,72})$} ) {
            $ret .= $1 . $/;
            next;
        }

        # support RFC 822 by way of RFC 1421 PEM header extensions that
        # begin with leading whitespace (sloppy, should only happen for
        # header lines)
        next if $line =~ m{^[ \t]};

        # support RFC 1421 PEM blank line (poorly, as all blank lines
        # are ignored)
        next if $line =~ m{^$};

        return undef, "fell off end of parser at line $.";
    }
    return $ok, $ret;
}

1;
__END__