File Coverage

blib/lib/Net/SSH/AuthorizedKeysFile.pm

Criterion	Covered	Total	%
statement	112	146	76.7
branch	32	54	59.2
condition	1	3	33.3
subroutine	17	21	80.9
pod	10	14	71.4
total	172	238	72.2

###########################################
package Net::SSH::AuthorizedKeysFile;
###########################################
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use Text::ParseWords;
use Net::SSH::AuthorizedKey;
use Net::SSH::AuthorizedKey::SSH1;
use Net::SSH::AuthorizedKey::SSH2;

our $VERSION = "0.18";

###########################################
sub new {
###########################################
    my($class, @options) = @_;

    my $self = {
        default_file        => "$ENV{HOME}/.ssh/authorized_keys",
        strict              => 0,
        abort_on_error      => 0,
        append              => 0,
        ridiculous_line_len => 100_000,
        @options,
    };

    bless $self, $class;

      # We allow keys to be set in the constructor
    my $keys = $self->{keys} if exists $self->{keys};

    $self->reset();

    $self->{keys} = $keys if defined $keys;

    return $self;
}

###########################################
sub sanity_check {
###########################################
    my($self, $file) = @_;

    $self->{file} = $file if defined $file;
    $self->{file} = $self->{default_file} if !defined $self->{file};

    my $result = undef;

    my $fh;

    if(! open $fh, "<$self->{file}") {
        ERROR "Cannot open file $self->{file}";
        return undef;
    }

    while(
      defined(my $rc =
              sysread($fh, my $chunk, $self->{ridiculous_line_len}))) {
        if($rc < $self->{ridiculous_line_len}) {
            $result = 1;
            last;
        }

        if(index( $chunk, "\n" ) >= 0) {
              # contains a newline, looks good
            next;
        }

          # we've got a line that's between ridiculous_line_len and
          # 2*ridiculous_line_len characters long. Pull the plug.
        $self->error("File $self->{file} contains insanely long lines " .
                     "(> $self->{ridiculous_line_len} chars");
        last;
    }

DONE:
    close $fh;

    if(!$result) {
        ERROR "Sanity check of file $self->{file} failed";
    }
    return $result;
}

###########################################
sub keys {
###########################################
    my($self) = @_;

    return @{$self->{keys}};
}

###########################################
sub reset {
###########################################
    my($self) = @_;

    $self->{keys}    = [];
    $self->{content} = "";
    $self->{error}   = undef;
}

###########################################
sub content {
###########################################
    my($self, $new_content) = @_;

    if( defined $new_content ) {
       $self->reset();
       $self->{content} = $new_content;
    }

    return $self->{content};
}

###########################################
sub line_parse {
###########################################
    my($self, $line, $line_number) = @_;

    chomp $line;

    DEBUG "Parsing line [$line]";

    $self->error( "" );

    my $pk = Net::SSH::AuthorizedKey->parse( $line );

    if( !$pk ) {
        my $msg = "[$line] rejected by all parsers";
        WARN $msg;
        $self->error($msg);
        return undef;
    }

    if(! $self->{strict} or $pk->sanity_check()) {
        return $pk;
    }

    WARN "Key [$line] failed sanity check";

    if($self->{strict}) {
        $self->error( $pk->error() );
        return undef;
    }

      # Key is corrupted, but ok in non-strict mode
    return $pk;
}

###########################################
sub parse {
###########################################
    my($self) = @_;

    $self->{keys}  = [];
    $self->{error} = "";

    my $line_number = 0;

    for my $line (split /\n/, $self->{content}) {
        $line_number++;

        $line =~ s/^\s+//;     # Remove leading blanks
        $line =~ s/\s+$//;     # Remove trailing blanks
        next if $line =~ /^$/; # Ignore empty lines
        next if $line =~ /^#/; # Ignore comment lines

        my $key = $self->line_parse($line, $line_number);

        if( defined $key ) {
            push @{$self->{keys}}, $key;
        } else {
            if($self->{abort_on_error}) {
                $self->error("Line $line_number: " . $self->error());
                return undef;
            }
        }
    }

    return 1;
}

###########################################
sub read {
###########################################
    my($self, $file) = @_;

    $self->reset();

    $self->{file} = $file if defined $file;
    $self->{file} = $self->{default_file} if !defined $self->{file};
    $self->{content} = "";

    DEBUG "Reading in $self->{file}";

    open FILE, "<$self->{file}" or LOGDIE "Cannot open $self->{file}";

    while() {
        $self->{content} .= $_;
    }

    close FILE;

   return $self->parse();
}

###########################################
sub as_string {
###########################################
    my($self) = @_;

    my $string = "";

    for my $key ( @{ $self->{keys} } ) {
        $string .= $key->as_string . "\n";
    }

    return $string;
}

###########################################
sub save {
###########################################
    my($self, $file) = @_;

    if(!defined $file) {
        $file = $self->{file};
    }

    if(! open FILE, ">$file") {
        $self->error("Cannot open $file ($!)");
        WARN $self->error();
        return undef;
    }

    print FILE $self->as_string();
    close FILE;
}

###########################################
sub append {
###########################################
    my($self, $key) = @_;

    $self->{append} = 1;
}

###########################################
sub error {
###########################################
    my($self, $text) = @_;


    if(defined $text) {
        $self->{error} = $text;

        if(length $text) {
            ERROR "$text";
        }
    }

    return $self->{error};
}

###########################################
sub ssh_dir {
###########################################
    my($self, $user) = @_;

    if(!defined $user) {
        my $uid = $>;
        $user = getpwuid($uid);
        if(!defined $user) {
            ERROR "getpwuid of $uid failed ($!)";
            return undef;
        }
    }

    my @pwent = getpwnam($user);

    if(! defined $pwent[0]) {
        ERROR "getpwnam of $user failed ($!)";
        return undef;
    }

    my $home = $pwent[7];

    return File::Spec->catfile($home, ".ssh");
}

###########################################
sub path_locate {
###########################################
    my($self, $user) = @_;

    my $ssh_dir = $self->ssh_dir($user);

    return undef if !defined $ssh_dir;

    return File::Spec->catfile($ssh_dir, "authorized_keys");
}

1;

__END__