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