view release on metacpan or  search on metacpan

scripts/passphrase-test  view on Meta::CPAN

#!/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') {