#!/usr/bin/perl

# $Id: passphrase-test,v 1.9 2007/01/30 20:09:03 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,
});

# build test plan
my @test_plan = ();
my $number_of_tests = 0;
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, get the code/message from there
            my ($code, $message);
            if (ref $phrase_data) {
                $code    = exists $phrase_data->{code   }
                         ?        $phrase_data->{code   } : $rule_code   ;
                $message = exists $phrase_data->{message}
                         ?        $phrase_data->{message} : $rule_message;
            }

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

            {
                code    => $code,
                message => $message,
                phrase  => $_,
            };
        } 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;
    $number_of_tests += scalar @tests;
}

plan tests => $number_of_tests;

# evaluate each rule in turn
foreach my $test (@test_plan) {

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

    # special case for localhost: call subroutine directly
    my ($code, $message);
    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();
    }

    # if location is remote, do an HTTP request
    else {

        # 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();
    }

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

__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)
