]> Dogcows Code - chaz/p5-CGI-Ex/blobdiff - lib/CGI/Ex/Auth.pm
CGI::Ex 2.08
[chaz/p5-CGI-Ex] / lib / CGI / Ex / Auth.pm
index 2208427b3d9d30d65befdf1f2e207f87a268eba9..fe9f776e125cb70732cdbeaf92c8609f33ed5816 100644 (file)
@@ -7,7 +7,7 @@ CGI::Ex::Auth - Handle logins nicely.
 =cut
 
 ###----------------------------------------------------------------###
-#  Copyright 2006 - Paul Seamons                                     #
+#  Copyright 2007 - Paul Seamons                                     #
 #  Distributed under the Perl Artistic License without warranty      #
 ###----------------------------------------------------------------###
 
@@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64);
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 
-$VERSION = '2.02';
+$VERSION = '2.08';
 
 ###----------------------------------------------------------------###
 
@@ -315,7 +315,9 @@ sub login_hash_common {
         $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,
     };
 }
 
@@ -337,7 +339,7 @@ sub verify_token {
         my $key;
         for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
             my $copy = ($armor eq 'none')           ? $token
-                     : ($armor eq 'base64')         ? decode_base64($token)
+                     : ($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) {
@@ -383,6 +385,13 @@ sub verify_token {
     } elsif (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
         $data->add_data({details => $@});
         $data->error('Could not get pass');
+    } elsif (ref $pass eq 'HASH') {
+        my $extra = $pass;
+        $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
+              : exists($extra->{'password'})  ? delete($extra->{'password'})
+              : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
+        $data->error('Invalid login') if ! defined $pass && ! $data->error;
+        $data->add_data($extra);
     }
     return $data if $data->error;
 
@@ -622,16 +631,16 @@ sub login_form {
     <input type="hidden" name="[% key_expires_min %]" value="">
     <table class="login_table">
     <tr class="login_username">
-      <td>Username:</td>
+      <td>[% text_user %]</td>
       <td><input name="[% key_user %]" type="text" size="30" value=""></td>
     </tr>
     <tr class="login_password">
-      <td>Password:</td>
+      <td>[% text_pass %]</td>
       <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
     </tr>
     <tr class="login_save">
       <td colspan="2">
-        <input type="checkbox" name="[% key_save %]" value="1"> Save Password ?
+        <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
       </td>
     </tr>
     <tr class="login_submit">
@@ -645,6 +654,10 @@ 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 login_script {
   return q {
     [%~ IF ! use_plaintext %]
@@ -715,18 +728,38 @@ __END__
 
 =head1 SYNOPSIS
 
-  ### authorize the user
-  my $auth = $self->get_valid_auth({
-    get_pass_by_user => \&get_pass_by_user,
-  });
+    use CGI::Ex::Auth;
 
+    ### authorize the user
+    my $auth = CGI::Ex::Auth->get_valid_auth({
+        get_pass_by_user => \&get_pass_by_user,
+    });
 
-  sub get_pass_by_user {
-    my $auth = shift;
-    my $user = shift;
-    my $pass = some_way_of_getting_password($user);
-    return $pass;
-  }
+
+    sub get_pass_by_user {
+        my $auth = shift;
+        my $user = shift;
+        my $pass = some_way_of_getting_password($user);
+        return $pass;
+    }
+
+    ### OR - if you are using a OO based CGI or Application
+
+    sub require_authentication {
+        my $self = shift;
+
+        return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
+            get_pass_by_user => sub {
+                my ($auth, $user) = @_;
+                return $self->get_pass($user);
+            },
+        });
+    }
+
+    sub get_pass {
+        my ($self, $user) = @_;
+        return $self->loopup_and_cache_pass($user);
+    }
 
 =head1 DESCRIPTION
 
@@ -797,6 +830,9 @@ defined separately.
     secure_hash_keys
     template_args
     template_include_path
+    text_user
+    text_pass
+    text_save
     use_base64
     use_blowfish
     use_crypt
@@ -946,6 +982,9 @@ Passed to the template swapped during login_print.
     $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 ?
 
 =item C<key_logout>
 
@@ -1028,6 +1067,27 @@ valid password for the user.  It can always return plaintext.  If use_crypt is
 enabled, it should return the crypted password.  If use_plaintext and use_crypt
 are not enabled, it may return the md5 sum of the password.
 
+   get_pass_by_user => sub {
+       my ($auth_obj, $user) = @_;
+       my $pass = $some_obj->get_pass({user => $user});
+       return $pass;
+   }
+
+Alternately, get_pass_by_user may return a hashref of data items that
+will be added to the data object if the token is valid.  The hashref
+must also contain a key named real_pass or password that contains the
+password.  Note that keys passed back in the hashref that are already
+in the data object will override those in the data object.
+
+   get_pass_by_user => sub {
+       my ($auth_obj, $user) = @_;
+       my ($pass, $user_id) = $some_obj->get_pass({user => $user});
+       return {
+           password => $pass,
+           user_id  => $user_id,
+       };
+   }
+
 =item C<cgix>
 
 Returns a CGI::Ex object.
@@ -1080,8 +1140,18 @@ Contains javascript that will attach to the form from login_form.  This script
 is capable of taking the login_fields and creating an md5 cram which prevents
 the password from being passed plaintext.
 
+=item C<text_user, text_pass, text_save>
+
+The text items shown in the default login template.  The default values are:
+
+    text_user  "Username:"
+    text_pass  "Password:"
+    text_save  "Save Password ?"
+
+=back
+
 =head1 AUTHORS
 
-Paul Seamons <perlspam at seamons dot com>
+Paul Seamons <paul at seamons dot com>
 
 =cut
This page took 0.022341 seconds and 4 git commands to generate.