package CGI::Ex::Auth;
=head1 NAME
CGI::Ex::Auth - Handle logins nicely.
=cut
###----------------------------------------------------------------###
# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use strict;
use vars qw($VERSION);
use MIME::Base64 qw(encode_base64 decode_base64);
use Digest::MD5 qw(md5_hex);
use CGI::Ex;
$VERSION = '2.20';
###----------------------------------------------------------------###
sub new {
my $class = shift || __PACKAGE__;
my $args = shift || {};
return bless {%$args}, $class;
}
sub get_valid_auth {
my $self = shift;
$self = $self->new(@_) if ! ref $self;
delete $self->{'_last_auth_data'};
### shortcut that will print a js file as needed (such as the md5.js)
if ($self->script_name . $self->path_info eq $self->js_uri_path . "/CGI/Ex/md5.js") {
$self->cgix->print_js('CGI/Ex/md5.js');
eval { die "Printed Javascript" };
return;
}
my $form = $self->form;
### allow for logout
if ($form->{$self->key_logout} && ! $self->{'_logout_looking_for_user'}) {
local $self->{'_logout_looking_for_user'} = 1;
local $self->{'no_set_cookie'} = 1;
local $self->{'no_cookie_verify'} = 1;
$self->check_valid_auth; # verify the logout so we can capture the username if possible
if ($self->bounce_on_logout) {
my $key_c = $self->key_cookie;
$self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c};
my $user = $self->last_auth_data ? $self->last_auth_data->{'user'} : undef;
$self->location_bounce($self->logout_redirect(defined($user) ? $user : ''));
eval { die "Logging out" };
return;
} else {
$self->form({});
$self->handle_failure;
return;
}
}
### look first in form, then in cookies for valid tokens
my $had_form_data;
foreach ([$form, $self->key_user, 1],
[$self->cookies, $self->key_cookie, 0],
) {
my ($hash, $key, $is_form) = @$_;
next if ! defined $hash->{$key};
last if ! $is_form && $had_form_data; # if form info was passed in - we must use it only
$had_form_data = 1 if $is_form;
### if it looks like a bare username (as in they didn't have javascript) - add in other items
my $data;
if ($is_form && delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
my $key_u = $self->key_user;
$self->new_auth_data({user => delete($form->{$key_u})});
$had_form_data = 0;
next;
} elsif ($is_form
&& $hash->{$key} !~ m|^[^/]+/| # looks like a cram token
&& defined $hash->{ $self->key_pass }) {
$data = $self->verify_token({
token => {
user => delete $hash->{$key},
test_pass => delete $hash->{ $self->key_pass },
expires_min => delete($hash->{ $self->key_save }) ? -1 : delete($hash->{ $self->key_expires_min }) || $self->expires_min,
payload => delete $hash->{ $self->key_payload } || '',
},
from => 'form',
}) || next;
} else {
$data = $self->verify_token({token => $hash->{$key}, from => ($is_form ? 'form' : 'cookie')}) || next;
delete $hash->{$key} if $is_form;
}
### generate a fresh cookie if they submitted info on plaintext types
if ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt')) {
$self->set_cookie({
key => $self->key_cookie,
val => $self->generate_token($data),
no_expires => ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving
}) if $is_form; # only set the cookie if we found info in the form - the cookie will be a session cookie after that
### always generate a cookie on types that have expiration
} else {
$self->set_cookie({
key => $self->key_cookie,
val => $self->generate_token($data),
no_expires => 0,
});
}
### successful login
return $self->handle_success({is_form => $is_form});
}
return $self->handle_failure({had_form_data => $had_form_data});
}
sub handle_success {
my $self = shift;
my $args = shift || {};
if (my $meth = $self->{'handle_success'}) {
return $meth->($self, $args);
}
my $form = $self->form;
### bounce to redirect
if (my $redirect = $form->{ $self->key_redirect }) {
$self->location_bounce($redirect);
eval { die "Success login - bouncing to redirect" };
return;
### if they have cookies we are done
} elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
$self->success_hook;
return $self;
### need to verify cookies are set-able
} elsif ($args->{'is_form'}) {
$form->{$self->key_verify} = $self->server_time;
my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
$self->location_bounce($url);
eval { die "Success login - bouncing to test cookie" };
return;
}
}
sub success_hook {
my $self = shift;
if (my $meth = $self->{'success_hook'}) {
return $meth->($self);
}
return;
}
sub handle_failure {
my $self = shift;
my $args = shift || {};
if (my $meth = $self->{'handle_failure'}) {
return $meth->($self, $args);
}
my $form = $self->form;
### make sure the cookie is gone
my $key_c = $self->key_cookie;
$self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c};
### no valid login and we are checking for cookies - see if they have cookies
if (my $value = delete $form->{$self->key_verify}) {
if (abs(time() - $value) < 15) {
$self->no_cookies_print;
return;
}
}
### oh - you're still here - well then - ask for login credentials
my $key_r = $self->key_redirect;
local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
$self->login_print;
my $data = $self->last_auth_data;
eval { die defined($data) ? $data : "Requesting credentials" };
### allow for a sleep to help prevent brute force
sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
$self->failure_hook;
return;
}
sub failure_hook {
my $self = shift;
if (my $meth = $self->{'failure_hook'}) {
return $meth->($self);
}
return;
}
sub check_valid_auth {
my $self = shift;
$self = $self->new(@_) if ! ref $self;
local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
local $self->{'login_print'} = sub {}; # check only - don't login if not
local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
return $self->get_valid_auth;
}
###----------------------------------------------------------------###
sub script_name { shift->{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
sub path_info { shift->{'path_info'} || $ENV{'PATH_INFO'} || '' }
sub server_time { time }
sub cgix {
my $self = shift;
$self->{'cgix'} = shift if @_ == 1;
return $self->{'cgix'} ||= CGI::Ex->new;
}
sub form {
my $self = shift;
$self->{'form'} = shift if @_ == 1;
return $self->{'form'} ||= $self->cgix->get_form;
}
sub cookies {
my $self = shift;
$self->{'cookies'} = shift if @_ == 1;
return $self->{'cookies'} ||= $self->cgix->get_cookies;
}
sub delete_cookie {
my $self = shift;
my $args = shift;
return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
my $key = $args->{'key'};
$self->cgix->set_cookie({
-name => $key,
-value => '',
-expires => '-10y',
-path => '/',
});
delete $self->cookies->{$key};
}
sub set_cookie {
my $self = shift;
my $args = shift;
return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
my $key = $args->{'key'};
my $val = $args->{'val'};
$self->cgix->set_cookie({
-name => $key,
-value => $val,
($args->{'no_expires'} ? () : (-expires => '+20y')), # let the expires time take care of things for types that self expire
-path => '/',
});
$self->cookies->{$key} = $val;
}
sub location_bounce {
my $self = shift;
my $url = shift;
return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
return $self->cgix->location_bounce($url);
}
###----------------------------------------------------------------###
sub key_logout { shift->{'key_logout'} ||= 'cea_logout' }
sub key_cookie { shift->{'key_cookie'} ||= 'cea_user' }
sub key_user { shift->{'key_user'} ||= 'cea_user' }
sub key_pass { shift->{'key_pass'} ||= 'cea_pass' }
sub key_time { shift->{'key_time'} ||= 'cea_time' }
sub key_save { shift->{'key_save'} ||= 'cea_save' }
sub key_expires_min { shift->{'key_expires_min'} ||= 'cea_expires_min' }
sub form_name { shift->{'form_name'} ||= 'cea_form' }
sub key_verify { shift->{'key_verify'} ||= 'cea_verify' }
sub key_redirect { shift->{'key_redirect'} ||= 'cea_redirect' }
sub key_payload { shift->{'key_payload'} ||= 'cea_payload' }
sub key_loggedout { shift->{'key_loggedout'} ||= 'loggedout' }
sub bounce_on_logout { shift->{'bounce_on_logout'} ||= 0 }
sub secure_hash_keys { shift->{'secure_hash_keys'} ||= [] }
#perl -e 'use Digest::MD5 qw(md5_hex); open(my $fh, "<", "/dev/urandom"); for (1..10) { read $fh, my $t, 5_000_000; print md5_hex($t),"\n"}'
sub no_cookie_verify { shift->{'no_cookie_verify'} ||= 0 }
sub use_crypt { shift->{'use_crypt'} ||= 0 }
sub use_blowfish { shift->{'use_blowfish'} ||= '' }
sub use_plaintext { my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
sub use_base64 { my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
sub expires_min { my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
sub failed_sleep { shift->{'failed_sleep'} ||= 0 }
sub logout_redirect {
my ($self, $user) = @_;
my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
return $self->{'logout_redirect'} || $self->script_name ."?$form";
}
sub js_uri_path {
my $self = shift;
return $self->{'js_uri_path'} ||= $self->script_name ."/js";
}
###----------------------------------------------------------------###
sub no_cookies_print {
my $self = shift;
$self->cgix->print_content_type;
print qq{
You do not appear to have cookies enabled.
};
return 1;
}
sub login_print {
my $self = shift;
my $hash = $self->login_hash_common;
my $template = $self->login_template;
### allow for a hooked override
if (my $meth = $self->{'login_print'}) {
$meth->($self, $template, $hash);
return 0;
}
### process the document
require CGI::Ex::Template;
my $cet = CGI::Ex::Template->new($self->template_args);
my $out = '';
$cet->process_simple($template, $hash, \$out) || die $cet->error;
### fill in form fields
require CGI::Ex::Fill;
CGI::Ex::Fill::fill({text => \$out, form => $hash});
### print it
$self->cgix->print_content_type;
print $out;
return 0;
}
sub template_args {
my $self = shift;
return $self->{'template_args'} ||= {
INCLUDE_PATH => $self->template_include_path,
};
}
sub template_include_path { shift->{'template_include_path'} || '' }
sub login_hash_common {
my $self = shift;
my $form = $self->form;
my $data = $self->last_auth_data || {};
return {
%$form,
error => ($form->{'had_form_data'}) ? "Login Failed" : "",
login_data => $data,
key_user => $self->key_user,
key_pass => $self->key_pass,
key_time => $self->key_time,
key_save => $self->key_save,
key_expires_min => $self->key_expires_min,
key_payload => $self->key_payload,
key_redirect => $self->key_redirect,
form_name => $self->form_name,
script_name => $self->script_name,
path_info => $self->path_info,
md5_js_path => $self->js_uri_path ."/CGI/Ex/md5.js",
use_plaintext => $self->use_plaintext,
$self->key_user => $data->{'user'} || '',
$self->key_pass => '', # don't allow for this to get filled into the form
$self->key_time => $self->server_time,
$self->key_payload => $self->generate_payload({%$data, login_form => 1}),
$self->key_expires_min => $self->expires_min,
text_user => $self->text_user,
text_pass => $self->text_pass,
text_save => $self->text_save,
text_submit => $self->text_submit,
hide_save => $self->hide_save,
};
}
###----------------------------------------------------------------###
sub verify_token {
my $self = shift;
my $args = shift;
my $token = delete $args->{'token'} || die "Missing token";
my $data = $self->new_auth_data({token => $token, %$args});
my $meth;
### make sure the token is parsed to usable data
if (ref $token) { # token already parsed
$data->add_data({%$token, armor => 'none'});
} elsif (my $meth = $self->{'parse_token'}) {
if (! $meth->($self, $args)) {
$data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
return $data;
}
} else {
if (! $self->parse_token($token, $data)) {
$data->error('Invalid token') if ! $data->error; # add error if not already added
return $data;
}
}
### verify the user
if (! defined($data->{'user'})) {
$data->error('Missing user');
} elsif (! defined $data->{'test_pass'}) {
$data->error('Missing test_pass');
} elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
$data->error('Invalid user');
}
return $data if $data->error;
### get the pass
my $pass;
if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
$data->add_data({details => $@});
$data->error('Could not get pass');
} elsif (ref $pass eq 'HASH') {
my $extra = $pass;
$pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
: exists($extra->{'password'}) ? delete($extra->{'password'})
: do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
$data->error('Invalid login') if ! defined $pass && ! $data->error;
$data->add_data($extra);
}
return $data if $data->error;
$data->add_data({real_pass => $pass}); # store - to allow generate_token to not need to relookup the pass
### validate the pass
if ($meth = $self->{'verify_password'}) {
if (! $meth->($self, $pass, $data)) {
$data->error('Password failed verification') if ! $data->error;
}
} else{
if (! $self->verify_password($pass, $data)) {
$data->error('Password failed verification') if ! $data->error;
}
}
return $data if $data->error;
### validate the payload
if ($meth = $self->{'verify_payload'}) {
if (! $meth->($self, $data->{'payload'}, $data)) {
$data->error('Payload failed custom verification') if ! $data->error;
}
} else {
if (! $self->verify_payload($data->{'payload'}, $data)) {
$data->error('Payload failed verification') if ! $data->error;
}
}
return $data;
}
sub new_auth_data {
my $self = shift;
return $self->{'_last_auth_data'} = CGI::Ex::Auth::Data->new(@_);
}
sub parse_token {
my ($self, $token, $data) = @_;
my $found;
my $key;
for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
my $copy = ($armor eq 'none') ? $token
: ($armor eq 'base64') ? eval { local $^W; decode_base64($token) }
: ($key = $self->use_blowfish) ? decrypt_blowfish($token, $key)
: next;
if ($copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\.\d+\.\d+))? $|x) {
$data->add_data({
user => $1,
cram_time => $2,
expires_min => $3,
payload => $4,
test_pass => $5,
secure_hash => $6 || '',
armor => $armor,
});
$found = 1;
last;
} elsif ($copy =~ m|^ ([^/]+) / (.*) $|x) {
$data->add_data({
user => $1,
test_pass => $2,
armor => $armor,
});
$found = 1;
last;
}
}
return $found;
}
sub verify_password {
my ($self, $pass, $data) = @_;
my $err;
### looks like a secure_hash cram
if ($data->{'secure_hash'}) {
$data->add_data(type => 'secure_hash_cram');
my $array = eval {$self->secure_hash_keys };
if (! $array) {
$err = 'secure_hash_keys not found';
} elsif (! @$array) {
$err = 'secure_hash_keys empty';
} elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
$err = 'Invalid secure hash';
} else {
my $rand1 = $1;
my $rand2 = $2;
my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($pass);
my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
if ($data->{'expires_min'} > 0
&& ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
$err = 'Login expired';
} elsif (lc($data->{'test_pass'}) ne $sum) {
$err = 'Invalid login';
}
}
### looks like a normal cram
} elsif ($data->{'cram_time'}) {
$data->add_data(type => 'cram');
my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($pass);
my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
my $sum = md5_hex($str .'/'. $real);
if ($data->{'expires_min'} > 0
&& ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
$err = 'Login expired';
} elsif (lc($data->{'test_pass'}) ne $sum) {
$err = 'Invalid login';
}
### plaintext_crypt
} elsif ($pass =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
&& crypt($data->{'test_pass'}, $1) eq $pass) {
$data->add_data(type => 'crypt', was_plaintext => 1);
### failed plaintext crypt
} elsif ($self->use_crypt) {
$err = 'Invalid login';
$data->add_data(type => 'crypt', was_plaintext => ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
### plaintext and md5
} else {
my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex($data->{'test_pass'});
my $real = $is_md5_r ? lc($pass) : md5_hex($pass);
$data->add_data(type => ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext => ($is_md5_t ? 0 : 1));
$err = 'Invalid login'
if $test ne $real;
}
$data->error($err) if $err;
return ! $err;
}
sub last_auth_data { shift->{'_last_auth_data'} }
sub generate_token {
my $self = shift;
my $data = shift || $self->last_auth_data;
die "Can't generate a token off of a failed auth" if ! $data;
my $token;
### do kinds that require staying plaintext
if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
|| (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
|| (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
$token = $data->{'user'} .'/'. $pass;
### all other types go to cram - secure_hash_cram, cram, plaintext and md5
} else {
my $user = $data->{'user'} || die "Missing user";
my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'}))
: die "Missing real_pass";
my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
my $load = $self->generate_payload($data);
die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m|/|;
die "User can not contain a \"/\." if $user =~ m|/|;
my $array;
if (! $data->{'prefer_cram'}
&& ($array = eval { $self->secure_hash_keys })
&& @$array) {
my $rand1 = int(rand @$array);
my $rand2 = int(rand 100000);
my $str = join("/", $user, $self->server_time, $exp, $load);
my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
$token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
} else {
my $str = join("/", $user, $self->server_time, $exp, $load);
my $sum = md5_hex($str .'/'. $real);
$token = $str .'/'. $sum;
}
}
if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
$token = encrypt_blowfish($token, $key);
} elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
$token = encode_base64($token, '');
}
return $token;
}
sub generate_payload {
my $self = shift;
my $args = shift;
if (my $meth = $self->{'generate_payload'}) {
return $meth->($self, $args);
}
return defined($args->{'payload'}) ? $args->{'payload'} : '';
}
sub verify_user {
my $self = shift;
my $user = shift;
if (my $meth = $self->{'verify_user'}) {
return $meth->($self, $user);
}
return 1;
}
sub cleanup_user {
my $self = shift;
my $user = shift;
if (my $meth = $self->{'cleanup_user'}) {
return $meth->($self, $user);
}
return $user;
}
sub get_pass_by_user {
my $self = shift;
my $user = shift;
if (my $meth = $self->{'get_pass_by_user'}) {
return $meth->($self, $user);
}
die "Please override get_pass_by_user";
}
sub verify_payload {
my ($self, $payload, $data) = @_;
if (my $meth = $self->{'verify_payload'}) {
return $meth->($self, $payload, $data);
}
return 1;
}
###----------------------------------------------------------------###
sub encrypt_blowfish {
my ($str, $key) = @_;
require Crypt::Blowfish;
my $cb = Crypt::Blowfish->new($key);
$str .= (chr 0) x (8 - length($str) % 8); # pad to multiples of 8
my $enc = '';
$enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
return $enc;
}
sub decrypt_blowfish {
my ($enc, $key) = @_;
require Crypt::Blowfish;
my $cb = Crypt::Blowfish->new($key);
my $str = '';
$str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
$str =~ y/\00//d;
return $str
}
###----------------------------------------------------------------###
sub login_template {
my $self = shift;
return $self->{'login_template'} if $self->{'login_template'};
my $text = ""
. $self->login_header
. $self->login_form
. $self->login_script
. $self->login_footer;
return \$text;
}
sub login_header {
return shift->{'login_header'} || q {
[%~ TRY ; PROCESS 'login_header.tt' ; CATCH %][% END ~%]
};
}
sub login_footer {
return shift->{'login_footer'} || q {
[%~ TRY ; PROCESS 'login_footer.tt' ; CATCH %][% END ~%]
};
}
sub login_form {
return shift->{'login_form'} || q {
};
}
sub text_user { my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
sub text_pass { my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
sub text_save { my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
sub hide_save { my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
sub text_submit { my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
sub login_script {
return shift->{'login_script'} || q {
[%~ IF ! use_plaintext %]
[% END ~%]
};
}
###----------------------------------------------------------------###
package CGI::Ex::Auth::Data;
use strict;
use overload
'bool' => sub { ! shift->error },
'0+' => sub { 1 },
'""' => sub { shift->as_string },
fallback => 1;
sub new {
my ($class, $args) = @_;
return bless {%{ $args || {} }}, $class;
}
sub add_data {
my $self = shift;
my $args = @_ == 1 ? shift : {@_};
@{ $self }{keys %$args} = values %$args;
}
sub error {
my $self = shift;
if (@_ == 1) {
$self->{'error'} = shift;
$self->{'error_caller'} = [caller];
}
return $self->{'error'};
}
sub as_string {
my $self = shift;
return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
}
###----------------------------------------------------------------###
1;
__END__
=head1 SYNOPSIS
use CGI::Ex::Auth;
### authorize the user
my $auth = CGI::Ex::Auth->get_valid_auth({
get_pass_by_user => \&get_pass_by_user,
});
sub get_pass_by_user {
my $auth = shift;
my $user = shift;
my $pass = some_way_of_getting_password($user);
return $pass;
}
### OR - if you are using a OO based CGI or Application
sub require_authentication {
my $self = shift;
return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
get_pass_by_user => sub {
my ($auth, $user) = @_;
return $self->get_pass($user);
},
});
}
sub get_pass {
my ($self, $user) = @_;
return $self->loopup_and_cache_pass($user);
}
=head1 DESCRIPTION
CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins. Auth uses
javascript modules that perform MD5 hashing to cram the password on
the client side before passing them through the internet.
For the stored cookie you can choose to use cram mechanisms,
secure hash cram tokens, auto expiring logins (not cookie based),
and Crypt::Blowfish protection. You can also choose to keep
passwords plaintext and to use perl's crypt for testing
passwords.
A downside to this module is that it does not use a session to
preserve state so get_pass_by_user has to happen on every request (any
authenticated area has to verify authentication each time). A plus is
that you don't need to use a session if you don't want to. It is up
to the interested reader to add caching to the get_pass_by_user
method.
=head1 METHODS
=over 4
=item C
Constructor. Takes a hashref of properties as arguments.
Many of the methods which may be overridden in a subclass,
or may be passed as properties to the new constuctor such as in the following:
CGI::Ex::Auth->new({
get_pass_by_user => \&my_pass_sub,
key_user => 'my_user',
key_pass => 'my_pass',
login_template => \"