CGI::Ex 2.32

[chaz/p5-CGI-Ex] / lib / CGI / Ex / Auth.pm

diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index 2dd895debd86b62410bf600898e4792b1fa41ebd..149123e13b6ecc7227d65c1f7ab72aba1c1eff24 100644 (file)
--- a/lib/CGI/Ex/Auth.pm
+++ b/lib/CGI/Ex/Auth.pm
@@ -17,15 +17,16 @@ use vars qw($VERSION);
 use MIME::Base64 qw(encode_base64 decode_base64);
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 use MIME::Base64 qw(encode_base64 decode_base64);
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;

+use Carp qw(croak);

 
 

-$VERSION = '2.21';
+$VERSION = '2.32';

 
 ###----------------------------------------------------------------###
 
 sub new {
 
 ###----------------------------------------------------------------###
 
 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 {
 }
 
 sub get_valid_auth {


@@ -33,7 +34,7 @@ sub get_valid_auth {
     $self = $self->new(@_) if ! ref $self;
     delete $self->{'_last_auth_data'};
 
     $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" };
     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" };


@@ -42,7 +43,7 @@ sub get_valid_auth {
 
     my $form = $self->form;
 
 
     my $form = $self->form;
 

-    ### allow for logout
+    # 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;
     if ($form->{$self->key_logout} && ! $self->{'_logout_looking_for_user'}) {
         local $self->{'_logout_looking_for_user'} = 1;
         local $self->{'no_set_cookie'}    = 1;


@@ -65,63 +66,65 @@ sub get_valid_auth {
         }
     }
 
         }
     }
 

-    ### 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 }) {
+    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 => {
             $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,
+                    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',
                 },
                 from => 'form',

-            }) || next;
-
+            });
+        } elsif (! length $form_user) {
+            $data = $self->new_auth_data({user => '', error => 'Invalid user'});

         } else {
         } 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 ($is_form
-            && ($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
-            });
-
-        ### 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,
-            });
+    # 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 || $user ne $data->{'user'}) { # 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'};
+                }
+            }

         }
         }

+    }
+
+    # failure
+    if (! $data) {
+        return $self->handle_failure({had_form_data => defined($form_user)});
+    }

 
 

-        ### successful login
-        return $self->handle_success({is_form => $is_form});
+    # 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)
+    });

 
 

-    return $self->handle_failure({had_form_data => $had_form_data});
+    return $self->handle_success({is_form => ($data->{'from'} eq 'form' ? 1 : 0)});

 }
 
 sub handle_success {
 }
 
 sub handle_success {


@@ -132,18 +135,18 @@ sub handle_success {
     }
     my $form = $self->form;
 
     }
     my $form = $self->form;
 

-    ### bounce to redirect
+    # bounce to redirect

     if (my $redirect = $form->{ $self->key_redirect }) {
         $self->location_bounce($redirect);
         eval { die "Success login - bouncing to redirect" };
         return;
 
     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
+    # if they have cookies we are done

     } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
         $self->success_hook;
         return $self;
 
     } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
         $self->success_hook;
         return $self;
 

-    ### need to verify cookies are set-able
+    # 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);
     } elsif ($args->{'is_form'}) {
         $form->{$self->key_verify} = $self->server_time;
         my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);


@@ -178,11 +181,11 @@ sub handle_failure {
     }
     my $form = $self->form;
 
     }
     my $form = $self->form;
 

-    ### make sure the cookie is gone
+    # make sure the cookie is gone

     my $key_c = $self->key_cookie;
     my $key_c = $self->key_cookie;

-    $self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c};
+    $self->delete_cookie({name => $key_c}) if $self->cookies->{$key_c};

 
 

-    ### no valid login and we are checking for cookies - 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;
     if (my $value = delete $form->{$self->key_verify}) {
         if (abs(time() - $value) < 15) {
             $self->no_cookies_print;


@@ -190,7 +193,7 @@ sub handle_failure {
         }
     }
 
         }
     }
 

-    ### 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;
     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;
     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;


@@ -198,7 +201,7 @@ sub handle_failure {
     my $data = $self->last_auth_data;
     eval { die defined($data) ? $data : "Requesting credentials" };
 
     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;
 
     sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
     $self->failure_hook;
 


@@ -225,7 +228,7 @@ sub check_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'} || '' }
 
 
 sub path_info { shift->{'path_info'} || $ENV{'PATH_INFO'} || '' }
 


@@ -253,27 +256,27 @@ sub delete_cookie {
     my $self = shift;
     my $args = shift;
     return $self->{'delete_cookie'}->($self, $args) if $self->{'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};
+    local $args->{'value'}   = '';
+    local $args->{'expires'} = '-10y' if ! $self->use_session_cookie($args->{'name'}, '');
+    $self->set_cookie($args);
+    delete $self->cookies->{$args->{'name'}};

 }
 
 sub set_cookie {
     my $self = shift;
     my $args = shift;
     return $self->{'set_cookie'}->($self, $args) if $self->{'set_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'};
+    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,
     $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;
 }
     });
     $self->cookies->{$key} = $val;
 }


@@ -308,7 +311,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 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 disable_simple_cram { shift->{'disable_simple_cram'} }

+sub complex_plaintext { shift->{'complex_plaintext'} }

 
 sub logout_redirect {
     my ($self, $user) = @_;
 
 sub logout_redirect {
     my ($self, $user) = @_;


@@ -333,19 +341,20 @@ sub no_cookies_print {
 sub login_print {
     my $self = shift;
     my $hash = $self->login_hash_common;
 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'}) {
 
     ### allow for a hooked override
     if (my $meth = $self->{'login_print'}) {

-        $meth->($self, $template, $hash);
+        $meth->($self, $file, $hash);

         return 0;
     }
 
     ### process the document
         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 = '';
     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;
 
     ### fill in form fields
     require CGI::Ex::Fill;


@@ -358,19 +367,23 @@ sub login_print {
     return 0;
 }
 
     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;
 
 sub login_hash_common {
     my $self = shift;
     my $form = $self->form;

-    my $data = $self->last_auth_data || {};
+    my $data = $self->last_auth_data;
+    $data = {no_data => 1} if ! ref $data;

 
     return {
         %$form,
 
     return {
         %$form,


@@ -403,41 +416,46 @@ sub login_hash_common {
 sub verify_token {
     my $self  = shift;
     my $args  = shift;
 sub verify_token {
     my $self  = shift;
     my $args  = shift;

-    my $token = delete $args->{'token'} || die "Missing token";
+    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;
 
     my $data  = $self->new_auth_data({token => $token, %$args});
     my $meth;
 

-    ### make sure the token is parsed to usable data
+    # 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
     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

+            $data->{'allow_cookie_match'} = 1;

             return $data;
         }
     } else {
         if (! $self->parse_token($token, $data)) {
             $data->error('Invalid 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

+            $data->{'allow_cookie_match'} = 1;

             return $data;
         }
     }
 
 
             return $data;
         }
     }
 
 

-    ### verify the user
+    # verify the user

     if (! defined($data->{'user'})) {
         $data->error('Missing 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 (! 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');
         $data->error('Invalid user');

-

     }
     return $data if $data->error;
 
     }
     return $data if $data->error;
 

-    ### get the pass
+    # get the pass

     my $pass;
     if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
         $data->add_data({details => $@});
     my $pass;
     if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
         $data->add_data({details => $@});


@@ -454,7 +472,7 @@ sub verify_token {
     $data->add_data({real_pass => $pass}); # store - to allow generate_token to not need to relookup the pass
 
 
     $data->add_data({real_pass => $pass}); # store - to allow generate_token to not need to relookup the pass
 
 

-    ### validate the pass
+    # validate the pass

     if ($meth = $self->{'verify_password'}) {
         if (! $meth->($self, $pass, $data)) {
             $data->error('Password failed verification') if ! $data->error;
     if ($meth = $self->{'verify_password'}) {
         if (! $meth->($self, $pass, $data)) {
             $data->error('Password failed verification') if ! $data->error;


@@ -467,7 +485,7 @@ sub verify_token {
     return $data if $data->error;
 
 
     return $data if $data->error;
 
 

-    ### validate the payload
+    # validate the payload

     if ($meth = $self->{'verify_payload'}) {
         if (! $meth->($self, $data->{'payload'}, $data)) {
             $data->error('Payload failed custom verification') if ! $data->error;
     if ($meth = $self->{'verify_payload'}) {
         if (! $meth->($self, $data->{'payload'}, $data)) {
             $data->error('Payload failed custom verification') if ! $data->error;


@@ -489,13 +507,24 @@ sub new_auth_data {
 sub parse_token {
     my ($self, $token, $data) = @_;
     my $found;
 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)
+    my $bkey;
+    for my $armor ('none', 'base64', 'blowfish') {
+        my $copy = ($armor eq 'none')       ? $token
+            : ($armor eq 'base64')          ? eval { local $^W; decode_base64($token) }
+            : ($bkey = $self->use_blowfish) ? decrypt_blowfish($token, $bkey)

             : next;
             : 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,
             $data->add_data({
                 user         => $1,
                 cram_time    => $2,


@@ -537,7 +566,7 @@ sub verify_password {
         } else {
             my $rand1 = $1;
             my $rand2 = $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
             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


@@ -552,7 +581,7 @@ sub verify_password {
     } elsif ($data->{'cram_time'}) {
         $data->add_data(type => 'simple_cram');
         die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
     } 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
         my $str  = join("/", @{$data}{qw(user cram_time expires_min payload)});
         my $sum  = md5_hex($str .'/'. $real);
         if ($data->{'expires_min'} > 0


@@ -562,6 +591,12 @@ sub verify_password {
             $err = '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 ($pass =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
              && crypt($data->{'test_pass'}, $1) eq $pass) {
     ### plaintext_crypt
     } elsif ($pass =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
              && crypt($data->{'test_pass'}, $1) eq $pass) {


@@ -570,12 +605,12 @@ sub verify_password {
     ### failed plaintext crypt
     } elsif ($self->use_crypt) {
         $err = 'Invalid login';
     ### 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 {
 
     ### 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));
         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));


@@ -593,26 +628,26 @@ 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 $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 $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'};
 
     ### 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 {
 
     ### 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 })
         my $array;
         if (! $data->{'prefer_simple_cram'}
             && ($array = eval { $self->secure_hash_keys })


@@ -720,58 +755,48 @@ sub login_template {
     my $self = shift;
     return $self->{'login_template'} if $self->{'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 %]<!-- [% error %] -->[% END %]\n" : ''}
+        $self->login_header, $self->login_form, $self->login_script, $self->login_footer;

     return \$text;
 }
 
     return \$text;
 }
 

-sub login_header {
-    return shift->{'login_header'} || q {
-    [%~ TRY ; PROCESS 'login_header.tt' ; CATCH %]<!-- [% error %] -->[% END ~%]
-    };
-}
-
-sub login_footer {
-    return shift->{'login_footer'} || q {
-    [%~ TRY ; PROCESS 'login_footer.tt' ; CATCH %]<!-- [% error %] -->[% END ~%]
-    };
-}
+sub login_header { shift->{'login_header'} || 'login_header.tt' }
+sub login_footer { shift->{'login_footer'} || 'login_footer.tt' }

 
 sub login_form {
 
 sub login_form {

-    return shift->{'login_form'} || q {
-    <div class="login_chunk">
-    <span class="login_error">[% error %]</span>
-    <form class="login_form" name="[% form_name %]" method="POST" action="[% script_name %][% path_info %]">
-    <input type="hidden" name="[% key_redirect %]" value="">
-    <input type="hidden" name="[% key_time %]" value="">
-    <input type="hidden" name="[% key_expires_min %]" value="">
-    <table class="login_table">
-    <tr class="login_username">
-      <td>[% text_user %]</td>
-      <td><input name="[% key_user %]" type="text" size="30" value=""></td>
-    </tr>
-    <tr class="login_password">
-      <td>[% text_pass %]</td>
-      <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
-    </tr>
-    [% IF ! hide_save ~%]
-    <tr class="login_save">
-      <td colspan="2">
-        <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
-      </td>
-    </tr>
-    [%~ END %]
-    <tr class="login_submit">
-      <td colspan="2" align="right">
-        <input type="submit" value="[% text_submit %]">
-      </td>
-    </tr>
-    </table>
-    </form>
-    </div>
+    my $self = shift;
+    return $self->{'login_form'} if defined $self->{'login_form'};
+    return \q{<div class="login_chunk">
+<span class="login_error">[% error %]</span>
+<form class="login_form" name="[% form_name %]" method="POST" action="[% script_name %][% path_info %]">
+<input type="hidden" name="[% key_redirect %]" value="">
+<input type="hidden" name="[% key_time %]" value="">
+<input type="hidden" name="[% key_expires_min %]" value="">
+<table class="login_table">
+<tr class="login_username">
+  <td>[% text_user %]</td>
+  <td><input name="[% key_user %]" type="text" size="30" value=""></td>
+</tr>
+<tr class="login_password">
+  <td>[% text_pass %]</td>
+  <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
+</tr>
+[% IF ! hide_save ~%]
+<tr class="login_save">
+  <td colspan="2">
+    <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
+  </td>
+</tr>
+[%~ END %]
+<tr class="login_submit">
+  <td colspan="2" align="right">
+    <input type="submit" value="[% text_submit %]">
+  </td>
+</tr>
+</table>
+</form>
+</div>

 };
 }
 
 };
 }
 


@@ -783,33 +808,32 @@ sub text_submit { my $self = shift; return defined($self->{'text_submit'}) ? $se
 
 sub login_script {
     my $self = shift;
 
 sub login_script {
     my $self = shift;

-    return $self->{'login_script'} if $self->{'login_script'};
+    return $self->{'login_script'} if defined $self->{'login_script'};

     return '' if $self->use_plaintext || $self->disable_simple_cram;
     return '' if $self->use_plaintext || $self->disable_simple_cram;

-    return q {
-    <form name="[% form_name %]_jspost" style="margin:0px" method="POST">
-    <input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
-    </form>
-    <script src="[% md5_js_path %]"></script>
-    <script>
-    if (document.md5_hex) document.[% form_name %].onsubmit = function () {
-      var f = document.[% form_name %];
-      var u = f.[% key_user %].value;
-      var p = f.[% key_pass %].value;
-      var t = f.[% key_time %].value;
-      var s = f.[% key_save %] && f.[% key_save %].checked ? -1 : f.[% key_expires_min %].value;
-
-      var str = u+'/'+t+'/'+s+'/'+'';
-      var sum = document.md5_hex(str +'/' + document.md5_hex(p));
-
-      var f2 = document.[% form_name %]_jspost;
-      f2.[% key_user %].value = str +'/'+ sum;
-      f2.[% key_redirect %].value = f.[% key_redirect %].value;
-      f2.action = f.action;
-      f2.submit();
-      return false;
-    }
-    </script>
-  };
+    return \q{<form name="[% form_name %]_jspost" style="margin:0px" method="POST">
+<input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
+</form>
+<script src="[% md5_js_path %]"></script>
+<script>
+if (document.md5_hex) document.[% form_name %].onsubmit = function () {
+  var f = document.[% form_name %];
+  var u = f.[% key_user %].value;
+  var p = f.[% key_pass %].value;
+  var t = f.[% key_time %].value;
+  var s = f.[% key_save %] && f.[% key_save %].checked ? -1 : f.[% key_expires_min %].value;
+
+  var str = u+'/'+t+'/'+s+'/'+'';
+  var sum = document.md5_hex(str +'/' + document.md5_hex(p));
+
+  var f2 = document.[% form_name %]_jspost;
+  f2.[% key_user %].value = str +'/'+ sum;
+  f2.[% key_redirect %].value = f.[% key_redirect %].value;
+  f2.action = f.action;
+  f2.submit();
+  return false;
+}
+</script>
+};

 }
 
 ###----------------------------------------------------------------###
 }
 
 ###----------------------------------------------------------------###


@@ -891,22 +915,35 @@ __END__
 
 =head1 DESCRIPTION
 
 
 =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 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
 
 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
 
 
 =head1 METHODS
 


@@ -931,6 +968,9 @@ described separately.
 
     cgix
     cleanup_user
 
     cgix
     cleanup_user

+    cookie_domain
+    cookie_secure
+    cookie_path

     cookies
     expires_min
     form
     cookies
     expires_min
     form


@@ -964,6 +1004,7 @@ described separately.
     secure_hash_keys
     template_args
     template_include_path
     secure_hash_keys
     template_args
     template_include_path

+    template_obj

     text_user
     text_pass
     text_save
     text_user
     text_pass
     text_save


@@ -973,6 +1014,8 @@ described separately.
     use_blowfish
     use_crypt
     use_plaintext
     use_blowfish
     use_crypt
     use_plaintext

+    use_session_cookie
+    verify_token

     verify_payload
     verify_user
 
     verify_payload
     verify_user