#!/usr/bin/perl

# $Id: passphrase-test,v 1.10 2007/08/14 15:45:51 ajk Exp $

use strict;
use warnings;

use Data::Passphrase;
use Data::Passphrase::Ruleset;
use Getopt::Long;
use Readonly;
use Test::More;

Readonly my $DEFAULT_RULES_FILE => '/etc/passphrase_rules';

# subclass of LWP::UserAgent that grabs credentials
my $Username = $ENV{LOGNAME};
my $Password;
package MyAgent;
use base qw(LWP::UserAgent);
sub get_basic_credentials { ($Username, $Password) };
package main;

# parse command line
my ($debug, $help, $location);
my $file = $DEFAULT_RULES_FILE;
GetOptions
    'd|debug'        => \$debug,
    'f|rules-file=s' => \$file,
    'l|location=s'   => \$location,
    'h|help'         => \$help,
    ;
Getopt::Long::Configure qw(bundling);

if ($help) {
    print <<"END";
usage: $0 [-dl]
usage: $0 -h
       -d  enable debugging messages when using a local service
       -f  specify a rules file other than $DEFAULT_RULES_FILE
       -h  display this help message
       -l  location of passphrase validation service [default: localhost]
END
    exit;
}

# read in the ruleset
my $ruleset = Data::Passphrase::Ruleset->new({
    debug => $debug,
    file  => $file,
});

# build passphrase object
my $passphrase_object = Data::Passphrase->new({
    debug    => $debug,
    ruleset  => $ruleset,
    username => $Username,
});

sub build_test_plan {
    my @test_plan = ();
    foreach my $rule ( @{ $ruleset->get_rules() } ) {

        # unpack rule attributes
        my $rule_code    = $rule->get_code   ();
        my $rule_message = $rule->get_message();

        # skip disabled tests
        next if $rule->get_disabled();

        # get list of passphrases from test specification if any
        my $battery  = $rule->get_test() or next;

        # if the battery is specified as code, run it
        if (ref $battery eq 'CODE') {
            $battery = $battery->($passphrase_object);
        }

        # if a hash, each test phrase may contain distinct code/message data
        my @tests;
        if (ref $battery eq 'HASH') {
            @tests = map {
                my $phrase_data = $battery->{$_};

                # if the hash value is a hash ref, extract values
                my ($code, $message, $score);
                if (ref $phrase_data) {
                    $code    = exists $phrase_data->{code   }
                             ?        $phrase_data->{code   } : $rule_code   ;
                    $message = exists $phrase_data->{message}
                             ?        $phrase_data->{message} : $rule_message;

                    if (exists $phrase_data->{score}) {
                        $score = $phrase_data->{score};
                    }
                }

                # otherwise, assume it's the scalar message and inherit $code
                else {
                    $code    = $rule_code;
                    $message = defined $phrase_data ? $phrase_data
                                                    : $rule_message;
                }

                {
                    code    => $code,
                    message => $message,
                    phrase  => $_,
                    score   => $score,
                };
            } keys %$battery;
        }

        # if a scalar or array, it's just the test phrases
        else {
            @tests = map {
                {
                    code    => $rule->get_code   (),
                    message => $rule->get_message(),
                    phrase  => $_,
                };
            } ref $battery eq 'ARRAY' ? @$battery : $battery;
        }

        # queue up these tests and move on to the next rule
        push @test_plan, @tests;
    }

    return \@test_plan;
}

sub run_tests {
    my ($test_plan) = @_;
    foreach my $test (@$test_plan) {

        my $test_phrase = $test->{phrase};

        # special case for localhost: call subroutine directly
        my ($code, $message, $score);
        if (!defined $location || $location eq 'localhost') {
            $passphrase_object->set_passphrase($test_phrase);
            $passphrase_object->validate();
            $code    = $passphrase_object->get_code   ();
            $message = $passphrase_object->get_message();
            $score   = $passphrase_object->get_score  ();
        }

        # if location is remote, do an HTTP request
        else {
            require JSON::DWIW;

            # grab password if we haven't already
            if (!defined $Password) {
                require Term::ReadKey;
                Term::ReadKey->import();

                # get the password with no echo
                print 'password: ';
                ReadMode('noecho');
                chomp($Password = <STDIN>);
                ReadMode('restore');
                print "\n";
            }

            my $user_agent = MyAgent->new();
            my $response   = $user_agent->post($location, {
                passphrase => $test_phrase,
                username   => $Username,
            });
            $code    = $response->code   ();
            $message = $response->message();

            # get score from JSON-formatted response
            $score = JSON::DWIW->new()->from_json( $response->content() )->{score};
        }

        # check the score if one was returned
        if (exists $test->{score}) {
            is $score, $test->{score},
               "$test_phrase (message: $test->{message}, score: $test->{score})"
               or diag "     score: $score";
        }

        # else just compare codes
        else {
            is $code, $test->{code},
               join '', $test_phrase, ' (', $test->{message}, ')'
               or diag "     message: $message";
        }
    }
}

# build two test plans: one for codes/messages and one for scores
my $plan  = build_test_plan;

# submit overall test plan
plan tests => scalar @$plan;

# run the tests
run_tests $plan;

__END__

=head1 NAME

passphrase-test - test a Data::Passaphrase service

=head1 USAGE

  passphrase-test [-d] [-f FILE] [-l LOCATION]
  passphrase-test -h

=head1 OPTIONS

=over

=item -d

Enable debugging messages when using a local service.

=item -f FILE

Load strength checking rules from FILE instead of the default
specified in the script source.

=item -h

Display a brief help message.

=item -l LOCATION

Look for passphrase validation service at LOCATION.  Defaults to
C<localhost>, in which case passphrase-test will make library calls to
Data::Passphrase->validate().  If the location is a URI,
passphrase-test will make HTTP connections to the location specified.

=back

=head1 DESCRIPTION

This program tests a L<Data::Passaphrase|Data::Passaphrase> ruleset by
walking it and trying the passphrases specified.  See L<Data::Passaphrase>
to learn how test passphrases are specified in the rules file.

=head1 AUTHOR

Andrew J. Korty <ajk@iu.edu>

=head1 SEE ALSO

Data::Passaphrase(3), Test::More(3)
