X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FAuth.pm;h=21b82d45fe51f1e9aac701a6b4f45d8195f787d3;hb=6ab8b2e8e8388d1a238148a1ee58e124855f3768;hp=2208427b3d9d30d65befdf1f2e207f87a268eba9;hpb=3fe8e76eb82e9d74f656674c5ba913950e166ab1;p=chaz%2Fp5-CGI-Ex
diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index 2208427..21b82d4 100644
--- a/lib/CGI/Ex/Auth.pm
+++ b/lib/CGI/Ex/Auth.pm
@@ -7,7 +7,7 @@ CGI::Ex::Auth - Handle logins nicely.
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2004-2012 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
@@ -17,115 +17,175 @@ use vars qw($VERSION);
use MIME::Base64 qw(encode_base64 decode_base64);
use Digest::MD5 qw(md5_hex);
use CGI::Ex;
+use Carp qw(croak);
-$VERSION = '2.02';
+$VERSION = '2.37';
###----------------------------------------------------------------###
sub new {
- my $class = shift || __PACKAGE__;
- my $args = shift || {};
- return bless {%$args}, $class;
+ my $class = shift || croak "Usage: ".__PACKAGE__."->new";
+ my $self = ref($_[0]) ? shift() : (@_ % 2) ? {} : {@_};
+ return bless {%$self}, $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)
+ # 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;
- my $cookies = $self->cookies;
- my $key_l = $self->key_logout;
- my $key_c = $self->key_cookie;
- my $has_cookies = scalar %$cookies;
-
- ### allow for logout
- if ($form->{$key_l}) {
- $self->delete_cookie({key => $key_c});;
- $self->location_bounce($self->logout_redirect);
- eval { die "Logging out" };
- 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
+
+ $self->logout_hook;
+
+ 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;
+ }
}
- my $had_form_info;
- foreach ([$form, $self->key_user, 1],
- [$cookies, $key_c, 0],
- ) {
- my ($hash, $key, $is_form) = @$_;
- next if ! defined $hash->{$key};
- $had_form_info ++ 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
- && $hash->{$key} !~ m|^[^/]+/|
- && defined $hash->{ $self->key_pass }) {
+ my $data;
+
+ # look in form first
+ my $form_user = delete $form->{$self->key_user};
+ if (defined $form_user) {
+ if (delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
+ $data = $self->new_auth_data({user => $form_user, error => 'Logged out'});
+ } elsif (defined $form->{ $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 } || '',
+ user => $form_user,
+ test_pass => delete $form->{ $self->key_pass },
+ expires_min => delete($form->{ $self->key_save }) ? -1 : delete($form->{ $self->key_expires_min }) || undef,
},
from => 'form',
- }) || next;
-
+ });
+ } elsif (! length $form_user) {
+ $data = $self->new_auth_data({user => '', error => 'Invalid user'});
} else {
- $data = $self->verify_token({token => $hash->{$key}, from => ($is_form ? 'form' : 'cookie')}) || next;
- delete $hash->{$key} if $is_form;
+ $data = $self->verify_token({token => $form_user, from => '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 => $key_c,
- 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 => $key_c,
- val => $self->generate_token($data),
- no_expires => 0,
- });
+ # no valid form data ? look in the cookie
+ if (! ref($data) # no form
+ || ($data->error && $data->{'allow_cookie_match'})) { # had form with error - but we can check if form user matches existing cookie
+ my $cookie = $self->cookies->{$self->key_cookie};
+ if (defined($cookie) && length($cookie)) {
+ my $form_data = $data;
+ $data = $self->verify_token({token => $cookie, from => 'cookie'});
+ if (defined $form_user) { # they had form data
+ my $user = $self->cleanup_user($form_user);
+ if (! $data || !$self->check_form_user_against_cookie($user, $data->{'user'}, $data)) { # but the cookie didn't match
+ $data = $self->{'_last_auth_data'} = $form_data; # restore old form data failure
+ $data->{'user'} = $user if ! defined $data->{'user'};
+ }
+ }
}
+ }
- ### successful login
+ # failure
+ if (! $data) {
+ return $self->handle_failure({had_form_data => defined($form_user)});
+ }
- ### bounce to redirect
- if (my $redirect = $form->{ $self->key_redirect }) {
- $self->location_bounce($redirect);
- eval { die "Success login - bouncing to redirect" };
- return;
+ # success
+ my $_key = $self->key_cookie;
+ my $_val = $self->generate_token($data);
+ my $use_session = $self->use_session_cookie($_key, $_val); # default false
+ if ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt')) {
+ $use_session = 1 if ! defined($use_session) && ! defined($data->{'expires_min'});
+ }
+ $self->set_cookie({
+ name => $_key,
+ value => $_val,
+ expires => ($use_session ? '' : '+20y'), # non-cram cookie types are session cookies unless save was set (thus setting expires_min)
+ });
- ### if they have cookies we are done
- } elsif ($has_cookies || $self->no_cookie_verify) {
- return $self;
+ return $self->handle_success({is_form => ($data->{'from'} eq 'form' ? 1 : 0)});
+}
- ### need to verify cookies are set-able
- } elsif ($is_form) {
- $form->{$self->key_verify} = $self->server_time;
- my $query = $self->cgix->make_form($form);
- my $url = $self->script_name . $self->path_info . ($query ? "?$query" : "");
+sub handle_success {
+ my $self = shift;
+ my $args = shift || {};
+ if (my $meth = $self->{'handle_success'}) {
+ return $meth->($self, $args);
+ }
+ my $form = $self->form;
- $self->location_bounce($url);
- eval { die "Success login - bouncing to test cookie" };
- return;
- }
+ # 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;
}
+}
- ### make sure the cookie is gone
- $self->delete_cookie({key => $key_c}) if $cookies->{$key_c};
+sub success_hook {
+ my $self = shift;
+ if (my $meth = $self->{'success_hook'}) {
+ return $meth->($self);
+ }
+ return;
+}
- ### nothing found - see if they have cookies
+sub logout_hook {
+ my $self = shift;
+ if (my $meth = $self->{'logout_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({name => $key_c}) if exists $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;
@@ -133,27 +193,42 @@ sub get_valid_auth {
}
}
- ### oh - you're still here - well then - ask for login credentials
+ # oh - you're still here - well then - ask for login credentials
my $key_r = $self->key_redirect;
- if (! $form->{$key_r}) {
- my $query = $self->cgix->make_form($form);
- $form->{$key_r} = $self->script_name . $self->path_info . ($query ? "?$query" : "");
- }
-
- $form->{'had_form_data'} = $had_form_info;
+ 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
+ # 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 script_name { shift->{'script_name'} || $ENV{'SCRIPT_NAME'} || '' }
sub path_info { shift->{'path_info'} || $ENV{'PATH_INFO'} || '' }
@@ -161,45 +236,57 @@ sub server_time { time }
sub cgix {
my $self = shift;
- $self->{'cgix'} = shift if $#_ != -1;
+ $self->{'cgix'} = shift if @_ == 1;
return $self->{'cgix'} ||= CGI::Ex->new;
}
sub form {
my $self = shift;
- $self->{'form'} = shift if $#_ != -1;
+ $self->{'form'} = shift if @_ == 1;
return $self->{'form'} ||= $self->cgix->get_form;
}
sub cookies {
my $self = shift;
- $self->{'cookies'} = shift if $#_ != -1;
+ $self->{'cookies'} = shift if @_ == 1;
return $self->{'cookies'} ||= $self->cgix->get_cookies;
}
sub delete_cookie {
my $self = shift;
my $args = shift;
- my $key = $args->{'key'};
- $self->cgix->set_cookie({
- -name => $key,
- -value => '',
- -expires => '-10y',
- -path => '/',
- });
- delete $self->cookies->{$key};
+ return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
+ local $args->{'value'} = '';
+ local $args->{'expires'} = '-10y';
+ if (my $dom = $ENV{HTTP_HOST}) {
+ $dom =~ s/:\d+$//;
+ do {
+ local $args->{'domain'} = $dom;
+ $self->set_cookie($args);
+ local $args->{'domain'} = ".$dom";
+ $self->set_cookie($args);
+ }
+ while ($dom =~ s/^[\w\-]*\.// and $dom =~ /\./);
+ }
+ $self->set_cookie($args);
+ delete $self->cookies->{$args->{'name'}};
}
sub set_cookie {
my $self = shift;
my $args = shift;
- my $key = $args->{'key'};
- my $val = $args->{'val'};
+ return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
+ my $key = $args->{'name'};
+ my $val = $args->{'value'};
+ my $dom = $args->{'domain'} || $self->cookie_domain;
+ my $sec = $args->{'secure'} || $self->cookie_secure;
$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 => '/',
+ -path => $args->{'path'} || $self->cookie_path($key, $val) || '/',
+ ($dom ? (-domain => $dom) : ()),
+ ($sec ? (-secure => $sec) : ()),
+ ($args->{'expires'} ? (-expires => $args->{'expires'}): ()),
});
$self->cookies->{$key} = $val;
}
@@ -207,6 +294,7 @@ sub set_cookie {
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);
}
@@ -222,8 +310,10 @@ 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'} ||= '' }
@@ -231,10 +321,17 @@ sub use_plaintext { my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||
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 cookie_path { shift->{'cookie_path'} }
+sub cookie_domain { shift->{'cookie_domain'} }
+sub cookie_secure { shift->{'cookie_secure'} }
+sub use_session_cookie { shift->{'use_session_cookie'} }
+sub disable_simple_cram { shift->{'disable_simple_cram'} }
+sub complex_plaintext { shift->{'complex_plaintext'} }
sub logout_redirect {
- my $self = shift;
- return $self->{'logout_redirect'} || $self->script_name ."?loggedout=1";
+ 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 {
@@ -246,27 +343,28 @@ sub js_uri_path {
sub no_cookies_print {
my $self = shift;
+ return $self->{'no_cookies_print'}->($self) if $self->{'no_cookies_print'};
$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;
+ my $file = $self->login_template;
### allow for a hooked override
if (my $meth = $self->{'login_print'}) {
- $meth->($self, $template, $hash);
+ $meth->($self, $file, $hash);
return 0;
}
### process the document
- require CGI::Ex::Template;
- my $cet = CGI::Ex::Template->new($self->template_args);
+ my $args = $self->template_args;
+ $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_include_path,
+ my $t = $self->template_obj($args);
my $out = '';
- $cet->process_simple($template, $hash, \$out) || die $cet->error;
+ $t->process_simple($file, $hash, \$out) || die $t->error;
### fill in form fields
require CGI::Ex::Fill;
@@ -279,20 +377,23 @@ sub login_print {
return 0;
}
-sub template_args {
- my $self = shift;
- return $self->{'template_args'} ||= {
- INCLUDE_PATH => $self->template_include_path,
+sub template_obj {
+ my ($self, $args) = @_;
+ return $self->{'template_obj'} || do {
+ require Template::Alloy;
+ Template::Alloy->new($args);
};
}
-sub template_include_path { shift->{'template_include_path'} || '' }
+sub template_args { $_[0]->{'template_args'} ||= {} }
+
+sub template_include_path { $_[0]->{'template_include_path'} || '' }
sub login_hash_common {
my $self = shift;
my $form = $self->form;
my $data = $self->last_auth_data;
- $data = {} if ! defined $data;
+ $data = {no_data => 1} if ! ref $data;
return {
%$form,
@@ -303,19 +404,20 @@ sub login_hash_common {
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,
};
}
@@ -324,142 +426,210 @@ sub login_hash_common {
sub verify_token {
my $self = shift;
my $args = shift;
- my $token = delete $args->{'token'} || die "Missing token";
- my $data = $self->{'_last_auth_data'} = $self->new_auth_data({token => $token, %$args});
+ if (my $meth = $self->{'verify_token'}) {
+ return $meth->($self, $args);
+ }
+ my $token = delete $args->{'token'}; die "Missing token" if ! length $token;
+ my $data = $self->new_auth_data({token => $token, %$args});
+ my $meth;
- ### token already parsed
- if (ref $token) {
+ # make sure the token is parsed to usable data
+ if (ref $token) { # token already parsed
$data->add_data({%$token, armor => 'none'});
- ### parse token for info
- } else {
- 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') ? 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;
- }
+ } 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
+ $data->{'allow_cookie_match'} = 1;
+ return $data;
}
- if (! $found) {
- $data->error('Invalid token');
+ } else {
+ if (! $self->parse_token($token, $data)) {
+ $data->error('Invalid token') if ! $data->error; # add error if not already added
+ $data->{'allow_cookie_match'} = 1;
return $data;
}
}
- ### verify the user and get the pass
- my $pass;
+ # verify the user
if (! defined($data->{'user'})) {
$data->error('Missing user');
-
+ } elsif (! defined($data->{'user'} = $self->cleanup_user($data->{'user'}))
+ || ! length($data->{'user'})) {
+ $data->error('Missing cleaned user');
} elsif (! defined $data->{'test_pass'}) {
$data->error('Missing test_pass');
-
- } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
+ } elsif (! $self->verify_user($data->{'user'})) {
$data->error('Invalid user');
+ }
+ return $data if $data->error;
- } elsif (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
+ # 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
- ### store - to allow generate_token to not need to relookup the pass
- $data->add_data({real_pass => $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 $bkey;
+ for my $armor ('none', 'base64', 'blowfish') {
+ my $copy = ($armor eq 'none') ? $token
+ : ($armor eq 'base64') ? $self->use_base64 ? eval { local $^W; decode_base64($token) } : next
+ : ($bkey = $self->use_blowfish) ? decrypt_blowfish($token, $bkey)
+ : next;
+ if ($self->complex_plaintext && $copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / ([^/]*) / (.*) $|x) {
+ $data->add_data({
+ user => $1,
+ plain_time => $2,
+ expires_min => $3,
+ payload => $4,
+ test_pass => $5,
+ armor => $armor,
+ });
+ $found = 1;
+ last;
+ } elsif ($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) {
- $data->error('secure_hash_keys not found');
+ $err = 'secure_hash_keys not found';
} elsif (! @$array) {
- $data->error('secure_hash_keys empty');
+ $err = 'secure_hash_keys empty';
} elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
- $data->error('Invalid secure hash');
+ $err = 'Invalid secure hash';
} else {
my $rand1 = $1;
my $rand2 = $2;
- my $real = $data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'});
+ my $real = $pass =~ /^[a-fA-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) {
- $data->error('Login expired');
+ $err = 'Login expired';
} elsif (lc($data->{'test_pass'}) ne $sum) {
- $data->error('Invalid login');
+ $err = 'Invalid login';
}
}
- ### looks like a normal cram
+ ### looks like a simple_cram
} elsif ($data->{'cram_time'}) {
- $data->add_data(type => 'cram');
- my $real = $data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'});
+ $data->add_data(type => 'simple_cram');
+ die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
+ my $real = $pass =~ /^[a-fA-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) {
- $data->error('Login expired');
+ $err = 'Login expired';
} elsif (lc($data->{'test_pass'}) ne $sum) {
- $data->error('Invalid login');
+ $err = 'Invalid login';
}
+ ### expiring plain
+ } elsif ($data->{'plain_time'}
+ && $data->{'expires_min'} > 0
+ && ($self->server_time - $data->{'plain_time'}) > $data->{'expires_min'} * 60) {
+ $err = 'Login expired';
+
### plaintext_crypt
- } elsif ($data->{'real_pass'} =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
- && crypt($data->{'test_pass'}, $1) eq $data->{'real_pass'}) {
+ } 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) {
- $data->error('Invalid login');
- $data->add_data(type => 'crypt', was_plaintext => ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
+ $err = 'Invalid login';
+ $data->add_data(type => 'crypt', was_plaintext => ($data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/ ? 0 : 1));
### plaintext and md5
} else {
- my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
- my $is_md5_r = $data->{'real_pass'} =~ /^[a-f0-9]{32}$/;
+ my $is_md5_t = $data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/;
+ my $is_md5_r = $pass =~ /^[a-fA-F0-9]{32}$/;
my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex($data->{'test_pass'});
- my $real = $is_md5_r ? lc($data->{'real_pass'}) : md5_hex($data->{'real_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));
- $data->error('Invalid login')
+ $err = 'Invalid login'
if $test ne $real;
}
- ### check the payload
- if (! $data->error && ! $self->verify_payload($data->{'payload'})) {
- $data->error('Invalid payload');
- }
-
- return $data;
-}
-
-sub new_auth_data {
- my $self = shift;
- return CGI::Ex::Auth::Data->new(@_);
+ $data->error($err) if $err;
+ return ! $err;
}
sub last_auth_data { shift->{'_last_auth_data'} }
@@ -468,27 +638,28 @@ 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;
-
+ die "Can't generate a token for a user which contains a \"/\"" if $data->{'user'} =~ m{/};
my $token;
+ my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
+
+ my $user = $data->{'user'} || die "Missing user";
+ my $load = $self->generate_payload($data);
+ die "User can not contain a \"/\." if $user =~ m|/|;
+ die "Payload can not contain a \"/\. Please encode it in generate_payload." if $load =~ m|/|;
### 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')) {
- $token = $data->{'user'} .'/'. $data->{'real_pass'};
+ my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
+ $token = $self->complex_plaintext ? join('/', $user, $self->server_time, $exp, $load, $pass) : "$user/$pass";
- ### all other types go to cram - secure_hash_cram, cram, plaintext and md5
+ ### all other types go to cram - secure_hash_cram, simple_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 $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-fA-F0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'}))
+ : die "Missing real_pass";
my $array;
- if (! $data->{'prefer_cram'}
+ if (! $data->{'prefer_simple_cram'}
&& ($array = eval { $self->secure_hash_keys })
&& @$array) {
my $rand1 = int(rand @$array);
@@ -497,6 +668,7 @@ sub generate_token {
my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
$token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
} else {
+ die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
my $str = join("/", $user, $self->server_time, $exp, $load);
my $sum = md5_hex($str .'/'. $real);
$token = $str .'/'. $sum;
@@ -516,6 +688,9 @@ sub generate_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'} : '';
}
@@ -537,6 +712,12 @@ sub cleanup_user {
return $user;
}
+sub check_form_user_against_cookie {
+ my ($self, $form_user, $cookie_user, $data) = @_;
+ return if ! defined($form_user) || ! defined($cookie_user);
+ return $form_user eq $cookie_user;
+}
+
sub get_pass_by_user {
my $self = shift;
my $user = shift;
@@ -548,10 +729,9 @@ sub get_pass_by_user {
}
sub verify_payload {
- my $self = shift;
- my $payload = shift;
+ my ($self, $payload, $data) = @_;
if (my $meth = $self->{'verify_payload'}) {
- return $meth->($self, $payload);
+ return $meth->($self, $payload, $data);
}
return 1;
}
@@ -591,84 +771,85 @@ 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;
+ my $text = join '',
+ map {ref $_ ? $$_ : /\[%/ ? $_ : $_ ? "[% TRY; PROCESS '$_'; CATCH %][% END %]\n" : ''}
+ $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_header { shift->{'login_header'} || 'login_header.tt' }
+sub login_footer { shift->{'login_footer'} || 'login_footer.tt' }
sub login_form {
- return shift->{'login_form'} || q {
-
+ my $self = shift;
+ return $self->{'login_form'} if defined $self->{'login_form'};
+ return \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 q {
- [%~ IF ! use_plaintext %]
-
-
- [% END ~%]
- };
+ my $self = shift;
+ return $self->{'login_script'} if defined $self->{'login_script'};
+ return '' if $self->use_plaintext || $self->disable_simple_cram;
+ return \q{
+
+
+};
}
###----------------------------------------------------------------###
@@ -715,37 +896,70 @@ __END__
=head1 SYNOPSIS
- ### authorize the user
- my $auth = $self->get_valid_auth({
- get_pass_by_user => \&get_pass_by_user,
- });
+ 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;
- }
+ 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.
+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,
+For the stored cookie you can choose to use simple 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.
+passwords. Or you can completely replace the cookie parsing/generating
+and let Auth handle requesting, setting, and storing the cookie.
+
+A theoretical 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
+- unless the verify_token method is completely overridden). In theory
+you should be checking the password everytime a user makes a request
+to make sure the password is still valid. A definite 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.
+
+In the end, the only truly secure login method is across an https
+connection. Any connection across non-https (non-secure) is
+susceptible to cookie hijacking or tcp hijacking - though the
+possibility of this is normally small and typically requires access to
+a machine somewhere in your TCP chain. If in doubt - you should try
+to use https - but even then you need to guard the logged in area
+against cross-site javascript exploits. A discussion of all security
+issues is far beyond the scope of this documentation.
=head1 METHODS
@@ -762,14 +976,17 @@ or may be passed as properties to the new constuctor such as in the following:
get_pass_by_user => \&my_pass_sub,
key_user => 'my_user',
key_pass => 'my_pass',
- login_template => \"