=cut
###----------------------------------------------------------------###
-# Copyright 2007 - Paul Seamons #
+# Copyright 2004-2012 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use CGI::Ex;
use Carp qw(croak);
-$VERSION = '2.27';
+$VERSION = '2.37';
###----------------------------------------------------------------###
$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 || $user ne $data->{'user'}) { # but the cookie didn't match
+ 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'};
}
# make sure the cookie is gone
my $key_c = $self->key_cookie;
- $self->delete_cookie({name => $key_c}) if $self->cookies->{$key_c};
+ $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}) {
my $args = shift;
return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
local $args->{'value'} = '';
- local $args->{'expires'} = '-10y' if ! $self->use_session_cookie($args->{'name'}, '');
+ 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'}};
}
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,
-path => $args->{'path'} || $self->cookie_path($key, $val) || '/',
($dom ? (-domain => $dom) : ()),
+ ($sec ? (-secure => $sec) : ()),
($args->{'expires'} ? (-expires => $args->{'expires'}): ()),
});
$self->cookies->{$key} = $val;
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, $user) = @_;
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{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
- return 1;
}
sub login_print {
my $bkey;
for my $armor ('none', 'base64', 'blowfish') {
my $copy = ($armor eq 'none') ? $token
- : ($armor eq 'base64') ? eval { local $^W; decode_base64($token) }
+ : ($armor eq 'base64') ? $self->use_base64 ? eval { local $^W; decode_base64($token) } : next
: ($bkey = $self->use_blowfish) ? decrypt_blowfish($token, $bkey)
: next;
- if ($copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\.\d+\.\d+))? $|x) {
+ 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,
} else {
my $rand1 = $1;
my $rand2 = $2;
- my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($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
} elsif ($data->{'cram_time'}) {
$data->add_data(type => 'simple_cram');
die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
- my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($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);
if ($data->{'expires_min'} > 0
$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 ($pass =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
&& crypt($data->{'test_pass'}, $1) eq $pass) {
### 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));
+ $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 = $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($pass) : md5_hex($pass);
$data->add_data(type => ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext => ($is_md5_t ? 0 : 1));
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')) {
my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
- $token = $data->{'user'} .'/'. $pass;
+ $token = $self->complex_plaintext ? join('/', $user, $self->server_time, $exp, $load, $pass) : "$user/$pass";
### 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_simple_cram'}
&& ($array = eval { $self->secure_hash_keys })
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;
cgix
cleanup_user
cookie_domain
+ cookie_secure
cookie_path
cookies
expires_min
projects / chaz / p5-CGI-Ex / blobdiff