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