]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Auth.pm
5e9cbcbb3fdbc7a1e2dbfca37cd15785d0fe60df
5 CGI::Ex::Auth - Handle logins nicely.
9 ###----------------------------------------------------------------###
10 # Copyright 2007 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
15 use vars
qw($VERSION);
17 use MIME
::Base64
qw(encode_base64 decode_base64);
18 use Digest
::MD5
qw(md5_hex);
23 ###----------------------------------------------------------------###
26 my $class = shift || __PACKAGE__
;
27 my $args = shift || {};
28 return bless {%$args}, $class;
33 $self = $self->new(@_) if ! ref $self;
34 delete $self->{'_last_auth_data'};
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" };
43 my $form = $self->form;
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
54 if ($self->bounce_on_logout) {
55 my $key_c = $self->key_cookie;
56 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
57 my $user = $self->last_auth_data ? $self->last_auth_data->{'user'} : undef;
58 $self->location_bounce($self->logout_redirect(defined($user) ? $user : ''));
59 eval { die "Logging out" };
63 $self->handle_failure;
68 ### look first in form, then in cookies for valid tokens
70 foreach ([$form, $self->key_user, 1],
71 [$self->cookies, $self->key_cookie, 0],
73 my ($hash, $key, $is_form) = @$_;
74 next if ! defined $hash->{$key};
75 last if ! $is_form && $had_form_data; # if form info was passed in - we must use it only
76 $had_form_data = 1 if $is_form;
77 next if ! length $hash->{$key};
79 ### if it looks like a bare username (as in they didn't have javascript) - add in other items
81 if ($is_form && delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
82 my $key_u = $self->key_user;
83 $self->new_auth_data({user
=> delete($form->{$key_u})});
87 && $hash->{$key} !~ m
|^[^/]+/| # looks like a cram token
88 && defined $hash->{ $self->key_pass }) {
89 $data = $self->verify_token({
91 user
=> delete $hash->{$key},
92 test_pass
=> delete $hash->{ $self->key_pass },
93 expires_min
=> delete($hash->{ $self->key_save }) ? -1 : delete($hash->{ $self->key_expires_min }) || $self->expires_min,
99 $data = $self->verify_token({token
=> $hash->{$key}, from
=> ($is_form ? 'form' : 'cookie')}) || next;
100 delete $hash->{$key} if $is_form;
103 ### generate a fresh cookie if they submitted info on plaintext types
105 && ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt'))) {
107 key
=> $self->key_cookie,
108 val
=> $self->generate_token($data),
109 no_expires
=> ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving
112 ### always generate a cookie on types that have expiration
115 key
=> $self->key_cookie,
116 val
=> $self->generate_token($data),
122 return $self->handle_success({is_form
=> $is_form});
125 return $self->handle_failure({had_form_data
=> $had_form_data});
130 my $args = shift || {};
131 if (my $meth = $self->{'handle_success'}) {
132 return $meth->($self, $args);
134 my $form = $self->form;
136 ### bounce to redirect
137 if (my $redirect = $form->{ $self->key_redirect }) {
138 $self->location_bounce($redirect);
139 eval { die "Success login - bouncing to redirect" };
142 ### if they have cookies we are done
143 } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
147 ### need to verify cookies are set-able
148 } elsif ($args->{'is_form'}) {
149 $form->{$self->key_verify} = $self->server_time;
150 my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
152 $self->location_bounce($url);
153 eval { die "Success login - bouncing to test cookie" };
160 if (my $meth = $self->{'success_hook'}) {
161 return $meth->($self);
168 if (my $meth = $self->{'logout_hook'}) {
169 return $meth->($self);
176 my $args = shift || {};
177 if (my $meth = $self->{'handle_failure'}) {
178 return $meth->($self, $args);
180 my $form = $self->form;
182 ### make sure the cookie is gone
183 my $key_c = $self->key_cookie;
184 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
186 ### no valid login and we are checking for cookies - see if they have cookies
187 if (my $value = delete $form->{$self->key_verify}) {
188 if (abs(time() - $value) < 15) {
189 $self->no_cookies_print;
194 ### oh - you're still here - well then - ask for login credentials
195 my $key_r = $self->key_redirect;
196 local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
197 local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
199 my $data = $self->last_auth_data;
200 eval { die defined($data) ? $data : "Requesting credentials" };
202 ### allow for a sleep to help prevent brute force
203 sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
211 if (my $meth = $self->{'failure_hook'}) {
212 return $meth->($self);
217 sub check_valid_auth
{
219 $self = $self->new(@_) if ! ref $self;
221 local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
222 local $self->{'login_print'} = sub {}; # check only - don't login if not
223 local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
224 return $self->get_valid_auth;
227 ###----------------------------------------------------------------###
229 sub script_name
{ shift-
>{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
231 sub path_info
{ shift-
>{'path_info'} || $ENV{'PATH_INFO'} || '' }
233 sub server_time
{ time }
237 $self->{'cgix'} = shift if @_ == 1;
238 return $self->{'cgix'} ||= CGI
::Ex-
>new;
243 $self->{'form'} = shift if @_ == 1;
244 return $self->{'form'} ||= $self->cgix->get_form;
249 $self->{'cookies'} = shift if @_ == 1;
250 return $self->{'cookies'} ||= $self->cgix->get_cookies;
256 return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
257 my $key = $args->{'key'};
258 $self->cgix->set_cookie({
264 delete $self->cookies->{$key};
270 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
271 my $key = $args->{'key'};
272 my $val = $args->{'val'};
273 $self->cgix->set_cookie({
276 ($args->{'no_expires'} ? () : (-expires
=> '+20y')), # let the expires time take care of things for types that self expire
279 $self->cookies->{$key} = $val;
282 sub location_bounce
{
285 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
286 return $self->cgix->location_bounce($url);
289 ###----------------------------------------------------------------###
291 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
292 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
293 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
294 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
295 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
296 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
297 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
298 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
299 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
300 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
301 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
302 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
303 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
304 #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"}'
305 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
306 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
307 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
308 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
309 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
310 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
311 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
312 sub disable_simple_cram
{ shift-
>{'disable_simple_cram'} }
314 sub logout_redirect
{
315 my ($self, $user) = @_;
316 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
317 return $self->{'logout_redirect'} || $self->script_name ."?$form";
322 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
325 ###----------------------------------------------------------------###
327 sub no_cookies_print
{
329 $self->cgix->print_content_type;
330 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
336 my $hash = $self->login_hash_common;
337 my $template = $self->login_template;
339 ### allow for a hooked override
340 if (my $meth = $self->{'login_print'}) {
341 $meth->($self, $template, $hash);
345 ### process the document
346 require CGI
::Ex
::Template
;
347 my $cet = CGI
::Ex
::Template-
>new($self->template_args);
349 $cet->process_simple($template, $hash, \
$out) || die $cet->error;
351 ### fill in form fields
352 require CGI
::Ex
::Fill
;
353 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
356 $self->cgix->print_content_type;
364 return $self->{'template_args'} ||= {
365 INCLUDE_PATH
=> $self->template_include_path,
369 sub template_include_path
{ shift-
>{'template_include_path'} || '' }
371 sub login_hash_common
{
373 my $form = $self->form;
374 my $data = $self->last_auth_data || {};
378 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
380 key_user
=> $self->key_user,
381 key_pass
=> $self->key_pass,
382 key_time
=> $self->key_time,
383 key_save
=> $self->key_save,
384 key_expires_min
=> $self->key_expires_min,
385 key_redirect
=> $self->key_redirect,
386 form_name
=> $self->form_name,
387 script_name
=> $self->script_name,
388 path_info
=> $self->path_info,
389 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
390 $self->key_user => $data->{'user'} || '',
391 $self->key_pass => '', # don't allow for this to get filled into the form
392 $self->key_time => $self->server_time,
393 $self->key_expires_min => $self->expires_min,
394 text_user
=> $self->text_user,
395 text_pass
=> $self->text_pass,
396 text_save
=> $self->text_save,
397 text_submit
=> $self->text_submit,
398 hide_save
=> $self->hide_save,
402 ###----------------------------------------------------------------###
407 my $token = delete $args->{'token'}; die "Missing token" if ! length $token;
408 my $data = $self->new_auth_data({token
=> $token, %$args});
411 ### make sure the token is parsed to usable data
412 if (ref $token) { # token already parsed
413 $data->add_data({%$token, armor
=> 'none'});
415 } elsif (my $meth = $self->{'parse_token'}) {
416 if (! $meth->($self, $args)) {
417 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
421 if (! $self->parse_token($token, $data)) {
422 $data->error('Invalid token') if ! $data->error; # add error if not already added
429 if (! defined($data->{'user'})) {
430 $data->error('Missing user');
432 } elsif (! defined $data->{'test_pass'}) {
433 $data->error('Missing test_pass');
435 } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
436 $data->error('Invalid user');
439 return $data if $data->error;
443 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
444 $data->add_data({details
=> $@});
445 $data->error('Could not get pass');
446 } elsif (ref $pass eq 'HASH') {
448 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
449 : exists($extra->{'password'}) ? delete($extra->{'password'})
450 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
451 $data->error('Invalid login') if ! defined $pass && ! $data->error;
452 $data->add_data($extra);
454 return $data if $data->error;
455 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
458 ### validate the pass
459 if ($meth = $self->{'verify_password'}) {
460 if (! $meth->($self, $pass, $data)) {
461 $data->error('Password failed verification') if ! $data->error;
464 if (! $self->verify_password($pass, $data)) {
465 $data->error('Password failed verification') if ! $data->error;
468 return $data if $data->error;
471 ### validate the payload
472 if ($meth = $self->{'verify_payload'}) {
473 if (! $meth->($self, $data->{'payload'}, $data)) {
474 $data->error('Payload failed custom verification') if ! $data->error;
477 if (! $self->verify_payload($data->{'payload'}, $data)) {
478 $data->error('Payload failed verification') if ! $data->error;
487 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
491 my ($self, $token, $data) = @_;
494 for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
495 my $copy = ($armor eq 'none') ? $token
496 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
497 : ($key = $self->use_blowfish) ? decrypt_blowfish
($token, $key)
499 if ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
506 secure_hash
=> $6 || '',
511 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
524 sub verify_password
{
525 my ($self, $pass, $data) = @_;
528 ### looks like a secure_hash cram
529 if ($data->{'secure_hash'}) {
530 $data->add_data(type
=> 'secure_hash_cram');
531 my $array = eval {$self->secure_hash_keys };
533 $err = 'secure_hash_keys not found';
534 } elsif (! @$array) {
535 $err = 'secure_hash_keys empty';
536 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
537 $err = 'Invalid secure hash';
541 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
542 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
543 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
544 if ($data->{'expires_min'} > 0
545 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
546 $err = 'Login expired';
547 } elsif (lc($data->{'test_pass'}) ne $sum) {
548 $err = 'Invalid login';
552 ### looks like a simple_cram
553 } elsif ($data->{'cram_time'}) {
554 $data->add_data(type
=> 'simple_cram');
555 die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
556 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
557 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
558 my $sum = md5_hex
($str .'/'. $real);
559 if ($data->{'expires_min'} > 0
560 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
561 $err = 'Login expired';
562 } elsif (lc($data->{'test_pass'}) ne $sum) {
563 $err = 'Invalid login';
567 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
568 && crypt($data->{'test_pass'}, $1) eq $pass) {
569 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
571 ### failed plaintext crypt
572 } elsif ($self->use_crypt) {
573 $err = 'Invalid login';
574 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
576 ### plaintext and md5
578 my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
579 my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
580 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
581 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
582 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
583 $err = 'Invalid login'
587 $data->error($err) if $err;
591 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
595 my $data = shift || $self->last_auth_data;
596 die "Can't generate a token off of a failed auth" if ! $data;
600 ### do kinds that require staying plaintext
601 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
602 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
603 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
604 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
605 $token = $data->{'user'} .'/'. $pass;
607 ### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
609 my $user = $data->{'user'} || die "Missing user";
610 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
611 : die "Missing real_pass";
612 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
613 my $load = $self->generate_payload($data);
614 die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m
|/|;
615 die "User can not contain a \"/\." if $user =~ m
|/|;
618 if (! $data->{'prefer_simple_cram'}
619 && ($array = eval { $self->secure_hash_keys })
621 my $rand1 = int(rand @$array);
622 my $rand2 = int(rand 100000);
623 my $str = join("/", $user, $self->server_time, $exp, $load);
624 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
625 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
627 die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
628 my $str = join("/", $user, $self->server_time, $exp, $load);
629 my $sum = md5_hex
($str .'/'. $real);
630 $token = $str .'/'. $sum;
634 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
635 $token = encrypt_blowfish
($token, $key);
637 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
638 $token = encode_base64
($token, '');
644 sub generate_payload
{
647 if (my $meth = $self->{'generate_payload'}) {
648 return $meth->($self, $args);
650 return defined($args->{'payload'}) ? $args->{'payload'} : '';
656 if (my $meth = $self->{'verify_user'}) {
657 return $meth->($self, $user);
665 if (my $meth = $self->{'cleanup_user'}) {
666 return $meth->($self, $user);
671 sub get_pass_by_user
{
674 if (my $meth = $self->{'get_pass_by_user'}) {
675 return $meth->($self, $user);
678 die "Please override get_pass_by_user";
682 my ($self, $payload, $data) = @_;
683 if (my $meth = $self->{'verify_payload'}) {
684 return $meth->($self, $payload, $data);
689 ###----------------------------------------------------------------###
691 sub encrypt_blowfish
{
692 my ($str, $key) = @_;
694 require Crypt
::Blowfish
;
695 my $cb = Crypt
::Blowfish-
>new($key);
697 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
700 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
705 sub decrypt_blowfish
{
706 my ($enc, $key) = @_;
708 require Crypt
::Blowfish
;
709 my $cb = Crypt
::Blowfish-
>new($key);
712 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
718 ###----------------------------------------------------------------###
722 return $self->{'login_template'} if $self->{'login_template'};
725 . $self->login_header
727 . $self->login_script
728 . $self->login_footer;
733 return shift-
>{'login_header'} || q
{
734 [%~ TRY
; PROCESS
'login_header.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
739 return shift-
>{'login_footer'} || q
{
740 [%~ TRY
; PROCESS
'login_footer.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
745 return shift-
>{'login_form'} || q
{
746 <div
class="login_chunk">
747 <span
class="login_error">[% error
%]</span
>
748 <form
class="login_form" name
="[% form_name %]" method="POST" action
="[% script_name %][% path_info %]">
749 <input type
="hidden" name
="[% key_redirect %]" value
="">
750 <input type
="hidden" name
="[% key_time %]" value
="">
751 <input type
="hidden" name
="[% key_expires_min %]" value
="">
752 <table
class="login_table">
753 <tr
class="login_username">
754 <td
>[% text_user
%]</td
>
755 <td
><input name
="[% key_user %]" type
="text" size
="30" value
=""></td
>
757 <tr
class="login_password">
758 <td
>[% text_pass
%]</td
>
759 <td
><input name
="[% key_pass %]" type
="password" size
="30" value
=""></td
>
761 [% IF
! hide_save
~%]
762 <tr
class="login_save">
764 <input type
="checkbox" name
="[% key_save %]" value
="1"> [% text_save
%]
768 <tr
class="login_submit">
769 <td colspan
="2" align
="right">
770 <input type
="submit" value
="[% text_submit %]">
779 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
780 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
781 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
782 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
783 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
787 return $self->{'login_script'} if $self->{'login_script'};
788 return '' if $self->use_plaintext || $self->disable_simple_cram;
790 <form name
="[% form_name %]_jspost" style
="margin:0px" method="POST">
791 <input type
="hidden" name
="[% key_user %]"><input type
="hidden" name
="[% key_redirect %]">
793 <script src
="[% md5_js_path %]"></script
>
795 if (document
.md5_hex
) document
.[% form_name
%].onsubmit
= function
() {
796 var f
= document
.[% form_name
%];
797 var u
= f
.[% key_user
%].value
;
798 var p
= f
.[% key_pass
%].value
;
799 var t
= f
.[% key_time
%].value
;
800 var s
= f
.[% key_save
%] && f
.[% key_save
%].checked
? -1 : f
.[% key_expires_min
%].value
;
802 var str
= u
+'/'+t
+'/'+s
+'/'+'';
803 var sum
= document
.md5_hex
(str
+'/' + document
.md5_hex
(p
));
805 var f2
= document
.[% form_name
%]_jspost
;
806 f2
.[% key_user
%].value
= str
+'/'+ sum
;
807 f2
.[% key_redirect
%].value
= f
.[% key_redirect
%].value
;
808 f2
.action
= f
.action
;
816 ###----------------------------------------------------------------###
818 package CGI
::Ex
::Auth
::Data
;
822 'bool' => sub { ! shift-
>error },
824 '""' => sub { shift-
>as_string },
828 my ($class, $args) = @_;
829 return bless {%{ $args || {} }}, $class;
834 my $args = @_ == 1 ? shift : {@_};
835 @{ $self }{keys %$args} = values %$args;
841 $self->{'error'} = shift;
842 $self->{'error_caller'} = [caller];
844 return $self->{'error'};
849 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
852 ###----------------------------------------------------------------###
862 ### authorize the user
863 my $auth = CGI::Ex::Auth->get_valid_auth({
864 get_pass_by_user => \&get_pass_by_user,
868 sub get_pass_by_user {
871 my $pass = some_way_of_getting_password($user);
875 ### OR - if you are using a OO based CGI or Application
877 sub require_authentication {
880 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
881 get_pass_by_user => sub {
882 my ($auth, $user) = @_;
883 return $self->get_pass($user);
889 my ($self, $user) = @_;
890 return $self->loopup_and_cache_pass($user);
895 CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins. Auth uses
896 javascript modules that perform MD5 hashing to cram the password on
897 the client side before passing them through the internet.
899 For the stored cookie you can choose to use simple cram mechanisms,
900 secure hash cram tokens, auto expiring logins (not cookie based),
901 and Crypt::Blowfish protection. You can also choose to keep
902 passwords plaintext and to use perl's crypt for testing
905 A downside to this module is that it does not use a session to
906 preserve state so get_pass_by_user has to happen on every request (any
907 authenticated area has to verify authentication each time). A plus is
908 that you don't need to use a session if you don't want to. It is up
909 to the interested reader to add caching to the get_pass_by_user
918 Constructor. Takes a hashref of properties as arguments.
920 Many of the methods which may be overridden in a subclass,
921 or may be passed as properties to the new constuctor such as in the following:
924 get_pass_by_user => \&my_pass_sub,
925 key_user => 'my_user',
926 key_pass => 'my_pass',
927 login_header => \"<h1>My Login</h1>",
930 The following methods will look for properties of the same name. Each of these will be
931 described separately.
967 template_include_path
980 =item C<generate_token>
982 Takes either an auth_data object from a auth_data returned by verify_token,
983 or a hashref of arguments.
985 Possible arguments are:
987 user - the username we are generating the token for
988 real_pass - the password of the user (if use_plaintext is false
989 and use_crypt is false, the password can be an md5sum
990 of the user's password)
991 use_blowfish - indicates that we should use Crypt::Blowfish to protect
992 the generated token. The value of this argument is used
993 as the key. Default is false.
994 use_base64 - indicates that we should use Base64 encoding to protect
995 the generated token. Default is true. Will not be
996 used if use_blowfish is true.
997 use_plaintext - indicates that we should keep the password in plaintext
998 use_crypt - also indicates that we should keep the password in plaintext
999 expires_min - says how many minutes until the generated token expires.
1000 Values <= 0 indicate to not ever expire. Used only on cram
1002 payload - a payload that will be passed to generate_payload and then
1003 will be added to cram type tokens. It cannot contain a /.
1005 - If the secure_hash_keys method returns keys, and it is a non-plaintext
1006 token, generate_token will create a secure_hash_cram. Set
1007 this value to true to tell it to use a simple_cram. This
1008 is generally only useful in testing.
1010 The following are types of tokens that can be generated by generate_token. Each type includes
1011 pseudocode and a sample of a generated that token.
1015 real_pass := "123qwe"
1016 token := join("/", user, real_pass);
1019 token == "paul/123qwe"
1022 token == "cGF1bC8xMjNxd2U="
1024 use_blowfish := "foobarbaz"
1025 token == "6da702975190f0fe98a746f0d6514683"
1027 Notes: This token will be used if either use_plaintext or use_crypt is set.
1028 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1029 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1030 token will not be able to be verified.
1034 real_pass := "123qwe"
1035 server_time := 1148512991 # a time in seconds since epoch
1036 expires_min := 6 * 60
1037 payload := "something"
1039 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1040 str := join("/", user, server_time, expires_min, payload, md5_pass)
1041 md5_str := md5(sum_str)
1042 token := join("/", user, server_time, expires_min, payload, md5_str)
1045 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1048 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1050 Notes: use_blowfish is available as well
1054 real_pass := "123qwe"
1055 server_time := 1148514034 # a time in seconds since epoch
1056 expires_min := 6 * 60
1057 payload := "something"
1058 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1059 rand1 := 3 # int(rand(length(secure_hash)))
1060 rand2 := 39163 # int(rand(100000))
1062 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1064 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1065 sh_str2 := join(".", "sh", rand1, rand2)
1066 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1067 md5_str := md5(sum_str)
1068 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1071 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1073 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1074 "secure_hash_keys" property of the CGI::Ex::Auth object.
1076 =item C<get_valid_auth>
1078 Performs the core logic. Returns an auth object on successful login.
1079 Returns false on errored login (with the details of the error stored in
1080 $@). If a false value is returned, execution of the CGI should be halted.
1081 get_valid_auth WILL NOT automatically stop execution.
1083 $auth->get_valid_auth || exit;
1085 Optionally, the class and a list of arguments may be passed. This will create a
1086 new object using the passed arguments, and then run get_valid_auth.
1088 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1090 =item C<check_valid_auth>
1092 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1093 This allows for obtaining login data without forcing an html login
1096 =item C<login_print>
1098 Called if login errored. Defaults to printing a very basic (but
1099 adequate) page loaded from login_template..
1101 You will want to override it with a template from your own system.
1102 The hook that is called will be passed the step to print (currently
1103 only "get_login_info" and "no_cookies"), and a hash containing the
1104 form variables as well as the following:
1106 =item C<login_hash_common>
1108 Passed to the template swapped during login_print.
1110 %$form, # any keys passed to the login script
1111 error # The text "Login Failed" if a login occurred
1112 login_data # A login data object if they failed authentication.
1113 key_user # $self->key_user, # the username fieldname
1114 key_pass # $self->key_pass, # the password fieldname
1115 key_time # $self->key_time, # the server time field name
1116 key_save # $self->key_save, # the save password checkbox field name
1117 key_redirect # $self->key_redirect, # the redirect fieldname
1118 form_name # $self->form_name, # the name of the form
1119 script_name # $self->script_name, # where the server will post back to
1120 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1121 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1122 $self->key_user # $data->{'user'}, # the username (if any)
1123 $self->key_pass # '', # intentional blankout
1124 $self->key_time # $self->server_time, # the server's time
1125 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1126 text_user # $self->text_user # template text Username:
1127 text_pass # $self->text_pass # template text Password:
1128 text_save # $self->text_save # template text Save Password ?
1129 text_submit # $self->text_submit # template text Login
1130 hide_save # $self->hide_save # 0
1132 =item C<bounce_on_logout>
1134 Default 0. If true, will location bounce to script returned by logout_redirect
1135 passing the key key_logout. If false, will simply show the login screen.
1137 =item C<key_loggedout>
1139 Key to bounce with in the form during a logout should bounce_on_logout return true.
1140 Default is "loggedout".
1144 If the form hash contains a true value in this field name, the current user will
1145 be logged out. Default is "cea_logout".
1149 The name of the auth cookie. Default is "cea_user".
1153 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1157 The form field name used to pass the username. Default is "cea_user".
1161 The form field name used to pass the password. Default is "cea_pass".
1165 Works in conjunction with key_expires_min. If key_save is true, then
1166 the cookie will be set to be saved for longer than the current session
1167 (If it is a plaintext variety it will be given a 20 year life rather
1168 than being a session cookie. If it is a cram variety, the expires_min
1169 portion of the cram will be set to -1). If it is set to false, the cookie
1170 will be available only for the session (If it is a plaintext variety, the cookie
1171 will be session based and will be removed on the next loggout. If it is
1172 a cram variety then the cookie will only be good for expires_min minutes.
1174 Default is "cea_save".
1176 =item C<key_expires_min>
1178 The name of the form field that contains how long cram type cookies will be valid
1179 if key_save contains a false value.
1181 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1183 This value will have no effect when use_plaintext or use_crypt is set.
1185 A value of -1 means no expiration.
1187 =item C<failed_sleep>
1189 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1190 if validation failed because of expired tokens. Default value is 0.
1191 Setting to 0 disables any sleeping.
1195 The name of the html login form to attach the javascript to. Default is "cea_form".
1197 =item C<verify_token>
1199 This method verifies the token that was passed either via the form or via cookies.
1200 It will accept plaintext or crammed tokens (A listing of the available algorithms
1201 for creating tokes is listed below). It also allows for armoring the token with
1202 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1203 can be found under generate_token.
1205 =item C<parse_token>
1207 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1208 Returns true if it was able to parse the passed token.
1210 =item C<cleanup_user>
1212 Called by verify_token. Default is to do no modification. Allows for usernames to
1213 be lowercased, or canonized in some other way. Should return the cleaned username.
1215 =item C<verify_user>
1217 Called by verify_token. Single argument is the username. May or may not be an
1218 initial check to see if the username is ok. The username will already be cleaned at
1219 this point. Default return is true.
1221 =item C<get_pass_by_user>
1223 Called by verify_token. Given the cleaned, verified username, should return a
1224 valid password for the user. It can always return plaintext. If use_crypt is
1225 enabled, it should return the crypted password. If use_plaintext and use_crypt
1226 are not enabled, it may return the md5 sum of the password.
1228 get_pass_by_user => sub {
1229 my ($auth_obj, $user) = @_;
1230 my $pass = $some_obj->get_pass({user => $user});
1234 Alternately, get_pass_by_user may return a hashref of data items that
1235 will be added to the data object if the token is valid. The hashref
1236 must also contain a key named real_pass or password that contains the
1237 password. Note that keys passed back in the hashref that are already
1238 in the data object will override those in the data object.
1240 get_pass_by_user => sub {
1241 my ($auth_obj, $user) = @_;
1242 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1245 user_id => $user_id,
1249 =item C<verify_password>
1251 Called by verify_token. Passed the password to check as well as the
1252 auth data object. Should return true if the password matches.
1253 Default method can handle md5, crypt, cram, secure_hash_cram, and
1254 plaintext (all of the default types supported by generate_token). If
1255 a property named verify_password exists, it will be used and called as
1256 a coderef rather than using the default method.
1258 =item C<verify_payload>
1260 Called by verify_token. Passed the password to check as well as the
1261 auth data object. Should return true if the payload is valid.
1262 Default method returns true without performing any checks on the
1263 payload. If a property named verify_password exists, it will be used
1264 and called as a coderef rather than using the default method.
1269 Returns a CGI::Ex object.
1273 A hash of passed form info. Defaults to CGI::Ex::get_form.
1277 The current cookies. Defaults to CGI::Ex::get_cookies.
1279 =item C<login_template>
1281 Should return either a template filename to use for the login template, or it
1282 should return a reference to a string that contains the template. The contents
1283 will be used in login_print and passed to the template engine.
1285 Default login_template is the values of login_header, login_form, login_script, and
1286 login_script concatenated together.
1288 Values from login_hash_common will be passed to the template engine, and will
1289 also be used to fill in the form.
1291 The basic values are capable of handling most needs so long as appropriate
1292 headers and css styles are used.
1294 =item C<login_header>
1296 Should return a header to use in the default login_template. The default
1297 value will try to PROCESS a file called login_header.tt that should be
1298 located in directory specified by the template_include_path method.
1300 It should ideally supply css styles that format the login_form as desired.
1302 =item C<login_footer>
1304 Same as login_header - but for the footer. Will look for login_footer.tt by
1309 An html chunk that contains the necessary form fields to login the user. The
1310 basic chunk has a username text entry, password text entry, save password checkbox,
1311 and submit button, and any hidden fields necessary for logging in the user.
1313 =item C<login_script>
1315 Contains javascript that will attach to the form from login_form. This script
1316 is capable of taking the login_fields and creating an md5 cram which prevents
1317 the password from being passed plaintext.
1319 =item C<text_user, text_pass, text_save>
1321 The text items shown in the default login template. The default values are:
1323 text_user "Username:"
1324 text_pass "Password:"
1325 text_save "Save Password ?"
1327 =item C<disable_simple_cram>
1329 Disables simple cram type from being an available type. Default is
1330 false. If set, then one of use_plaintext, use_crypt, or
1331 secure_hash_keys should be set. Setting this option allows for
1332 payloads to be generated by the server only - otherwise a user who
1333 understands the algorithm could generate a valid simple_cram cookie
1334 with a custom payload.
1336 Another option would be to only accept payloads from tokens if use_blowfish
1337 is set and armor was equal to "blowfish."
1343 This module may be distributed under the same terms as Perl itself.
1347 Paul Seamons <perl at seamons dot com>
This page took 0.148677 seconds and 4 git commands to generate.