]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Auth.pm
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
52 if ($self->bounce_on_logout) {
53 my $key_c = $self->key_cookie;
54 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
55 my $user = $self->last_auth_data ? $self->last_auth_data->{'user'} : undef;
56 $self->location_bounce($self->logout_redirect(defined($user) ? $user : ''));
57 eval { die "Logging out" };
61 $self->handle_failure;
66 ### look first in form, then in cookies for valid tokens
68 foreach ([$form, $self->key_user, 1],
69 [$self->cookies, $self->key_cookie, 0],
71 my ($hash, $key, $is_form) = @$_;
72 next if ! defined $hash->{$key};
73 last if ! $is_form && $had_form_data; # if form info was passed in - we must use it only
74 $had_form_data = 1 if $is_form;
76 ### if it looks like a bare username (as in they didn't have javascript) - add in other items
78 if ($is_form && delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
79 my $key_u = $self->key_user;
80 $self->new_auth_data({user
=> delete($form->{$key_u})});
84 && $hash->{$key} !~ m
|^[^/]+/| # looks like a cram token
85 && defined $hash->{ $self->key_pass }) {
86 $data = $self->verify_token({
88 user
=> delete $hash->{$key},
89 test_pass
=> delete $hash->{ $self->key_pass },
90 expires_min
=> delete($hash->{ $self->key_save }) ? -1 : delete($hash->{ $self->key_expires_min }) || $self->expires_min,
91 payload
=> delete $hash->{ $self->key_payload } || '',
97 $data = $self->verify_token({token
=> $hash->{$key}, from
=> ($is_form ? 'form' : 'cookie')}) || next;
98 delete $hash->{$key} if $is_form;
101 ### generate a fresh cookie if they submitted info on plaintext types
102 if ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt')) {
104 key
=> $self->key_cookie,
105 val
=> $self->generate_token($data),
106 no_expires
=> ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving
107 }) if $is_form; # only set the cookie if we found info in the form - the cookie will be a session cookie after that
109 ### always generate a cookie on types that have expiration
112 key
=> $self->key_cookie,
113 val
=> $self->generate_token($data),
119 return $self->handle_success({is_form
=> $is_form});
122 return $self->handle_failure({had_form_data
=> $had_form_data});
127 my $args = shift || {};
128 if (my $meth = $self->{'handle_success'}) {
129 return $meth->($self, $args);
131 my $form = $self->form;
133 ### bounce to redirect
134 if (my $redirect = $form->{ $self->key_redirect }) {
135 $self->location_bounce($redirect);
136 eval { die "Success login - bouncing to redirect" };
139 ### if they have cookies we are done
140 } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
144 ### need to verify cookies are set-able
145 } elsif ($args->{'is_form'}) {
146 $form->{$self->key_verify} = $self->server_time;
147 my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
149 $self->location_bounce($url);
150 eval { die "Success login - bouncing to test cookie" };
157 if (my $meth = $self->{'success_hook'}) {
158 return $meth->($self);
165 my $args = shift || {};
166 if (my $meth = $self->{'handle_failure'}) {
167 return $meth->($self, $args);
169 my $form = $self->form;
171 ### make sure the cookie is gone
172 my $key_c = $self->key_cookie;
173 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
175 ### no valid login and we are checking for cookies - see if they have cookies
176 if (my $value = delete $form->{$self->key_verify}) {
177 if (abs(time() - $value) < 15) {
178 $self->no_cookies_print;
183 ### oh - you're still here - well then - ask for login credentials
184 my $key_r = $self->key_redirect;
185 local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
186 local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
188 my $data = $self->last_auth_data;
189 eval { die defined($data) ? $data : "Requesting credentials" };
191 ### allow for a sleep to help prevent brute force
192 sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
200 if (my $meth = $self->{'failure_hook'}) {
201 return $meth->($self);
206 sub check_valid_auth
{
208 $self = $self->new(@_) if ! ref $self;
210 local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
211 local $self->{'login_print'} = sub {}; # check only - don't login if not
212 local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
213 return $self->get_valid_auth;
216 ###----------------------------------------------------------------###
218 sub script_name
{ shift-
>{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
220 sub path_info
{ shift-
>{'path_info'} || $ENV{'PATH_INFO'} || '' }
222 sub server_time
{ time }
226 $self->{'cgix'} = shift if @_ == 1;
227 return $self->{'cgix'} ||= CGI
::Ex-
>new;
232 $self->{'form'} = shift if @_ == 1;
233 return $self->{'form'} ||= $self->cgix->get_form;
238 $self->{'cookies'} = shift if @_ == 1;
239 return $self->{'cookies'} ||= $self->cgix->get_cookies;
245 return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
246 my $key = $args->{'key'};
247 $self->cgix->set_cookie({
253 delete $self->cookies->{$key};
259 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
260 my $key = $args->{'key'};
261 my $val = $args->{'val'};
262 $self->cgix->set_cookie({
265 ($args->{'no_expires'} ? () : (-expires
=> '+20y')), # let the expires time take care of things for types that self expire
268 $self->cookies->{$key} = $val;
271 sub location_bounce
{
274 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
275 return $self->cgix->location_bounce($url);
278 ###----------------------------------------------------------------###
280 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
281 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
282 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
283 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
284 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
285 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
286 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
287 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
288 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
289 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
290 sub key_payload
{ shift-
>{'key_payload'} ||= 'cea_payload' }
291 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
292 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
293 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
294 #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"}'
295 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
296 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
297 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
298 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
299 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
300 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
301 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
303 sub logout_redirect
{
304 my ($self, $user) = @_;
305 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
306 return $self->{'logout_redirect'} || $self->script_name ."?$form";
311 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
314 ###----------------------------------------------------------------###
316 sub no_cookies_print
{
318 $self->cgix->print_content_type;
319 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
325 my $hash = $self->login_hash_common;
326 my $template = $self->login_template;
328 ### allow for a hooked override
329 if (my $meth = $self->{'login_print'}) {
330 $meth->($self, $template, $hash);
334 ### process the document
335 require CGI
::Ex
::Template
;
336 my $cet = CGI
::Ex
::Template-
>new($self->template_args);
338 $cet->process_simple($template, $hash, \
$out) || die $cet->error;
340 ### fill in form fields
341 require CGI
::Ex
::Fill
;
342 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
345 $self->cgix->print_content_type;
353 return $self->{'template_args'} ||= {
354 INCLUDE_PATH
=> $self->template_include_path,
358 sub template_include_path
{ shift-
>{'template_include_path'} || '' }
360 sub login_hash_common
{
362 my $form = $self->form;
363 my $data = $self->last_auth_data || {};
367 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
369 key_user
=> $self->key_user,
370 key_pass
=> $self->key_pass,
371 key_time
=> $self->key_time,
372 key_save
=> $self->key_save,
373 key_expires_min
=> $self->key_expires_min,
374 key_payload
=> $self->key_payload,
375 key_redirect
=> $self->key_redirect,
376 form_name
=> $self->form_name,
377 script_name
=> $self->script_name,
378 path_info
=> $self->path_info,
379 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
380 use_plaintext
=> $self->use_plaintext,
381 $self->key_user => $data->{'user'} || '',
382 $self->key_pass => '', # don't allow for this to get filled into the form
383 $self->key_time => $self->server_time,
384 $self->key_payload => $self->generate_payload({%$data, login_form
=> 1}),
385 $self->key_expires_min => $self->expires_min,
386 text_user
=> $self->text_user,
387 text_pass
=> $self->text_pass,
388 text_save
=> $self->text_save,
389 text_submit
=> $self->text_submit,
390 hide_save
=> $self->hide_save,
394 ###----------------------------------------------------------------###
399 my $token = delete $args->{'token'} || die "Missing token";
400 my $data = $self->new_auth_data({token
=> $token, %$args});
403 ### make sure the token is parsed to usable data
404 if (ref $token) { # token already parsed
405 $data->add_data({%$token, armor
=> 'none'});
407 } elsif (my $meth = $self->{'parse_token'}) {
408 if (! $meth->($self, $args)) {
409 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
413 if (! $self->parse_token($token, $data)) {
414 $data->error('Invalid token') if ! $data->error; # add error if not already added
421 if (! defined($data->{'user'})) {
422 $data->error('Missing user');
424 } elsif (! defined $data->{'test_pass'}) {
425 $data->error('Missing test_pass');
427 } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
428 $data->error('Invalid user');
431 return $data if $data->error;
435 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
436 $data->add_data({details
=> $@});
437 $data->error('Could not get pass');
438 } elsif (ref $pass eq 'HASH') {
440 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
441 : exists($extra->{'password'}) ? delete($extra->{'password'})
442 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
443 $data->error('Invalid login') if ! defined $pass && ! $data->error;
444 $data->add_data($extra);
446 return $data if $data->error;
447 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
450 ### validate the pass
451 if ($meth = $self->{'verify_password'}) {
452 if (! $meth->($self, $pass, $data)) {
453 $data->error('Password failed verification') if ! $data->error;
456 if (! $self->verify_password($pass, $data)) {
457 $data->error('Password failed verification') if ! $data->error;
460 return $data if $data->error;
463 ### validate the payload
464 if ($meth = $self->{'verify_payload'}) {
465 if (! $meth->($self, $data->{'payload'}, $data)) {
466 $data->error('Payload failed custom verification') if ! $data->error;
469 if (! $self->verify_payload($data->{'payload'}, $data)) {
470 $data->error('Payload failed verification') if ! $data->error;
479 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
483 my ($self, $token, $data) = @_;
486 for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
487 my $copy = ($armor eq 'none') ? $token
488 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
489 : ($key = $self->use_blowfish) ? decrypt_blowfish
($token, $key)
491 if ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
498 secure_hash
=> $6 || '',
503 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
516 sub verify_password
{
517 my ($self, $pass, $data) = @_;
520 ### looks like a secure_hash cram
521 if ($data->{'secure_hash'}) {
522 $data->add_data(type
=> 'secure_hash_cram');
523 my $array = eval {$self->secure_hash_keys };
525 $err = 'secure_hash_keys not found';
526 } elsif (! @$array) {
527 $err = 'secure_hash_keys empty';
528 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
529 $err = 'Invalid secure hash';
533 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
534 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
535 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
536 if ($data->{'expires_min'} > 0
537 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
538 $err = 'Login expired';
539 } elsif (lc($data->{'test_pass'}) ne $sum) {
540 $err = 'Invalid login';
544 ### looks like a normal cram
545 } elsif ($data->{'cram_time'}) {
546 $data->add_data(type
=> 'cram');
547 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
548 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
549 my $sum = md5_hex
($str .'/'. $real);
550 if ($data->{'expires_min'} > 0
551 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
552 $err = 'Login expired';
553 } elsif (lc($data->{'test_pass'}) ne $sum) {
554 $err = 'Invalid login';
558 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
559 && crypt($data->{'test_pass'}, $1) eq $pass) {
560 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
562 ### failed plaintext crypt
563 } elsif ($self->use_crypt) {
564 $err = 'Invalid login';
565 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
567 ### plaintext and md5
569 my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
570 my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
571 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
572 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
573 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
574 $err = 'Invalid login'
578 $data->error($err) if $err;
582 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
586 my $data = shift || $self->last_auth_data;
587 die "Can't generate a token off of a failed auth" if ! $data;
591 ### do kinds that require staying plaintext
592 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
593 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
594 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
595 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
596 $token = $data->{'user'} .'/'. $pass;
598 ### all other types go to cram - secure_hash_cram, cram, plaintext and md5
600 my $user = $data->{'user'} || die "Missing user";
601 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
602 : die "Missing real_pass";
603 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
604 my $load = $self->generate_payload($data);
605 die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m
|/|;
606 die "User can not contain a \"/\." if $user =~ m
|/|;
609 if (! $data->{'prefer_cram'}
610 && ($array = eval { $self->secure_hash_keys })
612 my $rand1 = int(rand @$array);
613 my $rand2 = int(rand 100000);
614 my $str = join("/", $user, $self->server_time, $exp, $load);
615 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
616 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
618 my $str = join("/", $user, $self->server_time, $exp, $load);
619 my $sum = md5_hex
($str .'/'. $real);
620 $token = $str .'/'. $sum;
624 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
625 $token = encrypt_blowfish
($token, $key);
627 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
628 $token = encode_base64
($token, '');
634 sub generate_payload
{
637 if (my $meth = $self->{'generate_payload'}) {
638 return $meth->($self, $args);
640 return defined($args->{'payload'}) ? $args->{'payload'} : '';
646 if (my $meth = $self->{'verify_user'}) {
647 return $meth->($self, $user);
655 if (my $meth = $self->{'cleanup_user'}) {
656 return $meth->($self, $user);
661 sub get_pass_by_user
{
664 if (my $meth = $self->{'get_pass_by_user'}) {
665 return $meth->($self, $user);
668 die "Please override get_pass_by_user";
672 my ($self, $payload, $data) = @_;
673 if (my $meth = $self->{'verify_payload'}) {
674 return $meth->($self, $payload, $data);
679 ###----------------------------------------------------------------###
681 sub encrypt_blowfish
{
682 my ($str, $key) = @_;
684 require Crypt
::Blowfish
;
685 my $cb = Crypt
::Blowfish-
>new($key);
687 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
690 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
695 sub decrypt_blowfish
{
696 my ($enc, $key) = @_;
698 require Crypt
::Blowfish
;
699 my $cb = Crypt
::Blowfish-
>new($key);
702 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
708 ###----------------------------------------------------------------###
712 return $self->{'login_template'} if $self->{'login_template'};
715 . $self->login_header
717 . $self->login_script
718 . $self->login_footer;
723 return shift-
>{'login_header'} || q
{
724 [%~ TRY
; PROCESS
'login_header.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
729 return shift-
>{'login_footer'} || q
{
730 [%~ TRY
; PROCESS
'login_footer.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
735 return shift-
>{'login_form'} || q
{
736 <div
class="login_chunk">
737 <span
class="login_error">[% error
%]</span
>
738 <form
class="login_form" name
="[% form_name %]" method="POST" action
="[% script_name %][% path_info %]">
739 <input type
="hidden" name
="[% key_redirect %]" value
="">
740 <input type
="hidden" name
="[% key_payload %]" value
="">
741 <input type
="hidden" name
="[% key_time %]" value
="">
742 <input type
="hidden" name
="[% key_expires_min %]" value
="">
743 <table
class="login_table">
744 <tr
class="login_username">
745 <td
>[% text_user
%]</td
>
746 <td
><input name
="[% key_user %]" type
="text" size
="30" value
=""></td
>
748 <tr
class="login_password">
749 <td
>[% text_pass
%]</td
>
750 <td
><input name
="[% key_pass %]" type
="password" size
="30" value
=""></td
>
752 [% IF
! hide_save
~%]
753 <tr
class="login_save">
755 <input type
="checkbox" name
="[% key_save %]" value
="1"> [% text_save
%]
759 <tr
class="login_submit">
760 <td colspan
="2" align
="right">
761 <input type
="submit" value
="[% text_submit %]">
770 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
771 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
772 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
773 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
774 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
777 return shift-
>{'login_script'} || q
{
778 [%~ IF
! use_plaintext
%]
779 <form name
="[% form_name %]_jspost" style
="margin:0px" method="POST">
780 <input type
="hidden" name
="[% key_user %]"><input type
="hidden" name
="[% key_redirect %]">
782 <script src
="[% md5_js_path %]"></script
>
784 if (document
.md5_hex
) document
.[% form_name
%].onsubmit
= function
() {
785 var f
= document
.[% form_name
%];
786 var u
= f
.[% key_user
%].value
;
787 var p
= f
.[% key_pass
%].value
;
788 var t
= f
.[% key_time
%].value
;
789 var s
= f
.[% key_save
%] && f
.[% key_save
%].checked
? -1 : f
.[% key_expires_min
%].value
;
790 var l
= f
.[% key_payload
%].value
;
792 var str
= u
+'/'+t
+'/'+s
+'/'+l
;
793 var sum
= document
.md5_hex
(str
+'/' + document
.md5_hex
(p
));
795 var f2
= document
.[% form_name
%]_jspost
;
796 f2
.[% key_user
%].value
= str
+'/'+ sum
;
797 f2
.[% key_redirect
%].value
= f
.[% key_redirect
%].value
;
798 f2
.action
= f
.action
;
807 ###----------------------------------------------------------------###
809 package CGI
::Ex
::Auth
::Data
;
813 'bool' => sub { ! shift-
>error },
815 '""' => sub { shift-
>as_string },
819 my ($class, $args) = @_;
820 return bless {%{ $args || {} }}, $class;
825 my $args = @_ == 1 ? shift : {@_};
826 @{ $self }{keys %$args} = values %$args;
832 $self->{'error'} = shift;
833 $self->{'error_caller'} = [caller];
835 return $self->{'error'};
840 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
843 ###----------------------------------------------------------------###
853 ### authorize the user
854 my $auth = CGI::Ex::Auth->get_valid_auth({
855 get_pass_by_user => \&get_pass_by_user,
859 sub get_pass_by_user {
862 my $pass = some_way_of_getting_password($user);
866 ### OR - if you are using a OO based CGI or Application
868 sub require_authentication {
871 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
872 get_pass_by_user => sub {
873 my ($auth, $user) = @_;
874 return $self->get_pass($user);
880 my ($self, $user) = @_;
881 return $self->loopup_and_cache_pass($user);
886 CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins. Auth uses
887 javascript modules that perform MD5 hashing to cram the password on
888 the client side before passing them through the internet.
890 For the stored cookie you can choose to use cram mechanisms,
891 secure hash cram tokens, auto expiring logins (not cookie based),
892 and Crypt::Blowfish protection. You can also choose to keep
893 passwords plaintext and to use perl's crypt for testing
896 A downside to this module is that it does not use a session to
897 preserve state so get_pass_by_user has to happen on every request (any
898 authenticated area has to verify authentication each time). A plus is
899 that you don't need to use a session if you don't want to. It is up
900 to the interested reader to add caching to the get_pass_by_user
909 Constructor. Takes a hashref of properties as arguments.
911 Many of the methods which may be overridden in a subclass,
912 or may be passed as properties to the new constuctor such as in the following:
915 get_pass_by_user => \&my_pass_sub,
916 key_user => 'my_user',
917 key_pass => 'my_pass',
918 login_template => \"<form><input name=my_user ... </form>",
921 The following methods will look for properties of the same name. Each of these will be
958 template_include_path
971 =item C<generate_token>
973 Takes either an auth_data object from a auth_data returned by verify_token,
974 or a hashref of arguments.
976 Possible arguments are:
978 user - the username we are generating the token for
979 real_pass - the password of the user (if use_plaintext is false
980 and use_crypt is false, the password can be an md5sum
981 of the user's password)
982 use_blowfish - indicates that we should use Crypt::Blowfish to protect
983 the generated token. The value of this argument is used
984 as the key. Default is false.
985 use_base64 - indicates that we should use Base64 encoding to protect
986 the generated token. Default is true. Will not be
987 used if use_blowfish is true.
988 use_plaintext - indicates that we should keep the password in plaintext
989 use_crypt - also indicates that we should keep the password in plaintext
990 expires_min - says how many minutes until the generated token expires.
991 Values <= 0 indicate to not ever expire. Used only on cram
993 payload - a payload that will be passed to generate_payload and then
994 will be added to cram type tokens. It cannot contain a /.
995 prefer_cram - If the secure_hash_keys method returns keys, and it is a non-plaintext
996 token, generate_token will create a secure_hash_cram. Set
997 this value to true to tell it to use a normal cram. This
998 is generally only useful in testing.
1000 The following are types of tokens that can be generated by generate_token. Each type includes
1001 pseudocode and a sample of a generated that token.
1005 real_pass := "123qwe"
1006 token := join("/", user, real_pass);
1009 token == "paul/123qwe"
1012 token == "cGF1bC8xMjNxd2U="
1014 use_blowfish := "foobarbaz"
1015 token == "6da702975190f0fe98a746f0d6514683"
1017 Notes: This token will be used if either use_plaintext or use_crypt is set.
1018 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1019 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1020 token will not be able to be verified.
1024 real_pass := "123qwe"
1025 server_time := 1148512991 # a time in seconds since epoch
1026 expires_min := 6 * 60
1027 payload := "something"
1029 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1030 str := join("/", user, server_time, expires_min, payload, md5_pass)
1031 md5_str := md5(sum_str)
1032 token := join("/", user, server_time, expires_min, payload, md5_str)
1035 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1038 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1040 Notes: use_blowfish is available as well
1044 real_pass := "123qwe"
1045 server_time := 1148514034 # a time in seconds since epoch
1046 expires_min := 6 * 60
1047 payload := "something"
1048 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1049 rand1 := 3 # int(rand(length(secure_hash)))
1050 rand2 := 39163 # int(rand(100000))
1052 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1054 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1055 sh_str2 := join(".", "sh", rand1, rand2)
1056 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1057 md5_str := md5(sum_str)
1058 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1061 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1063 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1064 "secure_hash_keys" property of the CGI::Ex::Auth object.
1066 =item C<get_valid_auth>
1068 Performs the core logic. Returns an auth object on successful login.
1069 Returns false on errored login (with the details of the error stored in
1070 $@). If a false value is returned, execution of the CGI should be halted.
1071 get_valid_auth WILL NOT automatically stop execution.
1073 $auth->get_valid_auth || exit;
1075 Optionally, the class and a list of arguments may be passed. This will create a
1076 new object using the passed arguments, and then run get_valid_auth.
1078 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1080 =item C<check_valid_auth>
1082 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1083 This allows for obtaining login data without forcing an html login
1086 =item C<login_print>
1088 Called if login errored. Defaults to printing a very basic (but
1089 adequate) page loaded from login_template..
1091 You will want to override it with a template from your own system.
1092 The hook that is called will be passed the step to print (currently
1093 only "get_login_info" and "no_cookies"), and a hash containing the
1094 form variables as well as the following:
1096 =item C<login_hash_common>
1098 Passed to the template swapped during login_print.
1100 %$form, # any keys passed to the login script
1101 error # The text "Login Failed" if a login occurred
1102 login_data # A login data object if they failed authentication.
1103 key_user # $self->key_user, # the username fieldname
1104 key_pass # $self->key_pass, # the password fieldname
1105 key_time # $self->key_time, # the server time field name
1106 key_save # $self->key_save, # the save password checkbox field name
1107 key_payload # $self->key_payload, # the payload fieldname
1108 key_redirect # $self->key_redirect, # the redirect fieldname
1109 form_name # $self->form_name, # the name of the form
1110 script_name # $self->script_name, # where the server will post back to
1111 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1112 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1113 use_plaintext # $self->use_plaintext, # used to avoid cramming
1114 $self->key_user # $data->{'user'}, # the username (if any)
1115 $self->key_pass # '', # intentional blankout
1116 $self->key_time # $self->server_time, # the server's time
1117 $self->key_payload # $data->{'payload'} # the payload (if any)
1118 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1119 text_user # $self->text_user # template text Username:
1120 text_pass # $self->text_pass # template text Password:
1121 text_save # $self->text_save # template text Save Password ?
1122 text_submit # $self->text_submit # template text Login
1123 hide_save # $self->hide_save # 0
1125 =item C<bounce_on_logout>
1127 Default 0. If true, will location bounce to script returned by logout_redirect
1128 passing the key key_logout. If false, will simply show the login screen.
1130 =item C<key_loggedout>
1132 Key to bounce with in the form during a logout should bounce_on_logout return true.
1133 Default is "loggedout".
1137 If the form hash contains a true value in this field name, the current user will
1138 be logged out. Default is "cea_logout".
1142 The name of the auth cookie. Default is "cea_user".
1146 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1150 The form field name used to pass the username. Default is "cea_user".
1154 The form field name used to pass the password. Default is "cea_pass".
1158 Works in conjunction with key_expires_min. If key_save is true, then
1159 the cookie will be set to be saved for longer than the current session
1160 (If it is a plaintext variety it will be given a 20 year life rather
1161 than being a session cookie. If it is a cram variety, the expires_min
1162 portion of the cram will be set to -1). If it is set to false, the cookie
1163 will be available only for the session (If it is a plaintext variety, the cookie
1164 will be session based and will be removed on the next loggout. If it is
1165 a cram variety then the cookie will only be good for expires_min minutes.
1167 Default is "cea_save".
1169 =item C<key_expires_min>
1171 The name of the form field that contains how long cram type cookies will be valid
1172 if key_save contains a false value.
1174 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1176 This value will have no effect when use_plaintext or use_crypt is set.
1178 A value of -1 means no expiration.
1180 =item C<failed_sleep>
1182 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1183 if validation failed because of expired tokens. Default value is 0.
1184 Setting to 0 disables any sleeping.
1188 The name of the html login form to attach the javascript to. Default is "cea_form".
1190 =item C<verify_token>
1192 This method verifies the token that was passed either via the form or via cookies.
1193 It will accept plaintext or crammed tokens (A listing of the available algorithms
1194 for creating tokes is listed below). It also allows for armoring the token with
1195 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1196 can be found under generate_token.
1198 =item C<parse_token>
1200 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1201 Returns true if it was able to parse the passed token.
1203 =item C<cleanup_user>
1205 Called by verify_token. Default is to do no modification. Allows for usernames to
1206 be lowercased, or canonized in some other way. Should return the cleaned username.
1208 =item C<verify_user>
1210 Called by verify_token. Single argument is the username. May or may not be an
1211 initial check to see if the username is ok. The username will already be cleaned at
1212 this point. Default return is true.
1214 =item C<get_pass_by_user>
1216 Called by verify_token. Given the cleaned, verified username, should return a
1217 valid password for the user. It can always return plaintext. If use_crypt is
1218 enabled, it should return the crypted password. If use_plaintext and use_crypt
1219 are not enabled, it may return the md5 sum of the password.
1221 get_pass_by_user => sub {
1222 my ($auth_obj, $user) = @_;
1223 my $pass = $some_obj->get_pass({user => $user});
1227 Alternately, get_pass_by_user may return a hashref of data items that
1228 will be added to the data object if the token is valid. The hashref
1229 must also contain a key named real_pass or password that contains the
1230 password. Note that keys passed back in the hashref that are already
1231 in the data object will override those in the data object.
1233 get_pass_by_user => sub {
1234 my ($auth_obj, $user) = @_;
1235 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1238 user_id => $user_id,
1242 =item C<verify_password>
1244 Called by verify_token. Passed the password to check as well as the
1245 auth data object. Should return true if the password matches.
1246 Default method can handle md5, crypt, cram, secure_hash_cram, and
1247 plaintext (all of the default types supported by generate_token). If
1248 a property named verify_password exists, it will be used and called as
1249 a coderef rather than using the default method.
1251 =item C<verify_payload>
1253 Called by verify_token. Passed the password to check as well as the
1254 auth data object. Should return true if the payload is valid.
1255 Default method returns true without performing any checks on the
1256 payload. If a property named verify_password exists, it will be used
1257 and called as a coderef rather than using the default method.
1262 Returns a CGI::Ex object.
1266 A hash of passed form info. Defaults to CGI::Ex::get_form.
1270 The current cookies. Defaults to CGI::Ex::get_cookies.
1272 =item C<login_template>
1274 Should return either a template filename to use for the login template, or it
1275 should return a reference to a string that contains the template. The contents
1276 will be used in login_print and passed to the template engine.
1278 Default login_template is the values of login_header, login_form, login_script, and
1279 login_script concatenated together.
1281 Values from login_hash_common will be passed to the template engine, and will
1282 also be used to fill in the form.
1284 The basic values are capable of handling most needs so long as appropriate
1285 headers and css styles are used.
1287 =item C<login_header>
1289 Should return a header to use in the default login_template. The default
1290 value will try to PROCESS a file called login_header.tt that should be
1291 located in directory specified by the template_include_path method.
1293 It should ideally supply css styles that format the login_form as desired.
1295 =item C<login_footer>
1297 Same as login_header - but for the footer. Will look for login_footer.tt by
1302 An html chunk that contains the necessary form fields to login the user. The
1303 basic chunk has a username text entry, password text entry, save password checkbox,
1304 and submit button, and any hidden fields necessary for logging in the user.
1306 =item C<login_script>
1308 Contains javascript that will attach to the form from login_form. This script
1309 is capable of taking the login_fields and creating an md5 cram which prevents
1310 the password from being passed plaintext.
1312 =item C<text_user, text_pass, text_save>
1314 The text items shown in the default login template. The default values are:
1316 text_user "Username:"
1317 text_pass "Password:"
1318 text_save "Save Password ?"
1324 This module may be distributed under the same terms as Perl itself.
1328 Paul Seamons <perl at seamons dot com>
This page took 0.142398 seconds and 4 git commands to generate.