]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Auth.pm
2dd895debd86b62410bf600898e4792b1fa41ebd
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;
78 ### if it looks like a bare username (as in they didn't have javascript) - add in other items
80 if ($is_form && delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
81 my $key_u = $self->key_user;
82 $self->new_auth_data({user
=> delete($form->{$key_u})});
86 && $hash->{$key} !~ m
|^[^/]+/| # looks like a cram token
87 && defined $hash->{ $self->key_pass }) {
88 $data = $self->verify_token({
90 user
=> delete $hash->{$key},
91 test_pass
=> delete $hash->{ $self->key_pass },
92 expires_min
=> delete($hash->{ $self->key_save }) ? -1 : delete($hash->{ $self->key_expires_min }) || $self->expires_min,
98 $data = $self->verify_token({token
=> $hash->{$key}, from
=> ($is_form ? 'form' : 'cookie')}) || next;
99 delete $hash->{$key} if $is_form;
102 ### generate a fresh cookie if they submitted info on plaintext types
104 && ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt'))) {
106 key
=> $self->key_cookie,
107 val
=> $self->generate_token($data),
108 no_expires
=> ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving
111 ### always generate a cookie on types that have expiration
114 key
=> $self->key_cookie,
115 val
=> $self->generate_token($data),
121 return $self->handle_success({is_form
=> $is_form});
124 return $self->handle_failure({had_form_data
=> $had_form_data});
129 my $args = shift || {};
130 if (my $meth = $self->{'handle_success'}) {
131 return $meth->($self, $args);
133 my $form = $self->form;
135 ### bounce to redirect
136 if (my $redirect = $form->{ $self->key_redirect }) {
137 $self->location_bounce($redirect);
138 eval { die "Success login - bouncing to redirect" };
141 ### if they have cookies we are done
142 } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
146 ### need to verify cookies are set-able
147 } elsif ($args->{'is_form'}) {
148 $form->{$self->key_verify} = $self->server_time;
149 my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
151 $self->location_bounce($url);
152 eval { die "Success login - bouncing to test cookie" };
159 if (my $meth = $self->{'success_hook'}) {
160 return $meth->($self);
167 if (my $meth = $self->{'logout_hook'}) {
168 return $meth->($self);
175 my $args = shift || {};
176 if (my $meth = $self->{'handle_failure'}) {
177 return $meth->($self, $args);
179 my $form = $self->form;
181 ### make sure the cookie is gone
182 my $key_c = $self->key_cookie;
183 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
185 ### no valid login and we are checking for cookies - see if they have cookies
186 if (my $value = delete $form->{$self->key_verify}) {
187 if (abs(time() - $value) < 15) {
188 $self->no_cookies_print;
193 ### oh - you're still here - well then - ask for login credentials
194 my $key_r = $self->key_redirect;
195 local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
196 local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
198 my $data = $self->last_auth_data;
199 eval { die defined($data) ? $data : "Requesting credentials" };
201 ### allow for a sleep to help prevent brute force
202 sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
210 if (my $meth = $self->{'failure_hook'}) {
211 return $meth->($self);
216 sub check_valid_auth
{
218 $self = $self->new(@_) if ! ref $self;
220 local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
221 local $self->{'login_print'} = sub {}; # check only - don't login if not
222 local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
223 return $self->get_valid_auth;
226 ###----------------------------------------------------------------###
228 sub script_name
{ shift-
>{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
230 sub path_info
{ shift-
>{'path_info'} || $ENV{'PATH_INFO'} || '' }
232 sub server_time
{ time }
236 $self->{'cgix'} = shift if @_ == 1;
237 return $self->{'cgix'} ||= CGI
::Ex-
>new;
242 $self->{'form'} = shift if @_ == 1;
243 return $self->{'form'} ||= $self->cgix->get_form;
248 $self->{'cookies'} = shift if @_ == 1;
249 return $self->{'cookies'} ||= $self->cgix->get_cookies;
255 return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
256 my $key = $args->{'key'};
257 $self->cgix->set_cookie({
263 delete $self->cookies->{$key};
269 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
270 my $key = $args->{'key'};
271 my $val = $args->{'val'};
272 $self->cgix->set_cookie({
275 ($args->{'no_expires'} ? () : (-expires
=> '+20y')), # let the expires time take care of things for types that self expire
278 $self->cookies->{$key} = $val;
281 sub location_bounce
{
284 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
285 return $self->cgix->location_bounce($url);
288 ###----------------------------------------------------------------###
290 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
291 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
292 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
293 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
294 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
295 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
296 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
297 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
298 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
299 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
300 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
301 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
302 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
303 #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"}'
304 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
305 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
306 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
307 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
308 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
309 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
310 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
311 sub disable_simple_cram
{ shift-
>{'disable_simple_cram'} }
313 sub logout_redirect
{
314 my ($self, $user) = @_;
315 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
316 return $self->{'logout_redirect'} || $self->script_name ."?$form";
321 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
324 ###----------------------------------------------------------------###
326 sub no_cookies_print
{
328 $self->cgix->print_content_type;
329 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
335 my $hash = $self->login_hash_common;
336 my $template = $self->login_template;
338 ### allow for a hooked override
339 if (my $meth = $self->{'login_print'}) {
340 $meth->($self, $template, $hash);
344 ### process the document
345 require CGI
::Ex
::Template
;
346 my $cet = CGI
::Ex
::Template-
>new($self->template_args);
348 $cet->process_simple($template, $hash, \
$out) || die $cet->error;
350 ### fill in form fields
351 require CGI
::Ex
::Fill
;
352 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
355 $self->cgix->print_content_type;
363 return $self->{'template_args'} ||= {
364 INCLUDE_PATH
=> $self->template_include_path,
368 sub template_include_path
{ shift-
>{'template_include_path'} || '' }
370 sub login_hash_common
{
372 my $form = $self->form;
373 my $data = $self->last_auth_data || {};
377 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
379 key_user
=> $self->key_user,
380 key_pass
=> $self->key_pass,
381 key_time
=> $self->key_time,
382 key_save
=> $self->key_save,
383 key_expires_min
=> $self->key_expires_min,
384 key_redirect
=> $self->key_redirect,
385 form_name
=> $self->form_name,
386 script_name
=> $self->script_name,
387 path_info
=> $self->path_info,
388 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
389 $self->key_user => $data->{'user'} || '',
390 $self->key_pass => '', # don't allow for this to get filled into the form
391 $self->key_time => $self->server_time,
392 $self->key_expires_min => $self->expires_min,
393 text_user
=> $self->text_user,
394 text_pass
=> $self->text_pass,
395 text_save
=> $self->text_save,
396 text_submit
=> $self->text_submit,
397 hide_save
=> $self->hide_save,
401 ###----------------------------------------------------------------###
406 my $token = delete $args->{'token'} || die "Missing token";
407 my $data = $self->new_auth_data({token
=> $token, %$args});
410 ### make sure the token is parsed to usable data
411 if (ref $token) { # token already parsed
412 $data->add_data({%$token, armor
=> 'none'});
414 } elsif (my $meth = $self->{'parse_token'}) {
415 if (! $meth->($self, $args)) {
416 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
420 if (! $self->parse_token($token, $data)) {
421 $data->error('Invalid token') if ! $data->error; # add error if not already added
428 if (! defined($data->{'user'})) {
429 $data->error('Missing user');
431 } elsif (! defined $data->{'test_pass'}) {
432 $data->error('Missing test_pass');
434 } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
435 $data->error('Invalid user');
438 return $data if $data->error;
442 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
443 $data->add_data({details
=> $@});
444 $data->error('Could not get pass');
445 } elsif (ref $pass eq 'HASH') {
447 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
448 : exists($extra->{'password'}) ? delete($extra->{'password'})
449 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
450 $data->error('Invalid login') if ! defined $pass && ! $data->error;
451 $data->add_data($extra);
453 return $data if $data->error;
454 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
457 ### validate the pass
458 if ($meth = $self->{'verify_password'}) {
459 if (! $meth->($self, $pass, $data)) {
460 $data->error('Password failed verification') if ! $data->error;
463 if (! $self->verify_password($pass, $data)) {
464 $data->error('Password failed verification') if ! $data->error;
467 return $data if $data->error;
470 ### validate the payload
471 if ($meth = $self->{'verify_payload'}) {
472 if (! $meth->($self, $data->{'payload'}, $data)) {
473 $data->error('Payload failed custom verification') if ! $data->error;
476 if (! $self->verify_payload($data->{'payload'}, $data)) {
477 $data->error('Payload failed verification') if ! $data->error;
486 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
490 my ($self, $token, $data) = @_;
493 for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
494 my $copy = ($armor eq 'none') ? $token
495 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
496 : ($key = $self->use_blowfish) ? decrypt_blowfish
($token, $key)
498 if ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
505 secure_hash
=> $6 || '',
510 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
523 sub verify_password
{
524 my ($self, $pass, $data) = @_;
527 ### looks like a secure_hash cram
528 if ($data->{'secure_hash'}) {
529 $data->add_data(type
=> 'secure_hash_cram');
530 my $array = eval {$self->secure_hash_keys };
532 $err = 'secure_hash_keys not found';
533 } elsif (! @$array) {
534 $err = 'secure_hash_keys empty';
535 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
536 $err = 'Invalid secure hash';
540 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
541 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
542 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
543 if ($data->{'expires_min'} > 0
544 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
545 $err = 'Login expired';
546 } elsif (lc($data->{'test_pass'}) ne $sum) {
547 $err = 'Invalid login';
551 ### looks like a simple_cram
552 } elsif ($data->{'cram_time'}) {
553 $data->add_data(type
=> 'simple_cram');
554 die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
555 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
556 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
557 my $sum = md5_hex
($str .'/'. $real);
558 if ($data->{'expires_min'} > 0
559 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
560 $err = 'Login expired';
561 } elsif (lc($data->{'test_pass'}) ne $sum) {
562 $err = 'Invalid login';
566 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
567 && crypt($data->{'test_pass'}, $1) eq $pass) {
568 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
570 ### failed plaintext crypt
571 } elsif ($self->use_crypt) {
572 $err = 'Invalid login';
573 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
575 ### plaintext and md5
577 my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
578 my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
579 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
580 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
581 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
582 $err = 'Invalid login'
586 $data->error($err) if $err;
590 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
594 my $data = shift || $self->last_auth_data;
595 die "Can't generate a token off of a failed auth" if ! $data;
599 ### do kinds that require staying plaintext
600 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
601 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
602 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
603 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
604 $token = $data->{'user'} .'/'. $pass;
606 ### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
608 my $user = $data->{'user'} || die "Missing user";
609 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
610 : die "Missing real_pass";
611 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
612 my $load = $self->generate_payload($data);
613 die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m
|/|;
614 die "User can not contain a \"/\." if $user =~ m
|/|;
617 if (! $data->{'prefer_simple_cram'}
618 && ($array = eval { $self->secure_hash_keys })
620 my $rand1 = int(rand @$array);
621 my $rand2 = int(rand 100000);
622 my $str = join("/", $user, $self->server_time, $exp, $load);
623 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
624 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
626 die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
627 my $str = join("/", $user, $self->server_time, $exp, $load);
628 my $sum = md5_hex
($str .'/'. $real);
629 $token = $str .'/'. $sum;
633 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
634 $token = encrypt_blowfish
($token, $key);
636 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
637 $token = encode_base64
($token, '');
643 sub generate_payload
{
646 if (my $meth = $self->{'generate_payload'}) {
647 return $meth->($self, $args);
649 return defined($args->{'payload'}) ? $args->{'payload'} : '';
655 if (my $meth = $self->{'verify_user'}) {
656 return $meth->($self, $user);
664 if (my $meth = $self->{'cleanup_user'}) {
665 return $meth->($self, $user);
670 sub get_pass_by_user
{
673 if (my $meth = $self->{'get_pass_by_user'}) {
674 return $meth->($self, $user);
677 die "Please override get_pass_by_user";
681 my ($self, $payload, $data) = @_;
682 if (my $meth = $self->{'verify_payload'}) {
683 return $meth->($self, $payload, $data);
688 ###----------------------------------------------------------------###
690 sub encrypt_blowfish
{
691 my ($str, $key) = @_;
693 require Crypt
::Blowfish
;
694 my $cb = Crypt
::Blowfish-
>new($key);
696 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
699 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
704 sub decrypt_blowfish
{
705 my ($enc, $key) = @_;
707 require Crypt
::Blowfish
;
708 my $cb = Crypt
::Blowfish-
>new($key);
711 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
717 ###----------------------------------------------------------------###
721 return $self->{'login_template'} if $self->{'login_template'};
724 . $self->login_header
726 . $self->login_script
727 . $self->login_footer;
732 return shift-
>{'login_header'} || q
{
733 [%~ TRY
; PROCESS
'login_header.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
738 return shift-
>{'login_footer'} || q
{
739 [%~ TRY
; PROCESS
'login_footer.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
744 return shift-
>{'login_form'} || q
{
745 <div
class="login_chunk">
746 <span
class="login_error">[% error
%]</span
>
747 <form
class="login_form" name
="[% form_name %]" method="POST" action
="[% script_name %][% path_info %]">
748 <input type
="hidden" name
="[% key_redirect %]" value
="">
749 <input type
="hidden" name
="[% key_time %]" value
="">
750 <input type
="hidden" name
="[% key_expires_min %]" value
="">
751 <table
class="login_table">
752 <tr
class="login_username">
753 <td
>[% text_user
%]</td
>
754 <td
><input name
="[% key_user %]" type
="text" size
="30" value
=""></td
>
756 <tr
class="login_password">
757 <td
>[% text_pass
%]</td
>
758 <td
><input name
="[% key_pass %]" type
="password" size
="30" value
=""></td
>
760 [% IF
! hide_save
~%]
761 <tr
class="login_save">
763 <input type
="checkbox" name
="[% key_save %]" value
="1"> [% text_save
%]
767 <tr
class="login_submit">
768 <td colspan
="2" align
="right">
769 <input type
="submit" value
="[% text_submit %]">
778 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
779 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
780 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
781 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
782 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
786 return $self->{'login_script'} if $self->{'login_script'};
787 return '' if $self->use_plaintext || $self->disable_simple_cram;
789 <form name
="[% form_name %]_jspost" style
="margin:0px" method="POST">
790 <input type
="hidden" name
="[% key_user %]"><input type
="hidden" name
="[% key_redirect %]">
792 <script src
="[% md5_js_path %]"></script
>
794 if (document
.md5_hex
) document
.[% form_name
%].onsubmit
= function
() {
795 var f
= document
.[% form_name
%];
796 var u
= f
.[% key_user
%].value
;
797 var p
= f
.[% key_pass
%].value
;
798 var t
= f
.[% key_time
%].value
;
799 var s
= f
.[% key_save
%] && f
.[% key_save
%].checked
? -1 : f
.[% key_expires_min
%].value
;
801 var str
= u
+'/'+t
+'/'+s
+'/'+'';
802 var sum
= document
.md5_hex
(str
+'/' + document
.md5_hex
(p
));
804 var f2
= document
.[% form_name
%]_jspost
;
805 f2
.[% key_user
%].value
= str
+'/'+ sum
;
806 f2
.[% key_redirect
%].value
= f
.[% key_redirect
%].value
;
807 f2
.action
= f
.action
;
815 ###----------------------------------------------------------------###
817 package CGI
::Ex
::Auth
::Data
;
821 'bool' => sub { ! shift-
>error },
823 '""' => sub { shift-
>as_string },
827 my ($class, $args) = @_;
828 return bless {%{ $args || {} }}, $class;
833 my $args = @_ == 1 ? shift : {@_};
834 @{ $self }{keys %$args} = values %$args;
840 $self->{'error'} = shift;
841 $self->{'error_caller'} = [caller];
843 return $self->{'error'};
848 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
851 ###----------------------------------------------------------------###
861 ### authorize the user
862 my $auth = CGI::Ex::Auth->get_valid_auth({
863 get_pass_by_user => \&get_pass_by_user,
867 sub get_pass_by_user {
870 my $pass = some_way_of_getting_password($user);
874 ### OR - if you are using a OO based CGI or Application
876 sub require_authentication {
879 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
880 get_pass_by_user => sub {
881 my ($auth, $user) = @_;
882 return $self->get_pass($user);
888 my ($self, $user) = @_;
889 return $self->loopup_and_cache_pass($user);
894 CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins. Auth uses
895 javascript modules that perform MD5 hashing to cram the password on
896 the client side before passing them through the internet.
898 For the stored cookie you can choose to use simple cram mechanisms,
899 secure hash cram tokens, auto expiring logins (not cookie based),
900 and Crypt::Blowfish protection. You can also choose to keep
901 passwords plaintext and to use perl's crypt for testing
904 A downside to this module is that it does not use a session to
905 preserve state so get_pass_by_user has to happen on every request (any
906 authenticated area has to verify authentication each time). A plus is
907 that you don't need to use a session if you don't want to. It is up
908 to the interested reader to add caching to the get_pass_by_user
917 Constructor. Takes a hashref of properties as arguments.
919 Many of the methods which may be overridden in a subclass,
920 or may be passed as properties to the new constuctor such as in the following:
923 get_pass_by_user => \&my_pass_sub,
924 key_user => 'my_user',
925 key_pass => 'my_pass',
926 login_header => \"<h1>My Login</h1>",
929 The following methods will look for properties of the same name. Each of these will be
930 described separately.
966 template_include_path
979 =item C<generate_token>
981 Takes either an auth_data object from a auth_data returned by verify_token,
982 or a hashref of arguments.
984 Possible arguments are:
986 user - the username we are generating the token for
987 real_pass - the password of the user (if use_plaintext is false
988 and use_crypt is false, the password can be an md5sum
989 of the user's password)
990 use_blowfish - indicates that we should use Crypt::Blowfish to protect
991 the generated token. The value of this argument is used
992 as the key. Default is false.
993 use_base64 - indicates that we should use Base64 encoding to protect
994 the generated token. Default is true. Will not be
995 used if use_blowfish is true.
996 use_plaintext - indicates that we should keep the password in plaintext
997 use_crypt - also indicates that we should keep the password in plaintext
998 expires_min - says how many minutes until the generated token expires.
999 Values <= 0 indicate to not ever expire. Used only on cram
1001 payload - a payload that will be passed to generate_payload and then
1002 will be added to cram type tokens. It cannot contain a /.
1004 - If the secure_hash_keys method returns keys, and it is a non-plaintext
1005 token, generate_token will create a secure_hash_cram. Set
1006 this value to true to tell it to use a simple_cram. This
1007 is generally only useful in testing.
1009 The following are types of tokens that can be generated by generate_token. Each type includes
1010 pseudocode and a sample of a generated that token.
1014 real_pass := "123qwe"
1015 token := join("/", user, real_pass);
1018 token == "paul/123qwe"
1021 token == "cGF1bC8xMjNxd2U="
1023 use_blowfish := "foobarbaz"
1024 token == "6da702975190f0fe98a746f0d6514683"
1026 Notes: This token will be used if either use_plaintext or use_crypt is set.
1027 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1028 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1029 token will not be able to be verified.
1033 real_pass := "123qwe"
1034 server_time := 1148512991 # a time in seconds since epoch
1035 expires_min := 6 * 60
1036 payload := "something"
1038 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1039 str := join("/", user, server_time, expires_min, payload, md5_pass)
1040 md5_str := md5(sum_str)
1041 token := join("/", user, server_time, expires_min, payload, md5_str)
1044 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1047 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1049 Notes: use_blowfish is available as well
1053 real_pass := "123qwe"
1054 server_time := 1148514034 # a time in seconds since epoch
1055 expires_min := 6 * 60
1056 payload := "something"
1057 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1058 rand1 := 3 # int(rand(length(secure_hash)))
1059 rand2 := 39163 # int(rand(100000))
1061 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1063 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1064 sh_str2 := join(".", "sh", rand1, rand2)
1065 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1066 md5_str := md5(sum_str)
1067 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1070 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1072 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1073 "secure_hash_keys" property of the CGI::Ex::Auth object.
1075 =item C<get_valid_auth>
1077 Performs the core logic. Returns an auth object on successful login.
1078 Returns false on errored login (with the details of the error stored in
1079 $@). If a false value is returned, execution of the CGI should be halted.
1080 get_valid_auth WILL NOT automatically stop execution.
1082 $auth->get_valid_auth || exit;
1084 Optionally, the class and a list of arguments may be passed. This will create a
1085 new object using the passed arguments, and then run get_valid_auth.
1087 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1089 =item C<check_valid_auth>
1091 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1092 This allows for obtaining login data without forcing an html login
1095 =item C<login_print>
1097 Called if login errored. Defaults to printing a very basic (but
1098 adequate) page loaded from login_template..
1100 You will want to override it with a template from your own system.
1101 The hook that is called will be passed the step to print (currently
1102 only "get_login_info" and "no_cookies"), and a hash containing the
1103 form variables as well as the following:
1105 =item C<login_hash_common>
1107 Passed to the template swapped during login_print.
1109 %$form, # any keys passed to the login script
1110 error # The text "Login Failed" if a login occurred
1111 login_data # A login data object if they failed authentication.
1112 key_user # $self->key_user, # the username fieldname
1113 key_pass # $self->key_pass, # the password fieldname
1114 key_time # $self->key_time, # the server time field name
1115 key_save # $self->key_save, # the save password checkbox field name
1116 key_redirect # $self->key_redirect, # the redirect fieldname
1117 form_name # $self->form_name, # the name of the form
1118 script_name # $self->script_name, # where the server will post back to
1119 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1120 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1121 $self->key_user # $data->{'user'}, # the username (if any)
1122 $self->key_pass # '', # intentional blankout
1123 $self->key_time # $self->server_time, # the server's time
1124 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1125 text_user # $self->text_user # template text Username:
1126 text_pass # $self->text_pass # template text Password:
1127 text_save # $self->text_save # template text Save Password ?
1128 text_submit # $self->text_submit # template text Login
1129 hide_save # $self->hide_save # 0
1131 =item C<bounce_on_logout>
1133 Default 0. If true, will location bounce to script returned by logout_redirect
1134 passing the key key_logout. If false, will simply show the login screen.
1136 =item C<key_loggedout>
1138 Key to bounce with in the form during a logout should bounce_on_logout return true.
1139 Default is "loggedout".
1143 If the form hash contains a true value in this field name, the current user will
1144 be logged out. Default is "cea_logout".
1148 The name of the auth cookie. Default is "cea_user".
1152 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1156 The form field name used to pass the username. Default is "cea_user".
1160 The form field name used to pass the password. Default is "cea_pass".
1164 Works in conjunction with key_expires_min. If key_save is true, then
1165 the cookie will be set to be saved for longer than the current session
1166 (If it is a plaintext variety it will be given a 20 year life rather
1167 than being a session cookie. If it is a cram variety, the expires_min
1168 portion of the cram will be set to -1). If it is set to false, the cookie
1169 will be available only for the session (If it is a plaintext variety, the cookie
1170 will be session based and will be removed on the next loggout. If it is
1171 a cram variety then the cookie will only be good for expires_min minutes.
1173 Default is "cea_save".
1175 =item C<key_expires_min>
1177 The name of the form field that contains how long cram type cookies will be valid
1178 if key_save contains a false value.
1180 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1182 This value will have no effect when use_plaintext or use_crypt is set.
1184 A value of -1 means no expiration.
1186 =item C<failed_sleep>
1188 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1189 if validation failed because of expired tokens. Default value is 0.
1190 Setting to 0 disables any sleeping.
1194 The name of the html login form to attach the javascript to. Default is "cea_form".
1196 =item C<verify_token>
1198 This method verifies the token that was passed either via the form or via cookies.
1199 It will accept plaintext or crammed tokens (A listing of the available algorithms
1200 for creating tokes is listed below). It also allows for armoring the token with
1201 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1202 can be found under generate_token.
1204 =item C<parse_token>
1206 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1207 Returns true if it was able to parse the passed token.
1209 =item C<cleanup_user>
1211 Called by verify_token. Default is to do no modification. Allows for usernames to
1212 be lowercased, or canonized in some other way. Should return the cleaned username.
1214 =item C<verify_user>
1216 Called by verify_token. Single argument is the username. May or may not be an
1217 initial check to see if the username is ok. The username will already be cleaned at
1218 this point. Default return is true.
1220 =item C<get_pass_by_user>
1222 Called by verify_token. Given the cleaned, verified username, should return a
1223 valid password for the user. It can always return plaintext. If use_crypt is
1224 enabled, it should return the crypted password. If use_plaintext and use_crypt
1225 are not enabled, it may return the md5 sum of the password.
1227 get_pass_by_user => sub {
1228 my ($auth_obj, $user) = @_;
1229 my $pass = $some_obj->get_pass({user => $user});
1233 Alternately, get_pass_by_user may return a hashref of data items that
1234 will be added to the data object if the token is valid. The hashref
1235 must also contain a key named real_pass or password that contains the
1236 password. Note that keys passed back in the hashref that are already
1237 in the data object will override those in the data object.
1239 get_pass_by_user => sub {
1240 my ($auth_obj, $user) = @_;
1241 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1244 user_id => $user_id,
1248 =item C<verify_password>
1250 Called by verify_token. Passed the password to check as well as the
1251 auth data object. Should return true if the password matches.
1252 Default method can handle md5, crypt, cram, secure_hash_cram, and
1253 plaintext (all of the default types supported by generate_token). If
1254 a property named verify_password exists, it will be used and called as
1255 a coderef rather than using the default method.
1257 =item C<verify_payload>
1259 Called by verify_token. Passed the password to check as well as the
1260 auth data object. Should return true if the payload is valid.
1261 Default method returns true without performing any checks on the
1262 payload. If a property named verify_password exists, it will be used
1263 and called as a coderef rather than using the default method.
1268 Returns a CGI::Ex object.
1272 A hash of passed form info. Defaults to CGI::Ex::get_form.
1276 The current cookies. Defaults to CGI::Ex::get_cookies.
1278 =item C<login_template>
1280 Should return either a template filename to use for the login template, or it
1281 should return a reference to a string that contains the template. The contents
1282 will be used in login_print and passed to the template engine.
1284 Default login_template is the values of login_header, login_form, login_script, and
1285 login_script concatenated together.
1287 Values from login_hash_common will be passed to the template engine, and will
1288 also be used to fill in the form.
1290 The basic values are capable of handling most needs so long as appropriate
1291 headers and css styles are used.
1293 =item C<login_header>
1295 Should return a header to use in the default login_template. The default
1296 value will try to PROCESS a file called login_header.tt that should be
1297 located in directory specified by the template_include_path method.
1299 It should ideally supply css styles that format the login_form as desired.
1301 =item C<login_footer>
1303 Same as login_header - but for the footer. Will look for login_footer.tt by
1308 An html chunk that contains the necessary form fields to login the user. The
1309 basic chunk has a username text entry, password text entry, save password checkbox,
1310 and submit button, and any hidden fields necessary for logging in the user.
1312 =item C<login_script>
1314 Contains javascript that will attach to the form from login_form. This script
1315 is capable of taking the login_fields and creating an md5 cram which prevents
1316 the password from being passed plaintext.
1318 =item C<text_user, text_pass, text_save>
1320 The text items shown in the default login template. The default values are:
1322 text_user "Username:"
1323 text_pass "Password:"
1324 text_save "Save Password ?"
1326 =item C<disable_simple_cram>
1328 Disables simple cram type from being an available type. Default is
1329 false. If set, then one of use_plaintext, use_crypt, or
1330 secure_hash_keys should be set. Setting this option allows for
1331 payloads to be generated by the server only - otherwise a user who
1332 understands the algorithm could generate a valid simple_cram cookie
1333 with a custom payload.
1335 Another option would be to only accept payloads from tokens if use_blowfish
1336 is set and armor was equal to "blowfish."
1342 This module may be distributed under the same terms as Perl itself.
1346 Paul Seamons <perl at seamons dot com>
This page took 0.135806 seconds and 3 git commands to generate.