]>
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) {
143 ### need to verify cookies are set-able
144 } elsif ($args->{'is_form'}) {
145 $form->{$self->key_verify} = $self->server_time;
146 my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
148 $self->location_bounce($url);
149 eval { die "Success login - bouncing to test cookie" };
156 my $args = shift || {};
157 if (my $meth = $self->{'handle_failure'}) {
158 return $meth->($self, $args);
160 my $form = $self->form;
162 ### make sure the cookie is gone
163 my $key_c = $self->key_cookie;
164 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
166 ### no valid login and we are checking for cookies - see if they have cookies
167 if (my $value = delete $form->{$self->key_verify}) {
168 if (abs(time() - $value) < 15) {
169 $self->no_cookies_print;
174 ### oh - you're still here - well then - ask for login credentials
175 my $key_r = $self->key_redirect;
176 local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
177 local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
179 my $data = $self->last_auth_data;
180 eval { die defined($data) ? $data : "Requesting credentials" };
182 ### allow for a sleep to help prevent brute force
183 sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
188 sub check_valid_auth
{
190 $self = $self->new(@_) if ! ref $self;
192 local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
193 local $self->{'login_print'} = sub {}; # check only - don't login if not
194 local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
195 return $self->get_valid_auth;
198 ###----------------------------------------------------------------###
200 sub script_name
{ shift-
>{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
202 sub path_info
{ shift-
>{'path_info'} || $ENV{'PATH_INFO'} || '' }
204 sub server_time
{ time }
208 $self->{'cgix'} = shift if @_ == 1;
209 return $self->{'cgix'} ||= CGI
::Ex-
>new;
214 $self->{'form'} = shift if @_ == 1;
215 return $self->{'form'} ||= $self->cgix->get_form;
220 $self->{'cookies'} = shift if @_ == 1;
221 return $self->{'cookies'} ||= $self->cgix->get_cookies;
227 return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
228 my $key = $args->{'key'};
229 $self->cgix->set_cookie({
235 delete $self->cookies->{$key};
241 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
242 my $key = $args->{'key'};
243 my $val = $args->{'val'};
244 $self->cgix->set_cookie({
247 ($args->{'no_expires'} ? () : (-expires
=> '+20y')), # let the expires time take care of things for types that self expire
250 $self->cookies->{$key} = $val;
253 sub location_bounce
{
256 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
257 return $self->cgix->location_bounce($url);
260 ###----------------------------------------------------------------###
262 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
263 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
264 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
265 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
266 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
267 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
268 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
269 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
270 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
271 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
272 sub key_payload
{ shift-
>{'key_payload'} ||= 'cea_payload' }
273 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
274 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
275 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
276 #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"}'
277 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
278 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
279 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
280 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
281 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
282 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
283 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
285 sub logout_redirect
{
286 my ($self, $user) = @_;
287 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
288 return $self->{'logout_redirect'} || $self->script_name ."?$form";
293 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
296 ###----------------------------------------------------------------###
298 sub no_cookies_print
{
300 $self->cgix->print_content_type;
301 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
307 my $hash = $self->login_hash_common;
308 my $template = $self->login_template;
310 ### allow for a hooked override
311 if (my $meth = $self->{'login_print'}) {
312 $meth->($self, $template, $hash);
316 ### process the document
317 require CGI
::Ex
::Template
;
318 my $cet = CGI
::Ex
::Template-
>new($self->template_args);
320 $cet->process_simple($template, $hash, \
$out) || die $cet->error;
322 ### fill in form fields
323 require CGI
::Ex
::Fill
;
324 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
327 $self->cgix->print_content_type;
335 return $self->{'template_args'} ||= {
336 INCLUDE_PATH
=> $self->template_include_path,
340 sub template_include_path
{ shift-
>{'template_include_path'} || '' }
342 sub login_hash_common
{
344 my $form = $self->form;
345 my $data = $self->last_auth_data || {};
349 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
351 key_user
=> $self->key_user,
352 key_pass
=> $self->key_pass,
353 key_time
=> $self->key_time,
354 key_save
=> $self->key_save,
355 key_expires_min
=> $self->key_expires_min,
356 key_payload
=> $self->key_payload,
357 key_redirect
=> $self->key_redirect,
358 form_name
=> $self->form_name,
359 script_name
=> $self->script_name,
360 path_info
=> $self->path_info,
361 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
362 use_plaintext
=> $self->use_plaintext,
363 $self->key_user => $data->{'user'} || '',
364 $self->key_pass => '', # don't allow for this to get filled into the form
365 $self->key_time => $self->server_time,
366 $self->key_payload => $self->generate_payload({%$data, login_form
=> 1}),
367 $self->key_expires_min => $self->expires_min,
368 text_user
=> $self->text_user,
369 text_pass
=> $self->text_pass,
370 text_save
=> $self->text_save,
371 text_submit
=> $self->text_submit,
372 hide_save
=> $self->hide_save,
376 ###----------------------------------------------------------------###
381 my $token = delete $args->{'token'} || die "Missing token";
382 my $data = $self->new_auth_data({token
=> $token, %$args});
385 ### make sure the token is parsed to usable data
386 if (ref $token) { # token already parsed
387 $data->add_data({%$token, armor
=> 'none'});
389 } elsif (my $meth = $self->{'parse_token'}) {
390 if (! $meth->($self, $args)) {
391 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
395 if (! $self->parse_token($token, $data)) {
396 $data->error('Invalid token') if ! $data->error; # add error if not already added
403 if (! defined($data->{'user'})) {
404 $data->error('Missing user');
406 } elsif (! defined $data->{'test_pass'}) {
407 $data->error('Missing test_pass');
409 } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
410 $data->error('Invalid user');
413 return $data if $data->error;
417 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
418 $data->add_data({details
=> $@});
419 $data->error('Could not get pass');
420 } elsif (ref $pass eq 'HASH') {
422 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
423 : exists($extra->{'password'}) ? delete($extra->{'password'})
424 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
425 $data->error('Invalid login') if ! defined $pass && ! $data->error;
426 $data->add_data($extra);
428 return $data if $data->error;
429 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
432 ### validate the pass
433 if ($meth = $self->{'verify_password'}) {
434 if (! $meth->($self, $pass, $data)) {
435 $data->error('Password failed verification') if ! $data->error;
438 if (! $self->verify_password($pass, $data)) {
439 $data->error('Password failed verification') if ! $data->error;
442 return $data if $data->error;
445 ### validate the payload
446 if ($meth = $self->{'verify_payload'}) {
447 if (! $meth->($self, $data->{'payload'}, $data)) {
448 $data->error('Payload failed custom verification') if ! $data->error;
451 if (! $self->verify_payload($data->{'payload'}, $data)) {
452 $data->error('Payload failed verification') if ! $data->error;
461 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
465 my ($self, $token, $data) = @_;
468 for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
469 my $copy = ($armor eq 'none') ? $token
470 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
471 : ($key = $self->use_blowfish) ? decrypt_blowfish
($token, $key)
473 if ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
480 secure_hash
=> $6 || '',
485 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
498 sub verify_password
{
499 my ($self, $pass, $data) = @_;
502 ### looks like a secure_hash cram
503 if ($data->{'secure_hash'}) {
504 $data->add_data(type
=> 'secure_hash_cram');
505 my $array = eval {$self->secure_hash_keys };
507 $err = 'secure_hash_keys not found';
508 } elsif (! @$array) {
509 $err = 'secure_hash_keys empty';
510 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
511 $err = 'Invalid secure hash';
515 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
516 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
517 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
518 if ($data->{'expires_min'} > 0
519 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
520 $err = 'Login expired';
521 } elsif (lc($data->{'test_pass'}) ne $sum) {
522 $err = 'Invalid login';
526 ### looks like a normal cram
527 } elsif ($data->{'cram_time'}) {
528 $data->add_data(type
=> 'cram');
529 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
530 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
531 my $sum = md5_hex
($str .'/'. $real);
532 if ($data->{'expires_min'} > 0
533 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
534 $err = 'Login expired';
535 } elsif (lc($data->{'test_pass'}) ne $sum) {
536 $err = 'Invalid login';
540 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
541 && crypt($data->{'test_pass'}, $1) eq $pass) {
542 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
544 ### failed plaintext crypt
545 } elsif ($self->use_crypt) {
546 $err = 'Invalid login';
547 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
549 ### plaintext and md5
551 my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
552 my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
553 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
554 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
555 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
556 $err = 'Invalid login'
560 $data->error($err) if $err;
564 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
568 my $data = shift || $self->last_auth_data;
569 die "Can't generate a token off of a failed auth" if ! $data;
573 ### do kinds that require staying plaintext
574 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
575 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
576 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
577 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
578 $token = $data->{'user'} .'/'. $pass;
580 ### all other types go to cram - secure_hash_cram, cram, plaintext and md5
582 my $user = $data->{'user'} || die "Missing user";
583 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
584 : die "Missing real_pass";
585 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
586 my $load = $self->generate_payload($data);
587 die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m
|/|;
588 die "User can not contain a \"/\." if $user =~ m
|/|;
591 if (! $data->{'prefer_cram'}
592 && ($array = eval { $self->secure_hash_keys })
594 my $rand1 = int(rand @$array);
595 my $rand2 = int(rand 100000);
596 my $str = join("/", $user, $self->server_time, $exp, $load);
597 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
598 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
600 my $str = join("/", $user, $self->server_time, $exp, $load);
601 my $sum = md5_hex
($str .'/'. $real);
602 $token = $str .'/'. $sum;
606 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
607 $token = encrypt_blowfish
($token, $key);
609 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
610 $token = encode_base64
($token, '');
616 sub generate_payload
{
619 if (my $meth = $self->{'generate_payload'}) {
620 return $meth->($self, $args);
622 return defined($args->{'payload'}) ? $args->{'payload'} : '';
628 if (my $meth = $self->{'verify_user'}) {
629 return $meth->($self, $user);
637 if (my $meth = $self->{'cleanup_user'}) {
638 return $meth->($self, $user);
643 sub get_pass_by_user
{
646 if (my $meth = $self->{'get_pass_by_user'}) {
647 return $meth->($self, $user);
650 die "Please override get_pass_by_user";
654 my ($self, $payload, $data) = @_;
655 if (my $meth = $self->{'verify_payload'}) {
656 return $meth->($self, $payload, $data);
661 ###----------------------------------------------------------------###
663 sub encrypt_blowfish
{
664 my ($str, $key) = @_;
666 require Crypt
::Blowfish
;
667 my $cb = Crypt
::Blowfish-
>new($key);
669 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
672 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
677 sub decrypt_blowfish
{
678 my ($enc, $key) = @_;
680 require Crypt
::Blowfish
;
681 my $cb = Crypt
::Blowfish-
>new($key);
684 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
690 ###----------------------------------------------------------------###
694 return $self->{'login_template'} if $self->{'login_template'};
697 . $self->login_header
699 . $self->login_script
700 . $self->login_footer;
705 return shift-
>{'login_header'} || q
{
706 [%~ TRY
; PROCESS
'login_header.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
711 return shift-
>{'login_footer'} || q
{
712 [%~ TRY
; PROCESS
'login_footer.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
717 return shift-
>{'login_form'} || q
{
718 <div
class="login_chunk">
719 <span
class="login_error">[% error
%]</span
>
720 <form
class="login_form" name
="[% form_name %]" method="POST" action
="[% script_name %][% path_info %]">
721 <input type
="hidden" name
="[% key_redirect %]" value
="">
722 <input type
="hidden" name
="[% key_payload %]" value
="">
723 <input type
="hidden" name
="[% key_time %]" value
="">
724 <input type
="hidden" name
="[% key_expires_min %]" value
="">
725 <table
class="login_table">
726 <tr
class="login_username">
727 <td
>[% text_user
%]</td
>
728 <td
><input name
="[% key_user %]" type
="text" size
="30" value
=""></td
>
730 <tr
class="login_password">
731 <td
>[% text_pass
%]</td
>
732 <td
><input name
="[% key_pass %]" type
="password" size
="30" value
=""></td
>
734 [% IF
! hide_save
~%]
735 <tr
class="login_save">
737 <input type
="checkbox" name
="[% key_save %]" value
="1"> [% text_save
%]
741 <tr
class="login_submit">
742 <td colspan
="2" align
="right">
743 <input type
="submit" value
="[% text_submit %]">
752 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
753 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
754 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
755 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
756 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
759 return shift-
>{'login_script'} || q
{
760 [%~ IF
! use_plaintext
%]
761 <form name
="[% form_name %]_jspost" style
="margin:0px" method="POST">
762 <input type
="hidden" name
="[% key_user %]"><input type
="hidden" name
="[% key_redirect %]">
764 <script src
="[% md5_js_path %]"></script
>
766 if (document
.md5_hex
) document
.[% form_name
%].onsubmit
= function
() {
767 var f
= document
.[% form_name
%];
768 var u
= f
.[% key_user
%].value
;
769 var p
= f
.[% key_pass
%].value
;
770 var t
= f
.[% key_time
%].value
;
771 var s
= f
.[% key_save
%] && f
.[% key_save
%].checked
? -1 : f
.[% key_expires_min
%].value
;
772 var l
= f
.[% key_payload
%].value
;
774 var str
= u
+'/'+t
+'/'+s
+'/'+l
;
775 var sum
= document
.md5_hex
(str
+'/' + document
.md5_hex
(p
));
777 var f2
= document
.[% form_name
%]_jspost
;
778 f2
.[% key_user
%].value
= str
+'/'+ sum
;
779 f2
.[% key_redirect
%].value
= f
.[% key_redirect
%].value
;
780 f2
.action
= f
.action
;
789 ###----------------------------------------------------------------###
791 package CGI
::Ex
::Auth
::Data
;
795 'bool' => sub { ! shift-
>error },
797 '""' => sub { shift-
>as_string },
801 my ($class, $args) = @_;
802 return bless {%{ $args || {} }}, $class;
807 my $args = @_ == 1 ? shift : {@_};
808 @{ $self }{keys %$args} = values %$args;
814 $self->{'error'} = shift;
815 $self->{'error_caller'} = [caller];
817 return $self->{'error'};
822 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
825 ###----------------------------------------------------------------###
835 ### authorize the user
836 my $auth = CGI::Ex::Auth->get_valid_auth({
837 get_pass_by_user => \&get_pass_by_user,
841 sub get_pass_by_user {
844 my $pass = some_way_of_getting_password($user);
848 ### OR - if you are using a OO based CGI or Application
850 sub require_authentication {
853 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
854 get_pass_by_user => sub {
855 my ($auth, $user) = @_;
856 return $self->get_pass($user);
862 my ($self, $user) = @_;
863 return $self->loopup_and_cache_pass($user);
868 CGI::Ex::Auth allows for auto-expiring, safe and easy web based logins. Auth uses
869 javascript modules that perform MD5 hashing to cram the password on
870 the client side before passing them through the internet.
872 For the stored cookie you can choose to use cram mechanisms,
873 secure hash cram tokens, auto expiring logins (not cookie based),
874 and Crypt::Blowfish protection. You can also choose to keep
875 passwords plaintext and to use perl's crypt for testing
878 A downside to this module is that it does not use a session to
879 preserve state so get_pass_by_user has to happen on every request (any
880 authenticated area has to verify authentication each time). A plus is
881 that you don't need to use a session if you don't want to. It is up
882 to the interested reader to add caching to the get_pass_by_user
891 Constructor. Takes a hashref of properties as arguments.
893 Many of the methods which may be overridden in a subclass,
894 or may be passed as properties to the new constuctor such as in the following:
897 get_pass_by_user => \&my_pass_sub,
898 key_user => 'my_user',
899 key_pass => 'my_pass',
900 login_template => \"<form><input name=my_user ... </form>",
903 The following methods will look for properties of the same name. Each of these will be
938 template_include_path
951 =item C<generate_token>
953 Takes either an auth_data object from a auth_data returned by verify_token,
954 or a hashref of arguments.
956 Possible arguments are:
958 user - the username we are generating the token for
959 real_pass - the password of the user (if use_plaintext is false
960 and use_crypt is false, the password can be an md5sum
961 of the user's password)
962 use_blowfish - indicates that we should use Crypt::Blowfish to protect
963 the generated token. The value of this argument is used
964 as the key. Default is false.
965 use_base64 - indicates that we should use Base64 encoding to protect
966 the generated token. Default is true. Will not be
967 used if use_blowfish is true.
968 use_plaintext - indicates that we should keep the password in plaintext
969 use_crypt - also indicates that we should keep the password in plaintext
970 expires_min - says how many minutes until the generated token expires.
971 Values <= 0 indicate to not ever expire. Used only on cram
973 payload - a payload that will be passed to generate_payload and then
974 will be added to cram type tokens. It cannot contain a /.
975 prefer_cram - If the secure_hash_keys method returns keys, and it is a non-plaintext
976 token, generate_token will create a secure_hash_cram. Set
977 this value to true to tell it to use a normal cram. This
978 is generally only useful in testing.
980 The following are types of tokens that can be generated by generate_token. Each type includes
981 pseudocode and a sample of a generated that token.
985 real_pass := "123qwe"
986 token := join("/", user, real_pass);
989 token == "paul/123qwe"
992 token == "cGF1bC8xMjNxd2U="
994 use_blowfish := "foobarbaz"
995 token == "6da702975190f0fe98a746f0d6514683"
997 Notes: This token will be used if either use_plaintext or use_crypt is set.
998 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
999 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1000 token will not be able to be verified.
1004 real_pass := "123qwe"
1005 server_time := 1148512991 # a time in seconds since epoch
1006 expires_min := 6 * 60
1007 payload := "something"
1009 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1010 str := join("/", user, server_time, expires_min, payload, md5_pass)
1011 md5_str := md5(sum_str)
1012 token := join("/", user, server_time, expires_min, payload, md5_str)
1015 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1018 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1020 Notes: use_blowfish is available as well
1024 real_pass := "123qwe"
1025 server_time := 1148514034 # a time in seconds since epoch
1026 expires_min := 6 * 60
1027 payload := "something"
1028 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1029 rand1 := 3 # int(rand(length(secure_hash)))
1030 rand2 := 39163 # int(rand(100000))
1032 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1034 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1035 sh_str2 := join(".", "sh", rand1, rand2)
1036 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1037 md5_str := md5(sum_str)
1038 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1041 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1043 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1044 "secure_hash_keys" property of the CGI::Ex::Auth object.
1046 =item C<get_valid_auth>
1048 Performs the core logic. Returns an auth object on successful login.
1049 Returns false on errored login (with the details of the error stored in
1050 $@). If a false value is returned, execution of the CGI should be halted.
1051 get_valid_auth WILL NOT automatically stop execution.
1053 $auth->get_valid_auth || exit;
1055 Optionally, the class and a list of arguments may be passed. This will create a
1056 new object using the passed arguments, and then run get_valid_auth.
1058 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1060 =item C<check_valid_auth>
1062 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1063 This allows for obtaining login data without forcing an html login
1066 =item C<login_print>
1068 Called if login errored. Defaults to printing a very basic (but
1069 adequate) page loaded from login_template..
1071 You will want to override it with a template from your own system.
1072 The hook that is called will be passed the step to print (currently
1073 only "get_login_info" and "no_cookies"), and a hash containing the
1074 form variables as well as the following:
1076 =item C<login_hash_common>
1078 Passed to the template swapped during login_print.
1080 %$form, # any keys passed to the login script
1081 error # The text "Login Failed" if a login occurred
1082 login_data # A login data object if they failed authentication.
1083 key_user # $self->key_user, # the username fieldname
1084 key_pass # $self->key_pass, # the password fieldname
1085 key_time # $self->key_time, # the server time field name
1086 key_save # $self->key_save, # the save password checkbox field name
1087 key_payload # $self->key_payload, # the payload fieldname
1088 key_redirect # $self->key_redirect, # the redirect fieldname
1089 form_name # $self->form_name, # the name of the form
1090 script_name # $self->script_name, # where the server will post back to
1091 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1092 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1093 use_plaintext # $self->use_plaintext, # used to avoid cramming
1094 $self->key_user # $data->{'user'}, # the username (if any)
1095 $self->key_pass # '', # intentional blankout
1096 $self->key_time # $self->server_time, # the server's time
1097 $self->key_payload # $data->{'payload'} # the payload (if any)
1098 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1099 text_user # $self->text_user # template text Username:
1100 text_pass # $self->text_pass # template text Password:
1101 text_save # $self->text_save # template text Save Password ?
1102 text_submit # $self->text_submit # template text Login
1103 hide_save # $self->hide_save # 0
1105 =item C<bounce_on_logout>
1107 Default 0. If true, will location bounce to script returned by logout_redirect
1108 passing the key key_logout. If false, will simply show the login screen.
1110 =item C<key_loggedout>
1112 Key to bounce with in the form during a logout should bounce_on_logout return true.
1113 Default is "loggedout".
1117 If the form hash contains a true value in this field name, the current user will
1118 be logged out. Default is "cea_logout".
1122 The name of the auth cookie. Default is "cea_user".
1126 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1130 The form field name used to pass the username. Default is "cea_user".
1134 The form field name used to pass the password. Default is "cea_pass".
1138 Works in conjunction with key_expires_min. If key_save is true, then
1139 the cookie will be set to be saved for longer than the current session
1140 (If it is a plaintext variety it will be given a 20 year life rather
1141 than being a session cookie. If it is a cram variety, the expires_min
1142 portion of the cram will be set to -1). If it is set to false, the cookie
1143 will be available only for the session (If it is a plaintext variety, the cookie
1144 will be session based and will be removed on the next loggout. If it is
1145 a cram variety then the cookie will only be good for expires_min minutes.
1147 Default is "cea_save".
1149 =item C<key_expires_min>
1151 The name of the form field that contains how long cram type cookies will be valid
1152 if key_save contains a false value.
1154 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1156 This value will have no effect when use_plaintext or use_crypt is set.
1158 A value of -1 means no expiration.
1160 =item C<failed_sleep>
1162 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1163 if validation failed because of expired tokens. Default value is 0.
1164 Setting to 0 disables any sleeping.
1168 The name of the html login form to attach the javascript to. Default is "cea_form".
1170 =item C<verify_token>
1172 This method verifies the token that was passed either via the form or via cookies.
1173 It will accept plaintext or crammed tokens (A listing of the available algorithms
1174 for creating tokes is listed below). It also allows for armoring the token with
1175 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1176 can be found under generate_token.
1178 =item C<parse_token>
1180 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1181 Returns true if it was able to parse the passed token.
1183 =item C<cleanup_user>
1185 Called by verify_token. Default is to do no modification. Allows for usernames to
1186 be lowercased, or canonized in some other way. Should return the cleaned username.
1188 =item C<verify_user>
1190 Called by verify_token. Single argument is the username. May or may not be an
1191 initial check to see if the username is ok. The username will already be cleaned at
1192 this point. Default return is true.
1194 =item C<get_pass_by_user>
1196 Called by verify_token. Given the cleaned, verified username, should return a
1197 valid password for the user. It can always return plaintext. If use_crypt is
1198 enabled, it should return the crypted password. If use_plaintext and use_crypt
1199 are not enabled, it may return the md5 sum of the password.
1201 get_pass_by_user => sub {
1202 my ($auth_obj, $user) = @_;
1203 my $pass = $some_obj->get_pass({user => $user});
1207 Alternately, get_pass_by_user may return a hashref of data items that
1208 will be added to the data object if the token is valid. The hashref
1209 must also contain a key named real_pass or password that contains the
1210 password. Note that keys passed back in the hashref that are already
1211 in the data object will override those in the data object.
1213 get_pass_by_user => sub {
1214 my ($auth_obj, $user) = @_;
1215 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1218 user_id => $user_id,
1222 =item C<verify_password>
1224 Called by verify_token. Passed the password to check as well as the
1225 auth data object. Should return true if the password matches.
1226 Default method can handle md5, crypt, cram, secure_hash_cram, and
1227 plaintext (all of the default types supported by generate_token). If
1228 a property named verify_password exists, it will be used and called as
1229 a coderef rather than using the default method.
1231 =item C<verify_payload>
1233 Called by verify_token. Passed the password to check as well as the
1234 auth data object. Should return true if the payload is valid.
1235 Default method returns true without performing any checks on the
1236 payload. If a property named verify_password exists, it will be used
1237 and called as a coderef rather than using the default method.
1242 Returns a CGI::Ex object.
1246 A hash of passed form info. Defaults to CGI::Ex::get_form.
1250 The current cookies. Defaults to CGI::Ex::get_cookies.
1252 =item C<login_template>
1254 Should return either a template filename to use for the login template, or it
1255 should return a reference to a string that contains the template. The contents
1256 will be used in login_print and passed to the template engine.
1258 Default login_template is the values of login_header, login_form, login_script, and
1259 login_script concatenated together.
1261 Values from login_hash_common will be passed to the template engine, and will
1262 also be used to fill in the form.
1264 The basic values are capable of handling most needs so long as appropriate
1265 headers and css styles are used.
1267 =item C<login_header>
1269 Should return a header to use in the default login_template. The default
1270 value will try to PROCESS a file called login_header.tt that should be
1271 located in directory specified by the template_include_path method.
1273 It should ideally supply css styles that format the login_form as desired.
1275 =item C<login_footer>
1277 Same as login_header - but for the footer. Will look for login_footer.tt by
1282 An html chunk that contains the necessary form fields to login the user. The
1283 basic chunk has a username text entry, password text entry, save password checkbox,
1284 and submit button, and any hidden fields necessary for logging in the user.
1286 =item C<login_script>
1288 Contains javascript that will attach to the form from login_form. This script
1289 is capable of taking the login_fields and creating an md5 cram which prevents
1290 the password from being passed plaintext.
1292 =item C<text_user, text_pass, text_save>
1294 The text items shown in the default login template. The default values are:
1296 text_user "Username:"
1297 text_pass "Password:"
1298 text_save "Save Password ?"
1304 This module may be distributed under the same terms as Perl itself.
1308 Paul Seamons <perl at seamons dot com>
This page took 0.13778 seconds and 4 git commands to generate.