File Coverage

blib/lib/Config/OpenSSH/Authkey/Entry.pm

Criterion	Covered	Total	%
statement	87	92	94.5
branch	35	42	83.3
condition	7	15	46.6
subroutine	21	21	100.0
pod	16	16	100.0
total	166	186	89.2

# -*- Perl -*-
#
# representation of individual OpenSSH authorized_keys entries, based on
# a study of the sshd(8) manual, along with the OpenSSH 5.2 sources.
# this module only weakly validates the data; in particular, no effort
# is made to confirm whether the key options are actual valid options
# for the version of OpenSSH in question

package Config::OpenSSH::Authkey::Entry;

use 5.006000;
use strict;
use warnings;

use Config::OpenSSH::Authkey::Entry::Options ();

use Carp qw/croak/;

our $VERSION = '1.06';

# This limit is set for various things under OpenSSH code. Used here to
# limit length of authorized_keys lines.
my $MAX_PUBKEY_BYTES = 8192;

# Sanity check to ensure at least some data exists in the key field
my $MIN_KEY_LENGTH = 42;

######################################################################
#
# Data Parsing & Utility Methods - Internal

my $_parse_entry = sub {
    my $self = shift;
    my $data = shift || q{};

    my ( $options, $key, $comment, $protocol, $keytype );

    chomp $data;

    if ( $data =~ m/^\s*$/ or $data =~ m/^\s*#/ ) {
        return ( 0, 'no public key data' );
    } elsif ( length $data >= $MAX_PUBKEY_BYTES ) {
        return ( 0, 'exceeds size limit' );
    }

    # OpenSSH supports leading whitespace before options or key. Strip
    # this optional whitespace to simplify parsing.
    $data =~ s/^[ \t]+//;

  ENTRY_LEXER: {
        # Optional trailing comment (user@host, usually)
        if ( defined $key and $data =~ m/ \G (.+) /cgx ) {
            $comment = $1;

            last ENTRY_LEXER;
        }

        # SSH2 public keys
        if ( !defined $key
            and $data =~
            m/ \G ( (ssh-(rsa|dss|ed25519)|ecdsa-sha2-nistp256) [ \t]+? [A-Za-z0-9+\/]+ =* ) [ \t]* /cgx
        ) {

            $key = $1;
            my $type = $2;
            my $subtype = $3;
            # follow the -t argument option to ssh-keygen(1)
            if ( $type =~ m/^ssh-/ ) {
                if ( $subtype eq 'dss' ) {
                    $keytype = 'dsa';
                } else {
                    $keytype = $subtype;
                }
            } else {
                $keytype = 'ecdsa';
            }
            $protocol = 2;

            redo ENTRY_LEXER;
        }

        # SSH1 RSA public key
        if ( !defined $key
            and $data =~ m/ \G ( \d{3,5} [ \t]+? \d+ [ \t]+? \d+ ) [ \t]* /cgx ) {

            $key      = $1;
            $keytype  = 'rsa1';
            $protocol = 1;

            redo ENTRY_LEXER;
        }

        # Optional leading options - may contain whitespace inside ""
        if ( !defined $key and $data =~ m/ \G ([^ \t]+? [ \t]*) /cgx ) {
            $options .= $1;

            redo ENTRY_LEXER;
        }
    }

    if ( !defined $key ) {
        return ( 0, 'unable to parse public key' );

    } else {
        $self->{_key}      = $key;
        $self->{_protocol} = $protocol;
        $self->{_keytype}  = $keytype;

        if ( defined $options ) {
            $options =~ s/\s*$//;
            $self->{_options} = $options;
        }

        if ( defined $comment ) {
            $comment =~ s/\s*$//;
            $self->{_comment} = $comment;
        }
    }

    return ( 1, 'ok' );
};

######################################################################
#
# Class methods

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

    my $self = { _dup_of => 0 };

    if ( defined $data ) {
        my ( $is_parsed, $err_msg ) = $_parse_entry->( $self, $data );
        if ( !$is_parsed ) {
            croak $err_msg;
        }
    }

    bless $self, $class;
    return $self;
}

sub split_options {
    my $class = shift;
    Config::OpenSSH::Authkey::Entry::Options->split_options(@_);
}

######################################################################
#
# Instance methods

sub parse {
    my $self = shift;
    my $data = shift || croak 'no data supplied to parse';

    my ( $is_parsed, $err_msg ) = $_parse_entry->( $self, $data );
    if ( !$is_parsed ) {
        croak $err_msg;
    }

    return $self;
}

sub as_string {
    my $self   = shift;
    my $string = q{};

    if ( exists $self->{_parsed_options} ) {
        $string .= $self->{_parsed_options}->as_string . q{ };

    } elsif ( exists $self->{_options} and length $self->{_options} > 0 ) {
        $string .= $self->{_options} . q{ };
    }

    if ( !defined $self->{_key} or length $self->{_key} < $MIN_KEY_LENGTH ) {
        croak 'no key material present';
    }
    $string .= $self->{_key};

    if ( exists $self->{_comment} and length $self->{_comment} > 0 ) {
        $string .= q{ } . $self->{_comment};
    }

    return $string;
}

sub key {
    my $self = shift;
    my $key  = shift;
    if ( defined $key ) {
        my ( $is_parsed, $err_msg ) = $_parse_entry->( $self, $key );
        if ( !$is_parsed ) {
            croak $err_msg;
        }
    }
    if ( !defined $self->{_key} or length $self->{_key} < $MIN_KEY_LENGTH ) {
        croak 'no key material present';
    }
    return $self->{_key};
}

sub protocol {
    shift->{_protocol} || 0;
}

sub keytype {
    shift->{_keytype} || '';
}

sub comment {
    my $self    = shift;
    my $comment = shift;
    if ( defined $comment ) {
        $self->{_comment} = $comment;
    }
    return defined $self->{_comment} ? $self->{_comment} : '';
}

sub unset_comment {
    my $self = shift;
    delete $self->{_comment};
    return 1;
}

# The leading (optional!) options can be dealt with as a string
# (options, unset_options), or if parsed, as individual options
# (get_option, set_option, unset_option).

sub options {
    my $self        = shift;
    my $new_options = shift;

    if ( defined $new_options ) {
        delete $self->{_parsed_options};
        $self->{_options} = $new_options;
    }

    my $options_str =
      exists $self->{_parsed_options}
      ? $self->{_parsed_options}->as_string
      : $self->{_options};
    return defined $options_str ? $options_str : '';
}

sub unset_options {
    my $self = shift;
    delete $self->{_parsed_options};
    delete $self->{_options};
    return 1;
}

sub get_option {
    my $self = shift;

    if ( !exists $self->{_parsed_options} ) {
        $self->{_parsed_options} =
          Config::OpenSSH::Authkey::Entry::Options->new( $self->{_options} );
    }

    $self->{_parsed_options}->get_option(@_);
}

sub set_option {
    my $self = shift;

    if ( !exists $self->{_parsed_options} ) {
        $self->{_parsed_options} =
          Config::OpenSSH::Authkey::Entry::Options->new( $self->{_options} );
    }

    $self->{_parsed_options}->set_option(@_);
}

sub unset_option {
    my $self = shift;

    if ( !exists $self->{_parsed_options} ) {
        $self->{_parsed_options} =
          Config::OpenSSH::Authkey::Entry::Options->new( $self->{_options} );
    }

    $self->{_parsed_options}->unset_option(@_);
}

sub duplicate_of {
    my $self = shift;
    my $ref  = shift;

    if ( defined $ref ) {
        $self->{_dup_of} = $ref;
    }

    return $self->{_dup_of};
}

sub unset_duplicate {
    my $self = shift;
    $self->{_dup_of} = 0;
    return 1;
}

1;

__END__