CGI::Ex 2.22

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

diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index 85c28fe0dc0794c0c8d82a09698a14bb13b8a0cb..33e2a30e03454a1ad97df80b45f0237fd054481e 100644 (file)
--- 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;
 
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 

-$VERSION = '2.19';
+$VERSION = '2.22';

 
 ###----------------------------------------------------------------###
 
 
 ###----------------------------------------------------------------###
 


@@ -49,6 +49,8 @@ sub get_valid_auth {
         local $self->{'no_cookie_verify'} = 1;
         $self->check_valid_auth; # verify the logout so we can capture the username if possible
 
         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};
         if ($self->bounce_on_logout) {
             my $key_c = $self->key_cookie;
             $self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c};


@@ -72,6 +74,7 @@ sub get_valid_auth {
         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;
         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;

+        next if ! length $hash->{$key};

 
         ### if it looks like a bare username (as in they didn't have javascript) - add in other items
         my $data;
 
         ### if it looks like a bare username (as in they didn't have javascript) - add in other items
         my $data;


@@ -88,7 +91,6 @@ sub get_valid_auth {
                     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        => 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;
                 },
                 from => 'form',
             }) || next;


@@ -99,12 +101,13 @@ sub get_valid_auth {
         }
 
         ### generate a fresh cookie if they submitted info on plaintext types
         }
 
         ### 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        => $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
             $self->set_cookie({
                 key        => $self->key_cookie,
                 val        => $self->generate_token($data),
                 no_expires => ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving

-            }) if $is_form; # only set the cookie if we found info in the form - the cookie will be a session cookie after that
+            });

 
         ### always generate a cookie on types that have expiration
         } else {
 
         ### always generate a cookie on types that have expiration
         } else {


@@ -138,6 +141,7 @@ sub handle_success {
 
     ### if they have cookies we are done
     } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
 
     ### 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
         return $self;
 
     ### need to verify cookies are set-able


@@ -151,6 +155,22 @@ sub handle_success {
     }
 }
 
     }
 }
 

+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 || {};
 sub handle_failure {
     my $self = shift;
     my $args = shift || {};


@@ -181,10 +201,19 @@ sub handle_failure {
 
     ### allow for a sleep to help prevent brute force
     sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
 
     ### 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;
 }
 
 
     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;
 sub check_valid_auth {
     my $self = shift;
     $self = $self->new(@_) if ! ref $self;


@@ -269,7 +298,6 @@ 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 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'} ||= []             }
 sub key_loggedout    { shift->{'key_loggedout'}    ||= 'loggedout'    }
 sub bounce_on_logout { shift->{'bounce_on_logout'} ||= 0              }
 sub secure_hash_keys { shift->{'secure_hash_keys'} ||= []             }


@@ -281,6 +309,7 @@ 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 disable_simple_cram { shift->{'disable_simple_cram'} }

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


@@ -353,17 +382,14 @@ sub login_hash_common {
         key_time           => $self->key_time,
         key_save           => $self->key_save,
         key_expires_min    => $self->key_expires_min,
         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",
         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_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,
         $self->key_expires_min => $self->expires_min,
         text_user          => $self->text_user,
         text_pass          => $self->text_pass,


@@ -378,7 +404,7 @@ 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";
+    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;
 


@@ -523,9 +549,10 @@ sub verify_password {
             }
         }
 
             }
         }
 

-    ### looks like a normal cram
+    ### looks like a simple_cram

     } elsif ($data->{'cram_time'}) {
     } elsif ($data->{'cram_time'}) {

-        $data->add_data(type => 'cram');
+        $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);
         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);


@@ -577,7 +604,7 @@ sub generate_token {
         my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
         $token = $data->{'user'} .'/'. $pass;
 
         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'}))
     } 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'}))


@@ -588,7 +615,7 @@ sub generate_token {
         die "User can not contain a \"/\."                                           if $user =~ m|/|;
 
         my $array;
         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);
             && ($array = eval { $self->secure_hash_keys })
             && @$array) {
             my $rand1 = int(rand @$array);


@@ -597,6 +624,7 @@ sub generate_token {
             my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
             $token  = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
         } else {
             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;
             my $str = join("/", $user, $self->server_time, $exp, $load);
             my $sum = md5_hex($str .'/'. $real);
             $token  = $str .'/'. $sum;


@@ -719,7 +747,6 @@ sub login_form {
     <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="">
     <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_payload %]" value="">

     <input type="hidden" name="[% key_time %]" value="">
     <input type="hidden" name="[% key_expires_min %]" value="">
     <table class="login_table">
     <input type="hidden" name="[% key_time %]" value="">
     <input type="hidden" name="[% key_expires_min %]" value="">
     <table class="login_table">


@@ -756,8 +783,10 @@ sub hide_save   { my $self = shift; return defined($self->{'hide_save'})   ? $se
 sub text_submit { my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
 
 sub login_script {
 sub text_submit { my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
 
 sub login_script {

-    return shift->{'login_script'} || q {
-    [%~ IF ! use_plaintext %]
+    my $self = shift;
+    return $self->{'login_script'} if $self->{'login_script'};
+    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>
     <form name="[% form_name %]_jspost" style="margin:0px" method="POST">
     <input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
     </form>


@@ -769,9 +798,8 @@ sub login_script {
       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 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 l = f.[% key_payload %].value;

 
 

-      var str = u+'/'+t+'/'+s+'/'+l;
+      var str = u+'/'+t+'/'+s+'/'+'';

       var sum = document.md5_hex(str +'/' + document.md5_hex(p));
 
       var f2 = document.[% form_name %]_jspost;
       var sum = document.md5_hex(str +'/' + document.md5_hex(p));
 
       var f2 = document.[% form_name %]_jspost;


@@ -782,7 +810,6 @@ sub login_script {
       return false;
     }
     </script>
       return false;
     }
     </script>

-    [% END ~%]

   };
 }
 
   };
 }
 


@@ -869,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.
 
 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
 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


@@ -897,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',
         get_pass_by_user => \&my_pass_sub,
         key_user         => 'my_user',
         key_pass         => 'my_pass',

-        login_template   => \"<form><input name=my_user ... </form>",
+        login_header     => \"<h1>My Login</h1>",

     });
 
 The following methods will look for properties of the same name.  Each of these will be
     });
 
 The following methods will look for properties of the same name.  Each of these will be

-defined separately.
+described separately.

 
     cgix
     cleanup_user
 
     cgix
     cleanup_user


@@ -915,7 +942,6 @@ defined separately.
     key_expires_min
     key_logout
     key_pass
     key_expires_min
     key_logout
     key_pass

-    key_payload

     key_redirect
     key_save
     key_time
     key_redirect
     key_save
     key_time


@@ -930,6 +956,9 @@ defined separately.
     login_template
     handle_success
     handle_failure
     login_template
     handle_success
     handle_failure

+    success_hook
+    failure_hook
+    logout_hook

     no_cookie_verify
     path_info
     script_name
     no_cookie_verify
     path_info
     script_name


@@ -972,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 /.
                      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
                      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
                      is generally only useful in testing.
 
 The following are types of tokens that can be generated by generate_token.  Each type includes


@@ -999,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.
 
         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
         user        := "paul"
         real_pass   := "123qwe"
         server_time := 1148512991         # a time in seconds since epoch


@@ -1084,17 +1114,14 @@ 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_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
     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_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:
     $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:


@@ -1297,6 +1324,18 @@ The text items shown in the default login template.  The default values are:
     text_pass  "Password:"
     text_save  "Save Password ?"
 
     text_pass  "Password:"
     text_save  "Save Password ?"
 

+=item C<disable_simple_cram>
+
+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
 =back
 
 =head1 LICENSE