Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Auth.pm

   1 package CGI::Ex::Auth;
   2
   3 =head1 NAME
   4
   5 CGI::Ex::Auth - Handle logins nicely.
   6
   7 =cut
   8
   9 ###----------------------------------------------------------------###
  10 #  Copyright 2007 - Paul Seamons                                     #
  11 #  Distributed under the Perl Artistic License without warranty      #
  12 ###----------------------------------------------------------------###
  13
  14 use strict;
  15 use vars qw($VERSION);
  16
  17 use MIME::Base64 qw(encode_base64 decode_base64);
  18 use Digest::MD5 qw(md5_hex);
  19 use CGI::Ex;
  20
  21 $VERSION = '2.19';
  22
  23 ###----------------------------------------------------------------###
  24
  25 sub new {
  26     my $class = shift || __PACKAGE__;
  27     my $args  = shift || {};
  28     return bless {%$args}, $class;
  29 }
  30
  31 sub get_valid_auth {
  32     my $self = shift;
  33     $self = $self->new(@_) if ! ref $self;
  34     delete $self->{'_last_auth_data'};
  35
  36     ### shortcut that will print a js file as needed (such as the md5.js)
  37     if ($self->script_name . $self->path_info eq $self->js_uri_path . "/CGI/Ex/md5.js") {
  38         $self->cgix->print_js('CGI/Ex/md5.js');
  39         eval { die "Printed Javascript" };
  40         return;
  41     }
  42
  43     my $form = $self->form;
  44
  45     ### allow for logout
  46     if ($form->{$self->key_logout} && ! $self->{'_logout_looking_for_user'}) {
  47         local $self->{'_logout_looking_for_user'} = 1;
  48         local $self->{'no_set_cookie'}    = 1;
  49         local $self->{'no_cookie_verify'} = 1;
  50         $self->check_valid_auth; # verify the logout so we can capture the username if possible
  51
  52         if ($self->bounce_on_logout) {
  53             my $key_c = $self->key_cookie;
  54             $self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c};
  55             my $user = $self->last_auth_data ? $self->last_auth_data->{'user'} : undef;
  56             $self->location_bounce($self->logout_redirect(defined($user) ? $user : ''));
  57             eval { die "Logging out" };
  58             return;
  59         } else {
  60             $self->form({});
  61             $self->handle_failure;
  62             return;
  63         }
  64     }
  65
  66     ### look first in form, then in cookies for valid tokens
  67     my $had_form_data;
  68     foreach ([$form,          $self->key_user,   1],
  69              [$self->cookies, $self->key_cookie, 0],
  70              ) {
  71         my ($hash, $key, $is_form) = @$_;
  72         next if ! defined $hash->{$key};
  73         last if ! $is_form && $had_form_data;  # if form info was passed in - we must use it only
  74         $had_form_data = 1 if $is_form;
  75
  76         ### if it looks like a bare username (as in they didn't have javascript) - add in other items
  77         my $data;
  78         if ($is_form && delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
  79             my $key_u = $self->key_user;
  80             $self->new_auth_data({user => delete($form->{$key_u})});
  81             $had_form_data = 0;
  82             next;
  83         } elsif ($is_form
  84             && $hash->{$key} !~ m|^[^/]+/| # looks like a cram token
  85             && defined $hash->{ $self->key_pass }) {
  86             $data = $self->verify_token({
  87                 token => {
  88                     user        => delete $hash->{$key},
  89                     test_pass   => delete $hash->{ $self->key_pass },
  90                     expires_min => delete($hash->{ $self->key_save }) ? -1 : delete($hash->{ $self->key_expires_min }) || $self->expires_min,
  91                     payload     => delete $hash->{ $self->key_payload } || '',
  92                 },
  93                 from => 'form',
  94             }) || next;
  95
  96         } else {
  97             $data = $self->verify_token({token => $hash->{$key}, from => ($is_form ? 'form' : 'cookie')}) || next;
  98             delete $hash->{$key} if $is_form;
  99         }
 100
 101         ### generate a fresh cookie if they submitted info on plaintext types
 102         if ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt')) {
 103             $self->set_cookie({
 104                 key        => $self->key_cookie,
 105                 val        => $self->generate_token($data),
 106                 no_expires => ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving
 107             }) if $is_form; # only set the cookie if we found info in the form - the cookie will be a session cookie after that
 108
 109         ### always generate a cookie on types that have expiration
 110         } else {
 111             $self->set_cookie({
 112                 key        => $self->key_cookie,
 113                 val        => $self->generate_token($data),
 114                 no_expires => 0,
 115             });
 116         }
 117
 118         ### successful login
 119         return $self->handle_success({is_form => $is_form});
 120     }
 121
 122     return $self->handle_failure({had_form_data => $had_form_data});
 123 }
 124
 125 sub handle_success {
 126     my $self = shift;
 127     my $args = shift || {};
 128     if (my $meth = $self->{'handle_success'}) {
 129         return $meth->($self, $args);
 130     }
 131     my $form = $self->form;
 132
 133     ### bounce to redirect
 134     if (my $redirect = $form->{ $self->key_redirect }) {
 135         $self->location_bounce($redirect);
 136         eval { die "Success login - bouncing to redirect" };
 137         return;
 138
 139     ### if they have cookies we are done
 140     } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
 141         return $self;
 142
 143     ### need to verify cookies are set-able
 144     } elsif ($args->{'is_form'}) {
 145         $form->{$self->key_verify} = $self->server_time;
 146         my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
 147
 148         $self->location_bounce($url);
 149         eval { die "Success login - bouncing to test cookie" };
 150         return;
 151     }
 152 }
 153
 154 sub handle_failure {
 155     my $self = shift;
 156     my $args = shift || {};
 157     if (my $meth = $self->{'handle_failure'}) {
 158         return $meth->($self, $args);
 159     }
 160     my $form = $self->form;
 161
 162     ### make sure the cookie is gone
 163     my $key_c = $self->key_cookie;
 164     $self->delete_cookie({key => $key_c}) if $self->cookies->{$key_c};
 165
 166     ### no valid login and we are checking for cookies - see if they have cookies
 167     if (my $value = delete $form->{$self->key_verify}) {
 168         if (abs(time() - $value) < 15) {
 169             $self->no_cookies_print;
 170             return;
 171         }
 172     }
 173
 174     ### oh - you're still here - well then - ask for login credentials
 175     my $key_r = $self->key_redirect;
 176     local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
 177     local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
 178     $self->login_print;
 179     my $data = $self->last_auth_data;
 180     eval { die defined($data) ? $data : "Requesting credentials" };
 181
 182     ### allow for a sleep to help prevent brute force
 183     sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
 184
 185     return;
 186 }
 187
 188 sub check_valid_auth {
 189     my $self = shift;
 190     $self = $self->new(@_) if ! ref $self;
 191
 192     local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
 193     local $self->{'login_print'}     = sub {}; # check only - don't login if not
 194     local $self->{'set_cookie'}      = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
 195     return $self->get_valid_auth;
 196 }
 197
 198 ###----------------------------------------------------------------###
 199
 200 sub script_name { shift->{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
 201
 202 sub path_info { shift->{'path_info'} || $ENV{'PATH_INFO'} || '' }
 203
 204 sub server_time { time }
 205
 206 sub cgix {
 207     my $self = shift;
 208     $self->{'cgix'} = shift if @_ == 1;
 209     return $self->{'cgix'} ||= CGI::Ex->new;
 210 }
 211
 212 sub form {
 213     my $self = shift;
 214     $self->{'form'} = shift if @_ == 1;
 215     return $self->{'form'} ||= $self->cgix->get_form;
 216 }
 217
 218 sub cookies {
 219     my $self = shift;
 220     $self->{'cookies'} = shift if @_ == 1;
 221     return $self->{'cookies'} ||= $self->cgix->get_cookies;
 222 }
 223
 224 sub delete_cookie {
 225     my $self = shift;
 226     my $args = shift;
 227     return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
 228     my $key  = $args->{'key'};
 229     $self->cgix->set_cookie({
 230         -name    => $key,
 231         -value   => '',
 232         -expires => '-10y',
 233         -path    => '/',
 234     });
 235     delete $self->cookies->{$key};
 236 }
 237
 238 sub set_cookie {
 239     my $self = shift;
 240     my $args = shift;
 241     return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
 242     my $key  = $args->{'key'};
 243     my $val  = $args->{'val'};
 244     $self->cgix->set_cookie({
 245         -name    => $key,
 246         -value   => $val,
 247         ($args->{'no_expires'} ? () : (-expires => '+20y')), # let the expires time take care of things for types that self expire
 248         -path    => '/',
 249     });
 250     $self->cookies->{$key} = $val;
 251 }
 252
 253 sub location_bounce {
 254     my $self = shift;
 255     my $url  = shift;
 256     return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
 257     return $self->cgix->location_bounce($url);
 258 }
 259
 260 ###----------------------------------------------------------------###
 261
 262 sub key_logout       { shift->{'key_logout'}       ||= 'cea_logout'   }
 263 sub key_cookie       { shift->{'key_cookie'}       ||= 'cea_user'     }
 264 sub key_user         { shift->{'key_user'}         ||= 'cea_user'     }
 265 sub key_pass         { shift->{'key_pass'}         ||= 'cea_pass'     }
 266 sub key_time         { shift->{'key_time'}         ||= 'cea_time'     }
 267 sub key_save         { shift->{'key_save'}         ||= 'cea_save'     }
 268 sub key_expires_min  { shift->{'key_expires_min'}  ||= 'cea_expires_min' }
 269 sub form_name        { shift->{'form_name'}        ||= 'cea_form'     }
 270 sub key_verify       { shift->{'key_verify'}       ||= 'cea_verify'   }
 271 sub key_redirect     { shift->{'key_redirect'}     ||= 'cea_redirect' }
 272 sub key_payload      { shift->{'key_payload'}      ||= 'cea_payload'  }
 273 sub key_loggedout    { shift->{'key_loggedout'}    ||= 'loggedout'    }
 274 sub bounce_on_logout { shift->{'bounce_on_logout'} ||= 0              }
 275 sub secure_hash_keys { shift->{'secure_hash_keys'} ||= []             }
 276 #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"}'
 277 sub no_cookie_verify { shift->{'no_cookie_verify'} ||= 0              }
 278 sub use_crypt        { shift->{'use_crypt'}        ||= 0              }
 279 sub use_blowfish     { shift->{'use_blowfish'}     ||= ''             }
 280 sub use_plaintext    { my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
 281 sub use_base64       { my $s = shift; $s->{'use_base64'}  = 1      if ! defined $s->{'use_base64'};  $s->{'use_base64'}  }
 282 sub expires_min      { my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
 283 sub failed_sleep     { shift->{'failed_sleep'}     ||= 0              }
 284
 285 sub logout_redirect {
 286     my ($self, $user) = @_;
 287     my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
 288     return $self->{'logout_redirect'} || $self->script_name ."?$form";
 289 }
 290
 291 sub js_uri_path {
 292     my $self = shift;
 293     return $self->{'js_uri_path'} ||= $self->script_name ."/js";
 294 }
 295
 296 ###----------------------------------------------------------------###
 297
 298 sub no_cookies_print {
 299     my $self = shift;
 300     $self->cgix->print_content_type;
 301     print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
 302     return 1;
 303 }
 304
 305 sub login_print {
 306     my $self = shift;
 307     my $hash = $self->login_hash_common;
 308     my $template = $self->login_template;
 309
 310     ### allow for a hooked override
 311     if (my $meth = $self->{'login_print'}) {
 312         $meth->($self, $template, $hash);
 313         return 0;
 314     }
 315
 316     ### process the document
 317     require CGI::Ex::Template;
 318     my $cet = CGI::Ex::Template->new($self->template_args);
 319     my $out = '';
 320     $cet->process_simple($template, $hash, \$out) || die $cet->error;
 321
 322     ### fill in form fields
 323     require CGI::Ex::Fill;
 324     CGI::Ex::Fill::fill({text => \$out, form => $hash});
 325
 326     ### print it
 327     $self->cgix->print_content_type;
 328     print $out;
 329
 330     return 0;
 331 }
 332
 333 sub template_args {
 334     my $self = shift;
 335     return $self->{'template_args'} ||= {
 336         INCLUDE_PATH => $self->template_include_path,
 337     };
 338 }
 339
 340 sub template_include_path { shift->{'template_include_path'} || '' }
 341
 342 sub login_hash_common {
 343     my $self = shift;
 344     my $form = $self->form;
 345     my $data = $self->last_auth_data || {};
 346
 347     return {
 348         %$form,
 349         error              => ($form->{'had_form_data'}) ? "Login Failed" : "",
 350         login_data         => $data,
 351         key_user           => $self->key_user,
 352         key_pass           => $self->key_pass,
 353         key_time           => $self->key_time,
 354         key_save           => $self->key_save,
 355         key_expires_min    => $self->key_expires_min,
 356         key_payload        => $self->key_payload,
 357         key_redirect       => $self->key_redirect,
 358         form_name          => $self->form_name,
 359         script_name        => $self->script_name,
 360         path_info          => $self->path_info,
 361         md5_js_path        => $self->js_uri_path ."/CGI/Ex/md5.js",
 362         use_plaintext      => $self->use_plaintext,
 363         $self->key_user    => $data->{'user'} || '',
 364         $self->key_pass    => '', # don't allow for this to get filled into the form
 365         $self->key_time    => $self->server_time,
 366         $self->key_payload => $self->generate_payload({%$data, login_form => 1}),
 367         $self->key_expires_min => $self->expires_min,
 368         text_user          => $self->text_user,
 369         text_pass          => $self->text_pass,
 370         text_save          => $self->text_save,
 371         text_submit        => $self->text_submit,
 372         hide_save          => $self->hide_save,
 373     };
 374 }
 375
 376 ###----------------------------------------------------------------###
 377
 378 sub verify_token {
 379     my $self  = shift;
 380     my $args  = shift;
 381     my $token = delete $args->{'token'} || die "Missing token";
 382     my $data  = $self->new_auth_data({token => $token, %$args});
 383     my $meth;
 384
 385     ### make sure the token is parsed to usable data
 386     if (ref $token) { # token already parsed
 387         $data->add_data({%$token, armor => 'none'});
 388
 389     } elsif (my $meth = $self->{'parse_token'}) {
 390         if (! $meth->($self, $args)) {
 391             $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
 392             return $data;
 393         }
 394     } else {
 395         if (! $self->parse_token($token, $data)) {
 396             $data->error('Invalid token') if ! $data->error; # add error if not already added
 397             return $data;
 398         }
 399     }
 400
 401
 402     ### verify the user
 403     if (! defined($data->{'user'})) {
 404         $data->error('Missing user');
 405
 406     } elsif (! defined $data->{'test_pass'}) {
 407         $data->error('Missing test_pass');
 408
 409     } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
 410         $data->error('Invalid user');
 411
 412     }
 413     return $data if $data->error;
 414
 415     ### get the pass
 416     my $pass;
 417     if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
 418         $data->add_data({details => $@});
 419         $data->error('Could not get pass');
 420     } elsif (ref $pass eq 'HASH') {
 421         my $extra = $pass;
 422         $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
 423               : exists($extra->{'password'})  ? delete($extra->{'password'})
 424               : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
 425         $data->error('Invalid login') if ! defined $pass && ! $data->error;
 426         $data->add_data($extra);
 427     }
 428     return $data if $data->error;
 429     $data->add_data({real_pass => $pass}); # store - to allow generate_token to not need to relookup the pass
 430
 431
 432     ### validate the pass
 433     if ($meth = $self->{'verify_password'}) {
 434         if (! $meth->($self, $pass, $data)) {
 435             $data->error('Password failed verification') if ! $data->error;
 436         }
 437     } else{
 438         if (! $self->verify_password($pass, $data)) {
 439             $data->error('Password failed verification') if ! $data->error;
 440         }
 441     }
 442     return $data if $data->error;
 443
 444
 445     ### validate the payload
 446     if ($meth = $self->{'verify_payload'}) {
 447         if (! $meth->($self, $data->{'payload'}, $data)) {
 448             $data->error('Payload failed custom verification') if ! $data->error;
 449         }
 450     } else {
 451         if (! $self->verify_payload($data->{'payload'}, $data)) {
 452             $data->error('Payload failed verification') if ! $data->error;
 453         }
 454     }
 455
 456     return $data;
 457 }
 458
 459 sub new_auth_data {
 460     my $self = shift;
 461     return $self->{'_last_auth_data'} = CGI::Ex::Auth::Data->new(@_);
 462 }
 463
 464 sub parse_token {
 465     my ($self, $token, $data) = @_;
 466     my $found;
 467     my $key;
 468     for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
 469         my $copy = ($armor eq 'none')           ? $token
 470             : ($armor eq 'base64')         ? eval { local $^W; decode_base64($token) }
 471         : ($key = $self->use_blowfish) ? decrypt_blowfish($token, $key)
 472             : next;
 473         if ($copy =~ m|^ ([^/]+) / (\d+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\.\d+\.\d+))? $|x) {
 474             $data->add_data({
 475                 user         => $1,
 476                 cram_time    => $2,
 477                 expires_min  => $3,
 478                 payload      => $4,
 479                 test_pass    => $5,
 480                 secure_hash  => $6 || '',
 481                 armor        => $armor,
 482             });
 483             $found = 1;
 484             last;
 485         } elsif ($copy =~ m|^ ([^/]+) / (.*) $|x) {
 486             $data->add_data({
 487                 user         => $1,
 488                 test_pass    => $2,
 489                 armor        => $armor,
 490             });
 491             $found = 1;
 492             last;
 493         }
 494     }
 495     return $found;
 496 }
 497
 498 sub verify_password {
 499     my ($self, $pass, $data) = @_;
 500     my $err;
 501
 502     ### looks like a secure_hash cram
 503     if ($data->{'secure_hash'}) {
 504         $data->add_data(type => 'secure_hash_cram');
 505         my $array = eval {$self->secure_hash_keys };
 506         if (! $array) {
 507             $err = 'secure_hash_keys not found';
 508         } elsif (! @$array) {
 509             $err = 'secure_hash_keys empty';
 510         } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
 511             $err = 'Invalid secure hash';
 512         } else {
 513             my $rand1 = $1;
 514             my $rand2 = $2;
 515             my $real  = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($pass);
 516             my $str  = join("/", @{$data}{qw(user cram_time expires_min payload)});
 517             my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
 518             if ($data->{'expires_min'} > 0
 519                 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
 520                 $err = 'Login expired';
 521             } elsif (lc($data->{'test_pass'}) ne $sum) {
 522                 $err = 'Invalid login';
 523             }
 524         }
 525
 526     ### looks like a normal cram
 527     } elsif ($data->{'cram_time'}) {
 528         $data->add_data(type => 'cram');
 529         my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex($pass);
 530         my $str  = join("/", @{$data}{qw(user cram_time expires_min payload)});
 531         my $sum  = md5_hex($str .'/'. $real);
 532         if ($data->{'expires_min'} > 0
 533                  && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
 534             $err = 'Login expired';
 535         } elsif (lc($data->{'test_pass'}) ne $sum) {
 536             $err = 'Invalid login';
 537         }
 538
 539     ### plaintext_crypt
 540     } elsif ($pass =~ m|^([./0-9A-Za-z]{2})([./0-9A-Za-z]{11})$|
 541              && crypt($data->{'test_pass'}, $1) eq $pass) {
 542         $data->add_data(type => 'crypt', was_plaintext => 1);
 543
 544     ### failed plaintext crypt
 545     } elsif ($self->use_crypt) {
 546         $err = 'Invalid login';
 547         $data->add_data(type => 'crypt', was_plaintext => ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
 548
 549     ### plaintext and md5
 550     } else {
 551         my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
 552         my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
 553         my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex($data->{'test_pass'});
 554         my $real = $is_md5_r ? lc($pass) : md5_hex($pass);
 555         $data->add_data(type => ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext => ($is_md5_t ? 0 : 1));
 556         $err = 'Invalid login'
 557             if $test ne $real;
 558     }
 559
 560     $data->error($err) if $err;
 561     return ! $err;
 562 }
 563
 564 sub last_auth_data { shift->{'_last_auth_data'} }
 565
 566 sub generate_token {
 567     my $self  = shift;
 568     my $data  = shift || $self->last_auth_data;
 569     die "Can't generate a token off of a failed auth" if ! $data;
 570
 571     my $token;
 572
 573     ### do kinds that require staying plaintext
 574     if (   (defined($data->{'use_plaintext'}) ?  $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
 575         || (defined($data->{'use_crypt'})     && $data->{'use_crypt'})
 576         || (defined($data->{'type'})          && $data->{'type'} eq 'crypt')) {
 577         my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
 578         $token = $data->{'user'} .'/'. $pass;
 579
 580     ### all other types go to cram - secure_hash_cram, cram, plaintext and md5
 581     } else {
 582         my $user = $data->{'user'} || die "Missing user";
 583         my $real = defined($data->{'real_pass'})   ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex($data->{'real_pass'}))
 584                                                    : die "Missing real_pass";
 585         my $exp  = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
 586         my $load = $self->generate_payload($data);
 587         die "Payload can not contain a \"/\.  Please escape it in generate_payload." if $load =~ m|/|;
 588         die "User can not contain a \"/\."                                           if $user =~ m|/|;
 589
 590         my $array;
 591         if (! $data->{'prefer_cram'}
 592             && ($array = eval { $self->secure_hash_keys })
 593             && @$array) {
 594             my $rand1 = int(rand @$array);
 595             my $rand2 = int(rand 100000);
 596             my $str = join("/", $user, $self->server_time, $exp, $load);
 597             my $sum = md5_hex($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
 598             $token  = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
 599         } else {
 600             my $str = join("/", $user, $self->server_time, $exp, $load);
 601             my $sum = md5_hex($str .'/'. $real);
 602             $token  = $str .'/'. $sum;
 603         }
 604     }
 605
 606     if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
 607         $token = encrypt_blowfish($token, $key);
 608
 609     } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
 610         $token = encode_base64($token, '');
 611     }
 612
 613     return $token;
 614 }
 615
 616 sub generate_payload {
 617     my $self = shift;
 618     my $args = shift;
 619     if (my $meth = $self->{'generate_payload'}) {
 620         return $meth->($self, $args);
 621     }
 622     return defined($args->{'payload'}) ? $args->{'payload'} : '';
 623 }
 624
 625 sub verify_user {
 626     my $self = shift;
 627     my $user = shift;
 628     if (my $meth = $self->{'verify_user'}) {
 629         return $meth->($self, $user);
 630     }
 631     return 1;
 632 }
 633
 634 sub cleanup_user {
 635     my $self = shift;
 636     my $user = shift;
 637     if (my $meth = $self->{'cleanup_user'}) {
 638         return $meth->($self, $user);
 639     }
 640     return $user;
 641 }
 642
 643 sub get_pass_by_user {
 644     my $self = shift;
 645     my $user = shift;
 646     if (my $meth = $self->{'get_pass_by_user'}) {
 647         return $meth->($self, $user);
 648     }
 649
 650     die "Please override get_pass_by_user";
 651 }
 652
 653 sub verify_payload {
 654     my ($self, $payload, $data) = @_;
 655     if (my $meth = $self->{'verify_payload'}) {
 656         return $meth->($self, $payload, $data);
 657     }
 658     return 1;
 659 }
 660
 661 ###----------------------------------------------------------------###
 662
 663 sub encrypt_blowfish {
 664     my ($str, $key) = @_;
 665
 666     require Crypt::Blowfish;
 667     my $cb = Crypt::Blowfish->new($key);
 668
 669     $str .= (chr 0) x (8 - length($str) % 8); # pad to multiples of 8
 670
 671     my $enc = '';
 672     $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
 673
 674     return $enc;
 675 }
 676
 677 sub decrypt_blowfish {
 678     my ($enc, $key) = @_;
 679
 680     require Crypt::Blowfish;
 681     my $cb = Crypt::Blowfish->new($key);
 682
 683     my $str = '';
 684     $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
 685     $str =~ y/\00//d;
 686
 687     return $str
 688 }
 689
 690 ###----------------------------------------------------------------###
 691
 692 sub login_template {
 693     my $self = shift;
 694     return $self->{'login_template'} if $self->{'login_template'};
 695
 696     my $text = ""
 697         . $self->login_header
 698         . $self->login_form
 699         . $self->login_script
 700         . $self->login_footer;
 701     return \$text;
 702 }
 703
 704 sub login_header {
 705     return shift->{'login_header'} || q {
 706     [%~ TRY ; PROCESS 'login_header.tt' ; CATCH %]<!-- [% error %] -->[% END ~%]
 707     };
 708 }
 709
 710 sub login_footer {
 711     return shift->{'login_footer'} || q {
 712     [%~ TRY ; PROCESS 'login_footer.tt' ; CATCH %]<!-- [% error %] -->[% END ~%]
 713     };
 714 }
 715
 716 sub login_form {
 717     return shift->{'login_form'} || q {
 718     <div class="login_chunk">
 719     <span class="login_error">[% error %]</span>
 720     <form class="login_form" name="[% form_name %]" method="POST" action="[% script_name %][% path_info %]">
 721     <input type="hidden" name="[% key_redirect %]" value="">
 722     <input type="hidden" name="[% key_payload %]" value="">
 723     <input type="hidden" name="[% key_time %]" value="">
 724     <input type="hidden" name="[% key_expires_min %]" value="">
 725     <table class="login_table">
 726     <tr class="login_username">
 727       <td>[% text_user %]</td>
 728       <td><input name="[% key_user %]" type="text" size="30" value=""></td>
 729     </tr>
 730     <tr class="login_password">
 731       <td>[% text_pass %]</td>
 732       <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
 733     </tr>
 734     [% IF ! hide_save ~%]
 735     <tr class="login_save">
 736       <td colspan="2">
 737         <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
 738       </td>
 739     </tr>
 740     [%~ END %]
 741     <tr class="login_submit">
 742       <td colspan="2" align="right">
 743         <input type="submit" value="[% text_submit %]">
 744       </td>
 745     </tr>
 746     </table>
 747     </form>
 748     </div>
 749 };
 750 }
 751
 752 sub text_user   { my $self = shift; return defined($self->{'text_user'})   ? $self->{'text_user'}   : 'Username:' }
 753 sub text_pass   { my $self = shift; return defined($self->{'text_pass'})   ? $self->{'text_pass'}   : 'Password:' }
 754 sub text_save   { my $self = shift; return defined($self->{'text_save'})   ? $self->{'text_save'}   : 'Save Password ?' }
 755 sub hide_save   { my $self = shift; return defined($self->{'hide_save'})   ? $self->{'hide_save'}   : 0 }
 756 sub text_submit { my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
 757
 758 sub login_script {
 759     return shift->{'login_script'} || q {
 760     [%~ IF ! use_plaintext %]
 761     <form name="[% form_name %]_jspost" style="margin:0px" method="POST">
 762     <input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
 763     </form>
 764     <script src="[% md5_js_path %]"></script>
 765     <script>
 766     if (document.md5_hex) document.[% form_name %].onsubmit = function () {
 767       var f = document.[% form_name %];
 768       var u = f.[% key_user %].value;
 769       var p = f.[% key_pass %].value;
 770       var t = f.[% key_time %].value;
 771       var s = f.[% key_save %] && f.[% key_save %].checked ? -1 : f.[% key_expires_min %].value;
 772       var l = f.[% key_payload %].value;
 773
 774       var str = u+'/'+t+'/'+s+'/'+l;
 775       var sum = document.md5_hex(str +'/' + document.md5_hex(p));
 776
 777       var f2 = document.[% form_name %]_jspost;
 778       f2.[% key_user %].value = str +'/'+ sum;
 779       f2.[% key_redirect %].value = f.[% key_redirect %].value;
 780       f2.action = f.action;
 781       f2.submit();
 782       return false;
 783     }
 784     </script>
 785     [% END ~%]
 786   };
 787 }
 788
 789 ###----------------------------------------------------------------###
 790
 791 package CGI::Ex::Auth::Data;
 792
 793 use strict;
 794 use overload
 795     'bool'   => sub { ! shift->error },
 796     '0+'     => sub { 1 },
 797     '""'     => sub { shift->as_string },
 798     fallback => 1;
 799
 800 sub new {
 801     my ($class, $args) = @_;
 802     return bless {%{ $args || {} }}, $class;
 803 }
 804
 805 sub add_data {
 806     my $self = shift;
 807     my $args = @_ == 1 ? shift : {@_};
 808     @{ $self }{keys %$args} = values %$args;
 809 }
 810
 811 sub error {
 812     my $self = shift;
 813     if (@_ == 1) {
 814         $self->{'error'} = shift;
 815         $self->{'error_caller'} = [caller];
 816     }
 817     return $self->{'error'};
 818 }
 819
 820 sub as_string {
 821     my $self = shift;
 822     return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
 823 }
 824
 825 ###----------------------------------------------------------------###
 826
 827 1;
 828
 829 __END__
 830
 831 =head1 SYNOPSIS
 832
 833     use CGI::Ex::Auth;
 834
 835     ### authorize the user
 836     my $auth = CGI::Ex::Auth->get_valid_auth({
 837         get_pass_by_user => \&get_pass_by_user,
 838     });
 839
 840
 841     sub get_pass_by_user {
 842         my $auth = shift;
 843         my $user = shift;
 844         my $pass = some_way_of_getting_password($user);
 845         return $pass;
 846     }
 847
 848     ### OR - if you are using a OO based CGI or Application
 849
 850     sub require_authentication {
 851         my $self = shift;
 852
 853         return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
 854             get_pass_by_user => sub {
 855                 my ($auth, $user) = @_;
 856                 return $self->get_pass($user);
 857             },
 858         });
 859     }
 860
 861     sub get_pass {
 862         my ($self, $user) = @_;
 863         return $self->loopup_and_cache_pass($user);
 864     }
 865
 866 =head1 DESCRIPTION
 867
 868 CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins.  Auth uses
 869 javascript modules that perform MD5 hashing to cram the password on
 870 the client side before passing them through the internet.
 871
 872 For the stored cookie you can choose to use cram mechanisms,
 873 secure hash cram tokens, auto expiring logins (not cookie based),
 874 and Crypt::Blowfish protection.  You can also choose to keep
 875 passwords plaintext and to use perl's crypt for testing
 876 passwords.
 877
 878 A downside to this module is that it does not use a session to
 879 preserve state so get_pass_by_user has to happen on every request (any
 880 authenticated area has to verify authentication each time).  A plus is
 881 that you don't need to use a session if you don't want to.  It is up
 882 to the interested reader to add caching to the get_pass_by_user
 883 method.
 884
 885 =head1 METHODS
 886
 887 =over 4
 888
 889 =item C<new>
 890
 891 Constructor.  Takes a hashref of properties as arguments.
 892
 893 Many of the methods which may be overridden in a subclass,
 894 or may be passed as properties to the new constuctor such as in the following:
 895
 896     CGI::Ex::Auth->new({
 897         get_pass_by_user => \&my_pass_sub,
 898         key_user         => 'my_user',
 899         key_pass         => 'my_pass',
 900         login_template   => \"<form><input name=my_user ... </form>",
 901     });
 902
 903 The following methods will look for properties of the same name.  Each of these will be
 904 defined separately.
 905
 906     cgix
 907     cleanup_user
 908     cookies
 909     expires_min
 910     form
 911     form_name
 912     get_pass_by_user
 913     js_uri_path
 914     key_cookie
 915     key_expires_min
 916     key_logout
 917     key_pass
 918     key_payload
 919     key_redirect
 920     key_save
 921     key_time
 922     key_user
 923     key_verify
 924     key_loggedout
 925     bounce_on_logout
 926     login_footer
 927     login_form
 928     login_header
 929     login_script
 930     login_template
 931     handle_success
 932     handle_failure
 933     no_cookie_verify
 934     path_info
 935     script_name
 936     secure_hash_keys
 937     template_args
 938     template_include_path
 939     text_user
 940     text_pass
 941     text_save
 942     text_submit
 943     hide_save
 944     use_base64
 945     use_blowfish
 946     use_crypt
 947     use_plaintext
 948     verify_payload
 949     verify_user
 950
 951 =item C<generate_token>
 952
 953 Takes either an auth_data object from a auth_data returned by verify_token,
 954 or a hashref of arguments.
 955
 956 Possible arguments are:
 957
 958     user           - the username we are generating the token for
 959     real_pass      - the password of the user (if use_plaintext is false
 960                      and use_crypt is false, the password can be an md5sum
 961                      of the user's password)
 962     use_blowfish   - indicates that we should use Crypt::Blowfish to protect
 963                      the generated token.  The value of this argument is used
 964                      as the key.  Default is false.
 965     use_base64     - indicates that we should use Base64 encoding to protect
 966                      the generated token.  Default is true.  Will not be
 967                      used if use_blowfish is true.
 968     use_plaintext  - indicates that we should keep the password in plaintext
 969     use_crypt      - also indicates that we should keep the password in plaintext
 970     expires_min    - says how many minutes until the generated token expires.
 971                      Values <= 0 indicate to not ever expire.  Used only on cram
 972                      types.
 973     payload        - a payload that will be passed to generate_payload and then
 974                      will be added to cram type tokens.  It cannot contain a /.
 975     prefer_cram    - If the secure_hash_keys method returns keys, and it is a non-plaintext
 976                      token, generate_token will create a secure_hash_cram.  Set
 977                      this value to true to tell it to use a normal cram.  This
 978                      is generally only useful in testing.
 979
 980 The following are types of tokens that can be generated by generate_token.  Each type includes
 981 pseudocode and a sample of a generated that token.
 982
 983     plaintext:
 984         user         := "paul"
 985         real_pass    := "123qwe"
 986         token        := join("/", user, real_pass);
 987
 988         use_base64   := 0
 989         token        == "paul/123qwe"
 990
 991         use_base64   := 1
 992         token        == "cGF1bC8xMjNxd2U="
 993
 994         use_blowfish := "foobarbaz"
 995         token        == "6da702975190f0fe98a746f0d6514683"
 996
 997         Notes: This token will be used if either use_plaintext or use_crypt is set.
 998         The real_pass can also be the md5_sum of the password.  If real_pass is an md5_sum
 999         of the password but the get_pass_by_user hook returns the crypt'ed password, the
1000         token will not be able to be verified.
1001
1002     cram:
1003         user        := "paul"
1004         real_pass   := "123qwe"
1005         server_time := 1148512991         # a time in seconds since epoch
1006         expires_min := 6 * 60
1007         payload     := "something"
1008
1009         md5_pass    := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1010         str         := join("/", user, server_time, expires_min, payload, md5_pass)
1011         md5_str     := md5(sum_str)
1012         token       := join("/", user, server_time, expires_min, payload, md5_str)
1013
1014         use_base64  := 0
1015         token       == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1016
1017         use_base64  := 1
1018         token       == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1019
1020         Notes: use_blowfish is available as well
1021
1022     secure_hash_cram:
1023         user        := "paul"
1024         real_pass   := "123qwe"
1025         server_time := 1148514034         # a time in seconds since epoch
1026         expires_min := 6 * 60
1027         payload     := "something"
1028         secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1029         rand1       := 3                  # int(rand(length(secure_hash)))
1030         rand2       := 39163              # int(rand(100000))
1031
1032         md5_pass    := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1033
1034         sh_str1     := join(".", "sh", secure_hash[rand1], rand2)
1035         sh_str2     := join(".", "sh", rand1, rand2)
1036         str         := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1037         md5_str     := md5(sum_str)
1038         token       := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1039
1040         use_base64  := 0
1041         token       == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1042
1043         Notes: use_blowfish is available as well.  The secure_hash keys need to be set in the
1044         "secure_hash_keys" property of the CGI::Ex::Auth object.
1045
1046 =item C<get_valid_auth>
1047
1048 Performs the core logic.  Returns an auth object on successful login.
1049 Returns false on errored login (with the details of the error stored in
1050 $@).  If a false value is returned, execution of the CGI should be halted.
1051 get_valid_auth WILL NOT automatically stop execution.
1052
1053   $auth->get_valid_auth || exit;
1054
1055 Optionally, the class and a list of arguments may be passed.  This will create a
1056 new object using the passed arguments, and then run get_valid_auth.
1057
1058   CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1059
1060 =item C<check_valid_auth>
1061
1062 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1063 This allows for obtaining login data without forcing an html login
1064 page to appear.
1065
1066 =item C<login_print>
1067
1068 Called if login errored.  Defaults to printing a very basic (but
1069 adequate) page loaded from login_template..
1070
1071 You will want to override it with a template from your own system.
1072 The hook that is called will be passed the step to print (currently
1073 only "get_login_info" and "no_cookies"), and a hash containing the
1074 form variables as well as the following:
1075
1076 =item C<login_hash_common>
1077
1078 Passed to the template swapped during login_print.
1079
1080     %$form,            # any keys passed to the login script
1081     error              # The text "Login Failed" if a login occurred
1082     login_data         # A login data object if they failed authentication.
1083     key_user           # $self->key_user,        # the username fieldname
1084     key_pass           # $self->key_pass,        # the password fieldname
1085     key_time           # $self->key_time,        # the server time field name
1086     key_save           # $self->key_save,        # the save password checkbox field name
1087     key_payload        # $self->key_payload,     # the payload fieldname
1088     key_redirect       # $self->key_redirect,    # the redirect fieldname
1089     form_name          # $self->form_name,       # the name of the form
1090     script_name        # $self->script_name,     # where the server will post back to
1091     path_info          # $self->path_info,       # $ENV{PATH_INFO} if any
1092     md5_js_path        # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1093     use_plaintext      # $self->use_plaintext,   # used to avoid cramming
1094     $self->key_user    # $data->{'user'},        # the username (if any)
1095     $self->key_pass    # '',                     # intentional blankout
1096     $self->key_time    # $self->server_time,     # the server's time
1097     $self->key_payload # $data->{'payload'}      # the payload (if any)
1098     $self->key_expires_min # $self->expires_min  # how many minutes crams are valid
1099     text_user          # $self->text_user        # template text Username:
1100     text_pass          # $self->text_pass        # template text Password:
1101     text_save          # $self->text_save        # template text Save Password ?
1102     text_submit        # $self->text_submit      # template text Login
1103     hide_save          # $self->hide_save        # 0
1104
1105 =item C<bounce_on_logout>
1106
1107 Default 0.  If true, will location bounce to script returned by logout_redirect
1108 passing the key key_logout.  If false, will simply show the login screen.
1109
1110 =item C<key_loggedout>
1111
1112 Key to bounce with in the form during a logout should bounce_on_logout return true.
1113 Default is "loggedout".
1114
1115 =item C<key_logout>
1116
1117 If the form hash contains a true value in this field name, the current user will
1118 be logged out.  Default is "cea_logout".
1119
1120 =item C<key_cookie>
1121
1122 The name of the auth cookie.  Default is "cea_user".
1123
1124 =item C<key_verify>
1125
1126 A field name used during a bounce to see if cookies exist.  Default is "cea_verify".
1127
1128 =item C<key_user>
1129
1130 The form field name used to pass the username.  Default is "cea_user".
1131
1132 =item C<key_pass>
1133
1134 The form field name used to pass the password.  Default is "cea_pass".
1135
1136 =item C<key_save>
1137
1138 Works in conjunction with key_expires_min.  If key_save is true, then
1139 the cookie will be set to be saved for longer than the current session
1140 (If it is a plaintext variety it will be given a 20 year life rather
1141 than being a session cookie.  If it is a cram variety, the expires_min
1142 portion of the cram will be set to -1).  If it is set to false, the cookie
1143 will be available only for the session (If it is a plaintext variety, the cookie
1144 will be session based and will be removed on the next loggout.  If it is
1145 a cram variety then the cookie will only be good for expires_min minutes.
1146
1147 Default is "cea_save".
1148
1149 =item C<key_expires_min>
1150
1151 The name of the form field that contains how long cram type cookies will be valid
1152 if key_save contains a false value.
1153
1154 Default key name is "cea_expires_min".  Default field value is 6 * 60 (six hours).
1155
1156 This value will have no effect when use_plaintext or use_crypt is set.
1157
1158 A value of -1 means no expiration.
1159
1160 =item C<failed_sleep>
1161
1162 Number of seconds to sleep if the passed tokens are invalid.  Does not apply
1163 if validation failed because of expired tokens.  Default value is 0.
1164 Setting to 0 disables any sleeping.
1165
1166 =item C<form_name>
1167
1168 The name of the html login form to attach the javascript to.  Default is "cea_form".
1169
1170 =item C<verify_token>
1171
1172 This method verifies the token that was passed either via the form or via cookies.
1173 It will accept plaintext or crammed tokens (A listing of the available algorithms
1174 for creating tokes is listed below).  It also allows for armoring the token with
1175 base64 encoding, or using blowfish encryption.  A listing of creating these tokens
1176 can be found under generate_token.
1177
1178 =item C<parse_token>
1179
1180 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1181 Returns true if it was able to parse the passed token.
1182
1183 =item C<cleanup_user>
1184
1185 Called by verify_token.  Default is to do no modification.  Allows for usernames to
1186 be lowercased, or canonized in some other way.  Should return the cleaned username.
1187
1188 =item C<verify_user>
1189
1190 Called by verify_token.  Single argument is the username.  May or may not be an
1191 initial check to see if the username is ok.  The username will already be cleaned at
1192 this point.  Default return is true.
1193
1194 =item C<get_pass_by_user>
1195
1196 Called by verify_token.  Given the cleaned, verified username, should return a
1197 valid password for the user.  It can always return plaintext.  If use_crypt is
1198 enabled, it should return the crypted password.  If use_plaintext and use_crypt
1199 are not enabled, it may return the md5 sum of the password.
1200
1201    get_pass_by_user => sub {
1202        my ($auth_obj, $user) = @_;
1203        my $pass = $some_obj->get_pass({user => $user});
1204        return $pass;
1205    }
1206
1207 Alternately, get_pass_by_user may return a hashref of data items that
1208 will be added to the data object if the token is valid.  The hashref
1209 must also contain a key named real_pass or password that contains the
1210 password.  Note that keys passed back in the hashref that are already
1211 in the data object will override those in the data object.
1212
1213    get_pass_by_user => sub {
1214        my ($auth_obj, $user) = @_;
1215        my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1216        return {
1217            password => $pass,
1218            user_id  => $user_id,
1219        };
1220    }
1221
1222 =item C<verify_password>
1223
1224 Called by verify_token.  Passed the password to check as well as the
1225 auth data object.  Should return true if the password matches.
1226 Default method can handle md5, crypt, cram, secure_hash_cram, and
1227 plaintext (all of the default types supported by generate_token).  If
1228 a property named verify_password exists, it will be used and called as
1229 a coderef rather than using the default method.
1230
1231 =item C<verify_payload>
1232
1233 Called by verify_token.  Passed the password to check as well as the
1234 auth data object.  Should return true if the payload is valid.
1235 Default method returns true without performing any checks on the
1236 payload.  If a property named verify_password exists, it will be used
1237 and called as a coderef rather than using the default method.
1238
1239
1240 =item C<cgix>
1241
1242 Returns a CGI::Ex object.
1243
1244 =item C<form>
1245
1246 A hash of passed form info.  Defaults to CGI::Ex::get_form.
1247
1248 =item C<cookies>
1249
1250 The current cookies.  Defaults to CGI::Ex::get_cookies.
1251
1252 =item C<login_template>
1253
1254 Should return either a template filename to use for the login template, or it
1255 should return a reference to a string that contains the template.  The contents
1256 will be used in login_print and passed to the template engine.
1257
1258 Default login_template is the values of login_header, login_form, login_script, and
1259 login_script concatenated together.
1260
1261 Values from login_hash_common will be passed to the template engine, and will
1262 also be used to fill in the form.
1263
1264 The basic values are capable of handling most needs so long as appropriate
1265 headers and css styles are used.
1266
1267 =item C<login_header>
1268
1269 Should return a header to use in the default login_template.  The default
1270 value will try to PROCESS a file called login_header.tt that should be
1271 located in directory specified by the template_include_path method.
1272
1273 It should ideally supply css styles that format the login_form as desired.
1274
1275 =item C<login_footer>
1276
1277 Same as login_header - but for the footer.  Will look for login_footer.tt by
1278 default.
1279
1280 =item C<login_form>
1281
1282 An html chunk that contains the necessary form fields to login the user.  The
1283 basic chunk has a username text entry, password text entry, save password checkbox,
1284 and submit button, and any hidden fields necessary for logging in the user.
1285
1286 =item C<login_script>
1287
1288 Contains javascript that will attach to the form from login_form.  This script
1289 is capable of taking the login_fields and creating an md5 cram which prevents
1290 the password from being passed plaintext.
1291
1292 =item C<text_user, text_pass, text_save>
1293
1294 The text items shown in the default login template.  The default values are:
1295
1296     text_user  "Username:"
1297     text_pass  "Password:"
1298     text_save  "Save Password ?"
1299
1300 =back
1301
1302 =head1 LICENSE
1303
1304 This module may be distributed under the same terms as Perl itself.
1305
1306 =head1 AUTHORS
1307
1308 Paul Seamons <perl at seamons dot com>
1309
1310 =cut