Data-Passphrase/lib/Data/Passphrase/Apache.pm
# $Id: Apache.pm,v 1.5 2007/08/14 15:45:51 ajk Exp $
use strict;
use warnings;
package Data::Passphrase::Apache; {
use Readonly;
Readonly our $CONFIG_DEBUG => 'PassphraseDebug';
Readonly our $CONFIG_LOCATION => 'PassphraseLocation';
Readonly our $CONFIG_RULES_FILE => 'PassphraseRulesFile';
Readonly our $CONFIG_WSDL_NS => 'PassphraseWsdlNamespace';
Readonly my $ERROR_PREFIX => 'Data::Passphrase';
Readonly my $POST_MAX => 1024;
Readonly my %URI_MAP => (
'' => \&dispatch_http,
form => \&dispatch_form,
http => \&dispatch_http,
soap => \&dispatch_soap,
wsdl => \&dispatch_wsdl,
);
use Data::Passphrase qw(validate_passphrase);
use Data::Passphrase::Ruleset;
use HTML::Entities;
use HTTP::Status;
use LWP::UserAgent;
use mod_perl;
# load mod_perl modules based on version
my $IS_MOD_PERL_2;
BEGIN {
$IS_MOD_PERL_2 = exists $ENV{MOD_PERL_API_VERSION}
&& $ENV{MOD_PERL_API_VERSION} >= 2;
if ($IS_MOD_PERL_2) {
require Apache2::RequestRec;
require Apache2::RequestUtil;
require Apache2::Response;
if ($ENV{MOD_PERL}) {
require Apache2::Request;
}
}
else {
require Apache;
if ($ENV{MOD_PERL}) {
require Apache::Request;
}
}
}
# export utility routines and configuration directive names
BEGIN {
our %EXPORT_TAGS = (
config => [qw(
$CONFIG_DEBUG $CONFIG_LOCATION $CONFIG_RULES_FILE
$CONFIG_WSDL_NS
)],
);
$EXPORT_TAGS{all} = $EXPORT_TAGS{config};
Exporter::export_ok_tags('all');
}
# handle all requests and dispatch to other functions based on path
sub handler {
my ($r) = @_;
# object attributes to pass through the dispatch routine
my %apv;
# get configuration values
my $config = $r->dir_config();
my $debug = $config->get($CONFIG_DEBUG);
my $rules_file = $config->get($CONFIG_RULES_FILE);
# get ruleset
if (defined $rules_file) {
$apv{ruleset}
= Data::Passphrase::Ruleset->new(file => $rules_file);
}
# extract some commonly used query parameters
my $apreq_class
= $IS_MOD_PERL_2 ? 'Apache2::Request' : 'Apache::Request';
my $apreq = $apreq_class->new(
$r,
DISABLE_UPLOADS => 1,
POST_MAX => $POST_MAX,
);
$apv{passphrase} = $apreq->param('passphrase');
$apv{username } = $apreq->param('username' ) || $r->user();
# decide what to provide based on path info
my $status = RC_NOT_FOUND;
(my $path = $r->path_info()) =~ s{^/}{};
$debug and warn "path info: $path";
if (exists $URI_MAP{$path}) {
$status = eval {
$URI_MAP{$path}->({
apv_ref => \%apv,
apreq => $apreq,
config => $config,
debug => $debug,
r => $r,
});
};
}
# unknown path specified
else {
return RC_NOT_FOUND;
}
# error calling dispatch method
if ($@) {
warn;
return RC_INTERNAL_SERVER_ERROR;
}
return $status;
}
sub dispatch_http {
my ($arg_ref) = @_;
my $response = validate_passphrase {
%{$arg_ref->{apv_ref}},
debug => $arg_ref->{debug},
};
# set the response code, message, and a custom document with the score
my $code = $response->{code };
my $message = $response->{message};
my $score = $response->{score };
my $r = $arg_ref->{r};
$r->status_line("$code $message");
# send header
$r->content_type("text/plain");
# send JSON document with score and other results
$r->send_http_header();
$r->print(<<"END");
{
"code": $code,
"message": "$message",
"score": $score
}
END
return 0;
}
# trivial form handler
sub dispatch_form {
my ($arg_ref) = @_;
# unpack arguments
my $debug = $arg_ref->{debug};
my $passphrase = $arg_ref->{apv_ref}{passphrase};
my $username = $arg_ref->{apv_ref}{username };
# if a passphrase is supplied, validate it
my ($code, $message, $score);
if (defined $passphrase) {
$debug and warn 'validating supplied passphrase';
# special case for localhost: call subroutine directly
my $location = $arg_ref->{config}->get($CONFIG_LOCATION);
if (!defined $location || $location eq 'localhost') {
my $response = validate_passphrase {
%{$arg_ref->{apv_ref}},
debug => $arg_ref->{debug},
};
$code = $response->{code };
$message = $response->{message};
$score = $response->{score };
}
# if location is remote, do an HTTP request
else {
$debug and warn "making request to $location";
my $user_agent = LWP::UserAgent->new();
my $response = $user_agent->post(
$location,
passphrase => $passphrase,
username => $username ,
);
$code = $response->code ();
$message = $response->message();
$score = $response->score ();
}
$debug and warn "response: $code $message, score: $score\%";
}
$debug and warn 'printing form';
# print header
my $r = $arg_ref->{r};
$r->content_type("text/html");
if (!$IS_MOD_PERL_2) {
$r->send_http_header();
}
print <<"END";
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head><title>Validate Passphrase</title></head>
<body>
END
# print validation message if validation occurred
if (defined $message) {
print '<p><strong>Passphrase ', encode_entities($message),
"score: $score\%</strong></p>";
}
# print footer
print <<"END";
<form method="post">
<input name="passphrase" size="127" type="password" />
<input type="submit" value="Check Strength" />
</form>
</body>
</html>
END
return 0;
}
sub dispatch_soap {
my ($arg_ref) = @_;
# only allow passphrase & username attributes to be accessed from soap
my $apreq = $arg_ref->{apreq};
my $table = $apreq->param();
$table->clear();
if (exists $arg_ref->{passphrase}) {
$table->set(passphrase => $arg_ref->{passphrase});
}
if (exists $arg_ref->{username}) {
$table->set(username => $arg_ref->{username});
}
require SOAP::Transport::HTTP;
return SOAP::Transport::HTTP::Apache
->dispatch_to(__PACKAGE__ . '::validate_passphrase')
->handle(@_);
}
sub dispatch_wsdl {
my ($arg_ref) = @_;
# unpack arguments
my $config = $arg_ref->{config};
# determine WSDL namespace
my $wsdl_namespace = $config->get($CONFIG_WSDL_NS);
if (!defined $wsdl_namespace) {
(my $path = __PACKAGE__) =~ s{::}{/}g;
my $r = $arg_ref->{r};
my $hostname = $r->hostname();
(my $uri = $r->uri()) =~ s{/$}{};
$wsdl_namespace = "http://$hostname$uri/$path";
}
require Pod::WSDL;
$arg_ref->{r}->content_type("text/xml");
print Pod::WSDL->new(
source => __PACKAGE__,
location => $wsdl_namespace,
)->WSDL;
return 0;
}
}
1;
__END__
=head1 NAME
Data::Passphrase::Apache - HTTP service for checking passphrase strength
=head1 SYNOPSIS
In F<httpd.conf>:
<Location />
Require valid-user
SSLRequireSSL
PerlHandler +Data::Passphrase::Apache
SetHandler perl-script
# turn on debugging (default: 0)
PerlSetVar PassphraseDebug 1
# use a remote service for form_handler (default: localhost)
PerlSetVar PassphraseLocation \
"https://example.com/passphrase/validate"
# set location of rules file (default: /etc/passphrase_rules)
PerlSetVar PassphraseRules \
/usr/local/etc/passphrase_rules
</Location>
HTTP client:
use constant LOCATION => 'https://itso.iu.edu/validate/http';
use LWP::UserAgent;
my $username = $ENV{LOGNAME};
for (;;) {
print 'Passphrase (clear): ';
chomp (my $passphrase = <STDIN>);
my $user_agent = LWP::UserAgent->new();
my $response = $user_agent->post(LOCATION, {
passphrase => $passphrase,
username => $username,
});
$code = $response->code ();
$message = $response->message();
$score = $response->score ();
print "$code $message, score: $score\%\n";
}
SOAP client:
use SOAP::Lite +autodispatch =>
proxy => 'http://itso.iu.edu/validate/soap',
uri => 'http://passphrase.iu.edu/Data/Passphrase';
my $username = $ENV{LOGNAME};
for (;;) {
print 'Passphrase (clear): ';
chomp (my $passphrase = <STDIN>);
my $response = SOAP::Lite
->uri('http://passphrase.iu.edu/Data/Passphrase')
->proxy('http://itso.iu.edu/validate/soap')
->validate_passphrase({
username => $username,
passphrase => $passphrase,
})->result()
or die $!;
print "$result->{code} $result->{message}, score: $result->{score}\%\n";
}
=head1 DESCRIPTION
This mod_perl module provides HTTP and SOAP interfaces to
L<Data::Passphrase|Data::Passphrase>. A trivial form handler is also
included, mostly as an example. By default, the various interfaces
are accessible by the following URIs:
Interface URI
--------- ---
HTTP https://example.com/http
SOAP https://example.com/soap
WSDL https://example.com/wsdl
form example https://example.com/form
=head2 HTTP Interface
An application or user may submit the passphrase to be checked via the
query parameter C<passphrase>. The module also supports a C<username>
parameter, which defaults to $r->user(). Sites may wish to configure
rules to check passphrases based on user-related data, so the
C<username> parameter may be useful for testing.
The response consists of an HTTP response code and status message in
the header, and a JSON representation of the code, message, and score
in the body. If a passphrase is deemed to weak via a certain rule,
the error code associated with that rule is returned. Usually, these
error codes are in the 4xx range. If a passphrase passes all rules,
200 is returned.
This module supports GET and POST request methods, but POST is usually
appropriate to avoid passphrases being recorded in server logs.
RESTful URLs are not used for the same reason.
=head2 SOAP Interface
SOAP semantics are provided by L<SOAP::Lite|SOAP::Lite> with a
corresponding WSDL provided by L<Pod::WSDL|Pod::WSDL>. This interface
exposes only the
L<validate_passphrase()|Data::Passphrase/validate_passphrase()>
procedural method; there is no object-oriented RPC functionality.
=head2 Form Example
The form handler is just a trivial example for use in testing or as a
starting point.
=head1 AUTHOR
Andrew J. Korty <ajk@iu.edu>
=head1 SEE ALSO
Data::Passphrase(3), Pod::WSDL(3), SOAP::Lite(3)