X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=lib%2FCGI%2FEx%2FAuth.pm;h=33e2a30e03454a1ad97df80b45f0237fd054481e;hp=d7056e21dce85be27103c6c9b3f07f10530f3f30;hb=490b94ab4051adf93abf16a4ed34efb923d6e8fc;hpb=aa030874456c91d688e6c9b25e82d2bf9575ea6f diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm index d7056e2..33e2a30 100644 --- a/lib/CGI/Ex/Auth.pm +++ b/lib/CGI/Ex/Auth.pm @@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64); use Digest::MD5 qw(md5_hex); use CGI::Ex; -$VERSION = '2.14'; +$VERSION = '2.22'; ###----------------------------------------------------------------### @@ -31,6 +31,7 @@ sub new { 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") { @@ -39,39 +40,57 @@ sub get_valid_auth { 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; + my $form = $self->form; ### allow for logout - if ($form->{$key_l}) { - $self->delete_cookie({key => $key_c});; - $self->location_bounce($self->logout_redirect); - eval { die "Logging out" }; - return; + 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], + ### 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}; - $had_form_info ++ if $is_form; + 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; + next if ! length $hash->{$key}; - ### if it looks like a bare username (as in they didn't have javascript)- add in other items + ### 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|^[^/]+/| + 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; @@ -82,50 +101,89 @@ sub get_valid_auth { } ### generate a fresh cookie if they submitted info on plaintext types - if ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt')) { + if ($is_form + && ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt'))) { $self->set_cookie({ - key => $key_c, + 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 => $key_c, + key => $self->key_cookie, val => $self->generate_token($data), no_expires => 0, }); } ### successful login + return $self->handle_success({is_form => $is_form}); + } - ### bounce to redirect - if (my $redirect = $form->{ $self->key_redirect }) { - $self->location_bounce($redirect); - eval { die "Success login - bouncing to redirect" }; - return; + 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; - ### if they have cookies we are done - } elsif ($has_cookies || $self->no_cookie_verify) { - return $self; + ### bounce to redirect + if (my $redirect = $form->{ $self->key_redirect }) { + $self->location_bounce($redirect); + eval { die "Success login - bouncing to redirect" }; + return; - ### 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" : ""); + ### if they have cookies we are done + } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) { + $self->success_hook; + return $self; - $self->location_bounce($url); - eval { die "Success login - bouncing to test cookie" }; - return; - } + ### 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 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 - $self->delete_cookie({key => $key_c}) if $cookies->{$key_c}; + my $key_c = $self->key_cookie; + $self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c}; - ### nothing found - see if they have cookies + ### 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; @@ -135,22 +193,37 @@ sub get_valid_auth { ### 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 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" } @@ -161,25 +234,26 @@ 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; + return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'}; my $key = $args->{'key'}; $self->cgix->set_cookie({ -name => $key, @@ -193,6 +267,7 @@ sub delete_cookie { 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({ @@ -207,6 +282,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 +298,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 +309,12 @@ 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 disable_simple_cram { shift->{'disable_simple_cram'} } 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 { @@ -291,8 +371,7 @@ 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; - $data = {} if ! defined $data; + my $data = $self->last_auth_data || {}; return { %$form, @@ -303,21 +382,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, }; } @@ -326,53 +404,28 @@ 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}); + 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') ? 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; - } + } 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; } - 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 return $data; } } - ### verify the user and get the pass - my $pass; + ### verify the user if (! defined($data->{'user'})) { $data->error('Missing user'); @@ -382,7 +435,12 @@ sub verify_token { } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) { $data->error('Invalid user'); - } elsif (! defined($pass = eval { $self->get_pass_by_user($data->{'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') { @@ -394,81 +452,140 @@ sub verify_token { $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(@_); +} - ### store - to allow generate_token to not need to relookup the pass - $data->add_data({real_pass => $pass}); +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) { - $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-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-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'; } ### 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'); + $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 = $data->{'real_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($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'} } @@ -487,7 +604,7 @@ sub generate_token { 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 + ### 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'})) @@ -498,7 +615,7 @@ sub generate_token { die "User can not contain a \"/\." if $user =~ m|/|; my $array; - if (! $data->{'prefer_cram'} + if (! $data->{'prefer_simple_cram'} && ($array = eval { $self->secure_hash_keys }) && @$array) { my $rand1 = int(rand @$array); @@ -507,6 +624,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; @@ -526,6 +644,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'} : ''; } @@ -558,10 +679,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; } @@ -625,9 +745,8 @@ sub login_form { return shift->{'login_form'} || q {
[% error %] -
+ - @@ -639,14 +758,16 @@ sub login_form { + [% IF ! hide_save ~%] + [%~ END %] @@ -655,13 +776,20 @@ sub login_form { }; } -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 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 %] + my $self = shift; + return $self->{'login_script'} if $self->{'login_script'}; + return '' if $self->use_plaintext || $self->disable_simple_cram; + return q { + + +
- [% END ~%] }; } @@ -768,7 +896,7 @@ CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins. Auth us 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 @@ -796,11 +924,11 @@ 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 => \"
", + login_header => \"

My Login

", }); The following methods will look for properties of the same name. Each of these will be -defined separately. +described separately. cgix cleanup_user @@ -814,17 +942,23 @@ defined separately. key_expires_min key_logout key_pass - key_payload key_redirect key_save key_time key_user key_verify + key_loggedout + bounce_on_logout login_footer login_form login_header login_script login_template + handle_success + handle_failure + success_hook + failure_hook + logout_hook no_cookie_verify path_info script_name @@ -834,6 +968,8 @@ defined separately. text_user text_pass text_save + text_submit + hide_save use_base64 use_blowfish use_crypt @@ -865,9 +1001,10 @@ Possible arguments are: types. payload - a payload that will be passed to generate_payload and then will be added to cram type tokens. It cannot contain a /. - prefer_cram - If the secure_hash_keys method returns keys, and it is a non-plaintext + prefer_simple_cram + - If the secure_hash_keys method returns keys, and it is a non-plaintext token, generate_token will create a secure_hash_cram. Set - this value to true to tell it to use a normal cram. This + this value to true to tell it to use a simple_cram. This is generally only useful in testing. The following are types of tokens that can be generated by generate_token. Each type includes @@ -892,7 +1029,7 @@ pseudocode and a sample of a generated that token. of the password but the get_pass_by_user hook returns the crypt'ed password, the token will not be able to be verified. - cram: + simple_cram: user := "paul" real_pass := "123qwe" server_time := 1148512991 # a time in seconds since epoch @@ -950,6 +1087,12 @@ new object using the passed arguments, and then run get_valid_auth. CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit; +=item C + +Runs get_valid_auth with login_print and location_bounce set to do nothing. +This allows for obtaining login data without forcing an html login +page to appear. + =item C Called if login errored. Defaults to printing a very basic (but @@ -971,21 +1114,30 @@ Passed to the template swapped during login_print. key_pass # $self->key_pass, # the password fieldname key_time # $self->key_time, # the server time field name key_save # $self->key_save, # the save password checkbox field name - key_payload # $self->key_payload, # the payload fieldname key_redirect # $self->key_redirect, # the redirect fieldname form_name # $self->form_name, # the name of the form script_name # $self->script_name, # where the server will post back to path_info # $self->path_info, # $ENV{PATH_INFO} if any md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming - use_plaintext # $self->use_plaintext, # used to avoid cramming $self->key_user # $data->{'user'}, # the username (if any) $self->key_pass # '', # intentional blankout $self->key_time # $self->server_time, # the server's time - $self->key_payload # $data->{'payload'} # the payload (if any) $self->key_expires_min # $self->expires_min # how many minutes crams are valid text_user # $self->text_user # template text Username: text_pass # $self->text_pass # template text Password: text_save # $self->text_save # template text Save Password ? + text_submit # $self->text_submit # template text Login + hide_save # $self->hide_save # 0 + +=item C + +Default 0. If true, will location bounce to script returned by logout_redirect +passing the key key_logout. If false, will simply show the login screen. + +=item C + +Key to bounce with in the form during a logout should bounce_on_logout return true. +Default is "loggedout". =item C @@ -1050,6 +1202,11 @@ for creating tokes is listed below). It also allows for armoring the token with base64 encoding, or using blowfish encryption. A listing of creating these tokens can be found under generate_token. +=item C + +Used by verify_token to remove armor from the passed tokens and split the token into its parts. +Returns true if it was able to parse the passed token. + =item C Called by verify_token. Default is to do no modification. Allows for usernames to @@ -1089,6 +1246,24 @@ in the data object will override those in the data object. }; } +=item C + +Called by verify_token. Passed the password to check as well as the +auth data object. Should return true if the password matches. +Default method can handle md5, crypt, cram, secure_hash_cram, and +plaintext (all of the default types supported by generate_token). If +a property named verify_password exists, it will be used and called as +a coderef rather than using the default method. + +=item C + +Called by verify_token. Passed the password to check as well as the +auth data object. Should return true if the payload is valid. +Default method returns true without performing any checks on the +payload. If a property named verify_password exists, it will be used +and called as a coderef rather than using the default method. + + =item C Returns a CGI::Ex object. @@ -1149,10 +1324,26 @@ The text items shown in the default login template. The default values are: text_pass "Password:" text_save "Save Password ?" +=item C + +Disables simple cram type from being an available type. Default is +false. If set, then one of use_plaintext, use_crypt, or +secure_hash_keys should be set. Setting this option allows for +payloads to be generated by the server only - otherwise a user who +understands the algorithm could generate a valid simple_cram cookie +with a custom payload. + +Another option would be to only accept payloads from tokens if use_blowfish +is set and armor was equal to "blowfish." + =back +=head1 LICENSE + +This module may be distributed under the same terms as Perl itself. + =head1 AUTHORS -Paul Seamons +Paul Seamons =cut