File Coverage

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

Criterion	Covered	Total	%
statement	88	93	94.6
branch	35	42	83.3
condition	7	15	46.6
subroutine	21	21	100.0
pod	16	16	100.0
total	167	187	89.3

# -*- 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.05';

# 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 RSA or DSA public key
    if ( !defined $key
      and $data =~
      m/ \G ( ssh-(rsa|dss) [ \t]+? [A-Za-z0-9+\/]+ =* ) [ \t]* /cgx ) {

      $key = $1;
      # follow the -t argument option to ssh-keygen(1)
      $keytype = $2 eq 'rsa' ? 'rsa' : 'dsa';
      $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__