File Coverage

blib/lib/PasswordMonkey.pm

Criterion	Covered	Total	%
statement	121	136	88.9
branch	30	48	62.5
condition	3	6	50.0
subroutine	16	16	100.0
pod	4	5	80.0
total	174	211	82.4

###########################################
package PasswordMonkey;
###########################################
use strict;
use warnings;
use Expect qw(exp_continue);
use Log::Log4perl qw(:easy);
use Module::Pluggable require => 1;

our $VERSION = "0.09";
our $PACKAGE = __PACKAGE__;

our $PASSWORD_MONKEY_OK      = 1;
our $PASSWORD_MONKEY_TIMEOUT = 2;

__PACKAGE__->make_accessor( $_ ) for qw(
expect
fills
is_success
timed_out
exit_status
);

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

    my $self = {
        expect        => Expect->new(),
        timeout       => 60,
        fillers       => [],
        filler_report => [],
        %options,
    };

    bless $self, $class;
}

###########################################
sub filler_add {
###########################################
    my($self, $filler) = @_;

    if( ! defined ref $filler or
        ! ref($filler) =~ /^$PACKAGE/ ) {
        LOGDIE "filler_add expects a filler object";
    }

    push @{ $self->{fillers} }, $filler;
}

###########################################
sub spawn {
###########################################
    my($self, $command, @parameters) = @_;

    DEBUG "Spawning $command @parameters";

    $self->{expect}->spawn($command, @parameters)
        or die "Cannot spawn $command: $!\n";
}

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

    DEBUG "Monkey starts";

    my @regex_callbacks = ();

    $self->{fills}      = 0;
    $self->{is_success} = 1;
    $self->{timed_out}  = 0;
    $self->{eof}        = 0;

    for my $filler ( @{ $self->{ fillers } } ) {
        $filler->init();
        push @regex_callbacks, [
                $filler->prompt(),
                sub {
                    DEBUG "Running filler '", $filler->name(), "'";
                    for my $bouncer ( $filler->bouncers() ) {
                          # configure the bouncer object with
                          # the expect engine
                        $bouncer->init();
                        DEBUG "Running bouncer '", $bouncer->name(), "'\n";
                        $bouncer->expect( $self->{expect} );
                        if( $bouncer->check() ) {
                            DEBUG "Bouncer [", $bouncer->name(),
                                  "] check succeeded";
                        } else {
                            ERROR "Bouncer [", $bouncer->name(),
                                  "] check failed";
                              # continue without filling
                            return exp_continue;
                        }
                    }
                    $filler->pre_fill( @_ );
                    $filler->fill( @_ );
                    $filler->post_fill( @_ );

                    # reporting
                    push @{ $self->{filler_report} },
                         [ $self->expect->match, $filler->password ];

                    $self->{fills}++;
                    return exp_continue;
                }, $self];

       for my $dealbreaker ( @{ $filler->dealbreakers() } ) {
           my($pattern, $exit_code) = @$dealbreaker;
           push @regex_callbacks,
                [ $pattern, sub {
                    DEBUG "Encountered dealbreaker [$pattern], exiting";
                    $self->{exit_status} = ($exit_code << 8);
                    $self->{is_success}  = 0;
                    # no exp_continue
                }];
       }
    }

    push @regex_callbacks,
      [ "eof" => sub {
            DEBUG "Received 'eof'.";
            $self->{eof} = 1;
            return 0;
        }, $self
      ],
      [ "timeout" => sub {
            ERROR "Received 'timeout'.";
            $self->{ is_success } = 0;
            $self->{ timed_out }  = 1;
            return 0;
        }, $self
      ],
      ;

    my @expect_return =
      $self->{expect}->expect( $self->{timeout}, @regex_callbacks );

    for ( qw(matched_pattern_position
             error
             successfully_matching_string
             before_match
             after_match) ) {
        $self->{expect_return}->{$_} = shift @expect_return;
    }

      # Expect.pm sets the exit status *after* calling the 'eof' hook
      # defined above, so we need to do some post processing here.
    if( $self->{eof} ) {
        $self->{exit_status} = $self->{expect}->exitstatus();
        if( defined $self->{exit_status} ) {
            DEBUG "Exit status is $self->{exit_status}";
        } else {
            DEBUG "Exit status undefined";
        }
        if( !defined $self->{exit_status} or
            $self->{exit_status} != 0 ) {
            $self->{ is_success } = 0;
        }
    }

    DEBUG "Monkey stops (success=$self->{is_success})";
    return $self->{is_success};
}

##################################################
# Poor man's Class::Struct
##################################################
sub make_accessor {
##################################################
    my($package, $name) = @_;

    no strict qw(refs);

    my $code = <
        *{"$package\\::$name"} = sub {
            my(\$self, \$value) = \@_;

            if(defined \$value) {
                \$self->{$name} = \$value;
            }
            if(exists \$self->{$name}) {
                return (\$self->{$name});
            } else {
                return "";
            }
        }
EOT
    if(! defined *{"$package\::$name"}) {
        eval $code or die "$@";
    }
}

1;

__END__