]>
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
54 if ($self->bounce_on_logout) {
55 my $key_c = $self->key_cookie;
56 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
57 my $user = $self->last_auth_data ? $self->last_auth_data->{'user'} : undef;
58 $self->location_bounce($self->logout_redirect(defined($user) ? $user : ''));
59 eval { die "Logging out" };
63 $self->handle_failure;
68 ### look first in form, then in cookies for valid tokens
70 foreach ([$form, $self->key_user, 1],
71 [$self->cookies, $self->key_cookie, 0],
73 my ($hash, $key, $is_form) = @$_;
74 next if ! defined $hash->{$key};
75 last if ! $is_form && $had_form_data; # if form info was passed in - we must use it only
76 $had_form_data = 1 if $is_form;
77 next if ! length $hash->{$key};
79 ### if it looks like a bare username (as in they didn't have javascript) - add in other items
81 if ($is_form && delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
82 my $key_u = $self->key_user;
83 $self->new_auth_data({user
=> delete($form->{$key_u})});
87 && $hash->{$key} !~ m
|^[^/]+/| # looks like a cram token
88 && defined $hash->{ $self->key_pass }) {
89 $data = $self->verify_token({
91 user
=> delete $hash->{$key},
92 test_pass
=> delete $hash->{ $self->key_pass },
93 expires_min
=> delete($hash->{ $self->key_save }) ? -1 : delete($hash->{ $self->key_expires_min }) || $self->expires_min,
99 $data = $self->verify_token({token
=> $hash->{$key}, from
=> ($is_form ? 'form' : 'cookie')}) || next;
100 delete $hash->{$key} if $is_form;
103 ### generate a fresh cookie if they submitted info on plaintext types
105 && ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt'))) {
107 key
=> $self->key_cookie,
108 val
=> $self->generate_token($data),
109 no_expires
=> ($data->{ $self->key_save } ? 0 : 1), # make it a session cookie unless they ask for saving
112 ### always generate a cookie on types that have expiration
115 key
=> $self->key_cookie,
116 val
=> $self->generate_token($data),
122 return $self->handle_success({is_form
=> $is_form});
125 return $self->handle_failure({had_form_data
=> $had_form_data});
130 my $args = shift || {};
131 if (my $meth = $self->{'handle_success'}) {
132 return $meth->($self, $args);
134 my $form = $self->form;
136 ### bounce to redirect
137 if (my $redirect = $form->{ $self->key_redirect }) {
138 $self->location_bounce($redirect);
139 eval { die "Success login - bouncing to redirect" };
142 ### if they have cookies we are done
143 } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
147 ### need to verify cookies are set-able
148 } elsif ($args->{'is_form'}) {
149 $form->{$self->key_verify} = $self->server_time;
150 my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
152 $self->location_bounce($url);
153 eval { die "Success login - bouncing to test cookie" };
160 if (my $meth = $self->{'success_hook'}) {
161 return $meth->($self);
168 if (my $meth = $self->{'logout_hook'}) {
169 return $meth->($self);
176 my $args = shift || {};
177 if (my $meth = $self->{'handle_failure'}) {
178 return $meth->($self, $args);
180 my $form = $self->form;
182 ### make sure the cookie is gone
183 my $key_c = $self->key_cookie;
184 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
186 ### no valid login and we are checking for cookies - see if they have cookies
187 if (my $value = delete $form->{$self->key_verify}) {
188 if (abs(time() - $value) < 15) {
189 $self->no_cookies_print;
194 ### oh - you're still here - well then - ask for login credentials
195 my $key_r = $self->key_redirect;
196 local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
197 local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
199 my $data = $self->last_auth_data;
200 eval { die defined($data) ? $data : "Requesting credentials" };
202 ### allow for a sleep to help prevent brute force
203 sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
211 if (my $meth = $self->{'failure_hook'}) {
212 return $meth->($self);
217 sub check_valid_auth
{
219 $self = $self->new(@_) if ! ref $self;
221 local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
222 local $self->{'login_print'} = sub {}; # check only - don't login if not
223 local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
224 return $self->get_valid_auth;
227 ###----------------------------------------------------------------###
229 sub script_name
{ shift-
>{'script_name'} || $ENV{'SCRIPT_NAME'} || die "Missing SCRIPT_NAME" }
231 sub path_info
{ shift-
>{'path_info'} || $ENV{'PATH_INFO'} || '' }
233 sub server_time
{ time }
237 $self->{'cgix'} = shift if @_ == 1;
238 return $self->{'cgix'} ||= CGI
::Ex-
>new;
243 $self->{'form'} = shift if @_ == 1;
244 return $self->{'form'} ||= $self->cgix->get_form;
249 $self->{'cookies'} = shift if @_ == 1;
250 return $self->{'cookies'} ||= $self->cgix->get_cookies;
256 return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
257 my $key = $args->{'key'};
258 $self->cgix->set_cookie({
264 delete $self->cookies->{$key};
270 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
271 my $key = $args->{'key'};
272 my $val = $args->{'val'};
273 $self->cgix->set_cookie({
276 ($args->{'no_expires'} ? () : (-expires
=> '+20y')), # let the expires time take care of things for types that self expire
279 $self->cookies->{$key} = $val;
282 sub location_bounce
{
285 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
286 return $self->cgix->location_bounce($url);
289 ###----------------------------------------------------------------###
291 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
292 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
293 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
294 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
295 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
296 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
297 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
298 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
299 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
300 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
301 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
302 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
303 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
304 #perl -e 'use Digest::MD5 qw(md5_hex); open(my $fh, "<", "/dev/urandom"); for (1..10) { read $fh, my $t, 5_000_000; print md5_hex($t),"\n"}'
305 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
306 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
307 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
308 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
309 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
310 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
311 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
312 sub disable_simple_cram
{ shift-
>{'disable_simple_cram'} }
314 sub logout_redirect
{
315 my ($self, $user) = @_;
316 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
317 return $self->{'logout_redirect'} || $self->script_name ."?$form";
322 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
325 ###----------------------------------------------------------------###
327 sub no_cookies_print
{
329 $self->cgix->print_content_type;
330 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
336 my $hash = $self->login_hash_common;
337 my $file = $self->login_template;
339 ### allow for a hooked override
340 if (my $meth = $self->{'login_print'}) {
341 $meth->($self, $file, $hash);
345 ### process the document
346 my $args = $self->template_args;
347 $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_include_path,
348 my $t = $self->template_obj($args);
350 $t->process_simple($file, $hash, \
$out) || die $t->error;
352 ### fill in form fields
353 require CGI
::Ex
::Fill
;
354 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
357 $self->cgix->print_content_type;
364 my ($self, $args) = @_;
365 return $self->{'template_obj'} || do {
366 require Template
::Alloy
;
367 Template
::Alloy-
>new($args);
371 sub template_args
{ $_[0]->{'template_args'} ||= {} }
373 sub template_include_path
{ $_[0]->{'template_include_path'} || '' }
375 sub login_hash_common
{
377 my $form = $self->form;
378 my $data = $self->last_auth_data || {};
382 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
384 key_user
=> $self->key_user,
385 key_pass
=> $self->key_pass,
386 key_time
=> $self->key_time,
387 key_save
=> $self->key_save,
388 key_expires_min
=> $self->key_expires_min,
389 key_redirect
=> $self->key_redirect,
390 form_name
=> $self->form_name,
391 script_name
=> $self->script_name,
392 path_info
=> $self->path_info,
393 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
394 $self->key_user => $data->{'user'} || '',
395 $self->key_pass => '', # don't allow for this to get filled into the form
396 $self->key_time => $self->server_time,
397 $self->key_expires_min => $self->expires_min,
398 text_user
=> $self->text_user,
399 text_pass
=> $self->text_pass,
400 text_save
=> $self->text_save,
401 text_submit
=> $self->text_submit,
402 hide_save
=> $self->hide_save,
406 ###----------------------------------------------------------------###
411 my $token = delete $args->{'token'}; die "Missing token" if ! length $token;
412 my $data = $self->new_auth_data({token
=> $token, %$args});
415 ### make sure the token is parsed to usable data
416 if (ref $token) { # token already parsed
417 $data->add_data({%$token, armor
=> 'none'});
419 } elsif (my $meth = $self->{'parse_token'}) {
420 if (! $meth->($self, $args)) {
421 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
425 if (! $self->parse_token($token, $data)) {
426 $data->error('Invalid token') if ! $data->error; # add error if not already added
433 if (! defined($data->{'user'})) {
434 $data->error('Missing user');
436 } elsif (! defined $data->{'test_pass'}) {
437 $data->error('Missing test_pass');
439 } elsif (! $self->verify_user($data->{'user'} = $self->cleanup_user($data->{'user'}))) {
440 $data->error('Invalid user');
443 return $data if $data->error;
447 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
448 $data->add_data({details
=> $@});
449 $data->error('Could not get pass');
450 } elsif (ref $pass eq 'HASH') {
452 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
453 : exists($extra->{'password'}) ? delete($extra->{'password'})
454 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
455 $data->error('Invalid login') if ! defined $pass && ! $data->error;
456 $data->add_data($extra);
458 return $data if $data->error;
459 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
462 ### validate the pass
463 if ($meth = $self->{'verify_password'}) {
464 if (! $meth->($self, $pass, $data)) {
465 $data->error('Password failed verification') if ! $data->error;
468 if (! $self->verify_password($pass, $data)) {
469 $data->error('Password failed verification') if ! $data->error;
472 return $data if $data->error;
475 ### validate the payload
476 if ($meth = $self->{'verify_payload'}) {
477 if (! $meth->($self, $data->{'payload'}, $data)) {
478 $data->error('Payload failed custom verification') if ! $data->error;
481 if (! $self->verify_payload($data->{'payload'}, $data)) {
482 $data->error('Payload failed verification') if ! $data->error;
491 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
495 my ($self, $token, $data) = @_;
498 for my $armor ('none', 'base64', 'blowfish') { # try with and without base64 encoding
499 my $copy = ($armor eq 'none') ? $token
500 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
501 : ($key = $self->use_blowfish) ? decrypt_blowfish
($token, $key)
503 if ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
510 secure_hash
=> $6 || '',
515 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
528 sub verify_password
{
529 my ($self, $pass, $data) = @_;
532 ### looks like a secure_hash cram
533 if ($data->{'secure_hash'}) {
534 $data->add_data(type
=> 'secure_hash_cram');
535 my $array = eval {$self->secure_hash_keys };
537 $err = 'secure_hash_keys not found';
538 } elsif (! @$array) {
539 $err = 'secure_hash_keys empty';
540 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
541 $err = 'Invalid secure hash';
545 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
546 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
547 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
548 if ($data->{'expires_min'} > 0
549 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
550 $err = 'Login expired';
551 } elsif (lc($data->{'test_pass'}) ne $sum) {
552 $err = 'Invalid login';
556 ### looks like a simple_cram
557 } elsif ($data->{'cram_time'}) {
558 $data->add_data(type
=> 'simple_cram');
559 die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
560 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
561 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
562 my $sum = md5_hex
($str .'/'. $real);
563 if ($data->{'expires_min'} > 0
564 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
565 $err = 'Login expired';
566 } elsif (lc($data->{'test_pass'}) ne $sum) {
567 $err = 'Invalid login';
571 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
572 && crypt($data->{'test_pass'}, $1) eq $pass) {
573 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
575 ### failed plaintext crypt
576 } elsif ($self->use_crypt) {
577 $err = 'Invalid login';
578 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
580 ### plaintext and md5
582 my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
583 my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
584 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
585 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
586 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
587 $err = 'Invalid login'
591 $data->error($err) if $err;
595 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
599 my $data = shift || $self->last_auth_data;
600 die "Can't generate a token off of a failed auth" if ! $data;
604 ### do kinds that require staying plaintext
605 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
606 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
607 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
608 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
609 $token = $data->{'user'} .'/'. $pass;
611 ### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
613 my $user = $data->{'user'} || die "Missing user";
614 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
615 : die "Missing real_pass";
616 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
617 my $load = $self->generate_payload($data);
618 die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m
|/|;
619 die "User can not contain a \"/\." if $user =~ m
|/|;
622 if (! $data->{'prefer_simple_cram'}
623 && ($array = eval { $self->secure_hash_keys })
625 my $rand1 = int(rand @$array);
626 my $rand2 = int(rand 100000);
627 my $str = join("/", $user, $self->server_time, $exp, $load);
628 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
629 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
631 die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
632 my $str = join("/", $user, $self->server_time, $exp, $load);
633 my $sum = md5_hex
($str .'/'. $real);
634 $token = $str .'/'. $sum;
638 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
639 $token = encrypt_blowfish
($token, $key);
641 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
642 $token = encode_base64
($token, '');
648 sub generate_payload
{
651 if (my $meth = $self->{'generate_payload'}) {
652 return $meth->($self, $args);
654 return defined($args->{'payload'}) ? $args->{'payload'} : '';
660 if (my $meth = $self->{'verify_user'}) {
661 return $meth->($self, $user);
669 if (my $meth = $self->{'cleanup_user'}) {
670 return $meth->($self, $user);
675 sub get_pass_by_user
{
678 if (my $meth = $self->{'get_pass_by_user'}) {
679 return $meth->($self, $user);
682 die "Please override get_pass_by_user";
686 my ($self, $payload, $data) = @_;
687 if (my $meth = $self->{'verify_payload'}) {
688 return $meth->($self, $payload, $data);
693 ###----------------------------------------------------------------###
695 sub encrypt_blowfish
{
696 my ($str, $key) = @_;
698 require Crypt
::Blowfish
;
699 my $cb = Crypt
::Blowfish-
>new($key);
701 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
704 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
709 sub decrypt_blowfish
{
710 my ($enc, $key) = @_;
712 require Crypt
::Blowfish
;
713 my $cb = Crypt
::Blowfish-
>new($key);
716 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
722 ###----------------------------------------------------------------###
726 return $self->{'login_template'} if $self->{'login_template'};
729 . $self->login_header
731 . $self->login_script
732 . $self->login_footer;
737 return shift-
>{'login_header'} || q
{
738 [%~ TRY
; PROCESS
'login_header.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
743 return shift-
>{'login_footer'} || q
{
744 [%~ TRY
; PROCESS
'login_footer.tt' ; CATCH %]<!-- [% error
%] -->[% END ~%]
749 return shift-
>{'login_form'} || q
{
750 <div
class="login_chunk">
751 <span
class="login_error">[% error
%]</span
>
752 <form
class="login_form" name
="[% form_name %]" method="POST" action
="[% script_name %][% path_info %]">
753 <input type
="hidden" name
="[% key_redirect %]" value
="">
754 <input type
="hidden" name
="[% key_time %]" value
="">
755 <input type
="hidden" name
="[% key_expires_min %]" value
="">
756 <table
class="login_table">
757 <tr
class="login_username">
758 <td
>[% text_user
%]</td
>
759 <td
><input name
="[% key_user %]" type
="text" size
="30" value
=""></td
>
761 <tr
class="login_password">
762 <td
>[% text_pass
%]</td
>
763 <td
><input name
="[% key_pass %]" type
="password" size
="30" value
=""></td
>
765 [% IF
! hide_save
~%]
766 <tr
class="login_save">
768 <input type
="checkbox" name
="[% key_save %]" value
="1"> [% text_save
%]
772 <tr
class="login_submit">
773 <td colspan
="2" align
="right">
774 <input type
="submit" value
="[% text_submit %]">
783 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
784 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
785 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
786 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
787 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
791 return $self->{'login_script'} if $self->{'login_script'};
792 return '' if $self->use_plaintext || $self->disable_simple_cram;
794 <form name
="[% form_name %]_jspost" style
="margin:0px" method="POST">
795 <input type
="hidden" name
="[% key_user %]"><input type
="hidden" name
="[% key_redirect %]">
797 <script src
="[% md5_js_path %]"></script
>
799 if (document
.md5_hex
) document
.[% form_name
%].onsubmit
= function
() {
800 var f
= document
.[% form_name
%];
801 var u
= f
.[% key_user
%].value
;
802 var p
= f
.[% key_pass
%].value
;
803 var t
= f
.[% key_time
%].value
;
804 var s
= f
.[% key_save
%] && f
.[% key_save
%].checked
? -1 : f
.[% key_expires_min
%].value
;
806 var str
= u
+'/'+t
+'/'+s
+'/'+'';
807 var sum
= document
.md5_hex
(str
+'/' + document
.md5_hex
(p
));
809 var f2
= document
.[% form_name
%]_jspost
;
810 f2
.[% key_user
%].value
= str
+'/'+ sum
;
811 f2
.[% key_redirect
%].value
= f
.[% key_redirect
%].value
;
812 f2
.action
= f
.action
;
820 ###----------------------------------------------------------------###
822 package CGI
::Ex
::Auth
::Data
;
826 'bool' => sub { ! shift-
>error },
828 '""' => sub { shift-
>as_string },
832 my ($class, $args) = @_;
833 return bless {%{ $args || {} }}, $class;
838 my $args = @_ == 1 ? shift : {@_};
839 @{ $self }{keys %$args} = values %$args;
845 $self->{'error'} = shift;
846 $self->{'error_caller'} = [caller];
848 return $self->{'error'};
853 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
856 ###----------------------------------------------------------------###
866 ### authorize the user
867 my $auth = CGI::Ex::Auth->get_valid_auth({
868 get_pass_by_user => \&get_pass_by_user,
872 sub get_pass_by_user {
875 my $pass = some_way_of_getting_password($user);
879 ### OR - if you are using a OO based CGI or Application
881 sub require_authentication {
884 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
885 get_pass_by_user => sub {
886 my ($auth, $user) = @_;
887 return $self->get_pass($user);
893 my ($self, $user) = @_;
894 return $self->loopup_and_cache_pass($user);
899 CGI::Ex::Auth allows for auto-expiring, safe and easy web based
900 logins. Auth uses javascript modules that perform MD5 hashing to cram
901 the password on the client side before passing them through the
904 For the stored cookie you can choose to use simple cram mechanisms,
905 secure hash cram tokens, auto expiring logins (not cookie based),
906 and Crypt::Blowfish protection. You can also choose to keep
907 passwords plaintext and to use perl's crypt for testing
910 A theoretical downside to this module is that it does not use a
911 session to preserve state so get_pass_by_user has to happen on every
912 request (any authenticated area has to verify authentication each
913 time). In theory you should be checking the password everytime a user
914 makes a request to make sure the password is still valid. A definite
915 plus is that you don't need to use a session if you don't want to. It
916 is up to the interested reader to add caching to the get_pass_by_user
919 In the end, the only truly secure login method is across an https
920 connection. Any connection across non-https (non-secure) is
921 susceptible to cookie hijacking or tcp hijacking - though the
922 possibility of this is normally small and typically requires access to
923 a machine somewhere in your TCP chain. If in doubt - you should try
932 Constructor. Takes a hashref of properties as arguments.
934 Many of the methods which may be overridden in a subclass,
935 or may be passed as properties to the new constuctor such as in the following:
938 get_pass_by_user => \&my_pass_sub,
939 key_user => 'my_user',
940 key_pass => 'my_pass',
941 login_header => \"<h1>My Login</h1>",
944 The following methods will look for properties of the same name. Each of these will be
945 described separately.
981 template_include_path
995 =item C<generate_token>
997 Takes either an auth_data object from a auth_data returned by verify_token,
998 or a hashref of arguments.
1000 Possible arguments are:
1002 user - the username we are generating the token for
1003 real_pass - the password of the user (if use_plaintext is false
1004 and use_crypt is false, the password can be an md5sum
1005 of the user's password)
1006 use_blowfish - indicates that we should use Crypt::Blowfish to protect
1007 the generated token. The value of this argument is used
1008 as the key. Default is false.
1009 use_base64 - indicates that we should use Base64 encoding to protect
1010 the generated token. Default is true. Will not be
1011 used if use_blowfish is true.
1012 use_plaintext - indicates that we should keep the password in plaintext
1013 use_crypt - also indicates that we should keep the password in plaintext
1014 expires_min - says how many minutes until the generated token expires.
1015 Values <= 0 indicate to not ever expire. Used only on cram
1017 payload - a payload that will be passed to generate_payload and then
1018 will be added to cram type tokens. It cannot contain a /.
1020 - If the secure_hash_keys method returns keys, and it is a non-plaintext
1021 token, generate_token will create a secure_hash_cram. Set
1022 this value to true to tell it to use a simple_cram. This
1023 is generally only useful in testing.
1025 The following are types of tokens that can be generated by generate_token. Each type includes
1026 pseudocode and a sample of a generated that token.
1030 real_pass := "123qwe"
1031 token := join("/", user, real_pass);
1034 token == "paul/123qwe"
1037 token == "cGF1bC8xMjNxd2U="
1039 use_blowfish := "foobarbaz"
1040 token == "6da702975190f0fe98a746f0d6514683"
1042 Notes: This token will be used if either use_plaintext or use_crypt is set.
1043 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1044 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1045 token will not be able to be verified.
1049 real_pass := "123qwe"
1050 server_time := 1148512991 # a time in seconds since epoch
1051 expires_min := 6 * 60
1052 payload := "something"
1054 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1055 str := join("/", user, server_time, expires_min, payload, md5_pass)
1056 md5_str := md5(sum_str)
1057 token := join("/", user, server_time, expires_min, payload, md5_str)
1060 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1063 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1065 Notes: use_blowfish is available as well
1069 real_pass := "123qwe"
1070 server_time := 1148514034 # a time in seconds since epoch
1071 expires_min := 6 * 60
1072 payload := "something"
1073 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1074 rand1 := 3 # int(rand(length(secure_hash)))
1075 rand2 := 39163 # int(rand(100000))
1077 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1079 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1080 sh_str2 := join(".", "sh", rand1, rand2)
1081 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1082 md5_str := md5(sum_str)
1083 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1086 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1088 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1089 "secure_hash_keys" property of the CGI::Ex::Auth object.
1091 =item C<get_valid_auth>
1093 Performs the core logic. Returns an auth object on successful login.
1094 Returns false on errored login (with the details of the error stored in
1095 $@). If a false value is returned, execution of the CGI should be halted.
1096 get_valid_auth WILL NOT automatically stop execution.
1098 $auth->get_valid_auth || exit;
1100 Optionally, the class and a list of arguments may be passed. This will create a
1101 new object using the passed arguments, and then run get_valid_auth.
1103 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1105 =item C<check_valid_auth>
1107 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1108 This allows for obtaining login data without forcing an html login
1111 =item C<login_print>
1113 Called if login errored. Defaults to printing a very basic (but
1114 adequate) page loaded from login_template..
1116 You will want to override it with a template from your own system.
1117 The hook that is called will be passed the step to print (currently
1118 only "get_login_info" and "no_cookies"), and a hash containing the
1119 form variables as well as the following:
1121 =item C<login_hash_common>
1123 Passed to the template swapped during login_print.
1125 %$form, # any keys passed to the login script
1126 error # The text "Login Failed" if a login occurred
1127 login_data # A login data object if they failed authentication.
1128 key_user # $self->key_user, # the username fieldname
1129 key_pass # $self->key_pass, # the password fieldname
1130 key_time # $self->key_time, # the server time field name
1131 key_save # $self->key_save, # the save password checkbox field name
1132 key_redirect # $self->key_redirect, # the redirect fieldname
1133 form_name # $self->form_name, # the name of the form
1134 script_name # $self->script_name, # where the server will post back to
1135 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1136 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1137 $self->key_user # $data->{'user'}, # the username (if any)
1138 $self->key_pass # '', # intentional blankout
1139 $self->key_time # $self->server_time, # the server's time
1140 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1141 text_user # $self->text_user # template text Username:
1142 text_pass # $self->text_pass # template text Password:
1143 text_save # $self->text_save # template text Save Password ?
1144 text_submit # $self->text_submit # template text Login
1145 hide_save # $self->hide_save # 0
1147 =item C<bounce_on_logout>
1149 Default 0. If true, will location bounce to script returned by logout_redirect
1150 passing the key key_logout. If false, will simply show the login screen.
1152 =item C<key_loggedout>
1154 Key to bounce with in the form during a logout should bounce_on_logout return true.
1155 Default is "loggedout".
1159 If the form hash contains a true value in this field name, the current user will
1160 be logged out. Default is "cea_logout".
1164 The name of the auth cookie. Default is "cea_user".
1168 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1172 The form field name used to pass the username. Default is "cea_user".
1176 The form field name used to pass the password. Default is "cea_pass".
1180 Works in conjunction with key_expires_min. If key_save is true, then
1181 the cookie will be set to be saved for longer than the current session
1182 (If it is a plaintext variety it will be given a 20 year life rather
1183 than being a session cookie. If it is a cram variety, the expires_min
1184 portion of the cram will be set to -1). If it is set to false, the cookie
1185 will be available only for the session (If it is a plaintext variety, the cookie
1186 will be session based and will be removed on the next loggout. If it is
1187 a cram variety then the cookie will only be good for expires_min minutes.
1189 Default is "cea_save".
1191 =item C<key_expires_min>
1193 The name of the form field that contains how long cram type cookies will be valid
1194 if key_save contains a false value.
1196 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1198 This value will have no effect when use_plaintext or use_crypt is set.
1200 A value of -1 means no expiration.
1202 =item C<failed_sleep>
1204 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1205 if validation failed because of expired tokens. Default value is 0.
1206 Setting to 0 disables any sleeping.
1210 The name of the html login form to attach the javascript to. Default is "cea_form".
1212 =item C<verify_token>
1214 This method verifies the token that was passed either via the form or via cookies.
1215 It will accept plaintext or crammed tokens (A listing of the available algorithms
1216 for creating tokes is listed below). It also allows for armoring the token with
1217 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1218 can be found under generate_token.
1220 =item C<parse_token>
1222 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1223 Returns true if it was able to parse the passed token.
1225 =item C<cleanup_user>
1227 Called by verify_token. Default is to do no modification. Allows for usernames to
1228 be lowercased, or canonized in some other way. Should return the cleaned username.
1230 =item C<verify_user>
1232 Called by verify_token. Single argument is the username. May or may not be an
1233 initial check to see if the username is ok. The username will already be cleaned at
1234 this point. Default return is true.
1236 =item C<get_pass_by_user>
1238 Called by verify_token. Given the cleaned, verified username, should return a
1239 valid password for the user. It can always return plaintext. If use_crypt is
1240 enabled, it should return the crypted password. If use_plaintext and use_crypt
1241 are not enabled, it may return the md5 sum of the password.
1243 get_pass_by_user => sub {
1244 my ($auth_obj, $user) = @_;
1245 my $pass = $some_obj->get_pass({user => $user});
1249 Alternately, get_pass_by_user may return a hashref of data items that
1250 will be added to the data object if the token is valid. The hashref
1251 must also contain a key named real_pass or password that contains the
1252 password. Note that keys passed back in the hashref that are already
1253 in the data object will override those in the data object.
1255 get_pass_by_user => sub {
1256 my ($auth_obj, $user) = @_;
1257 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1260 user_id => $user_id,
1264 =item C<verify_password>
1266 Called by verify_token. Passed the password to check as well as the
1267 auth data object. Should return true if the password matches.
1268 Default method can handle md5, crypt, cram, secure_hash_cram, and
1269 plaintext (all of the default types supported by generate_token). If
1270 a property named verify_password exists, it will be used and called as
1271 a coderef rather than using the default method.
1273 =item C<verify_payload>
1275 Called by verify_token. Passed the password to check as well as the
1276 auth data object. Should return true if the payload is valid.
1277 Default method returns true without performing any checks on the
1278 payload. If a property named verify_password exists, it will be used
1279 and called as a coderef rather than using the default method.
1284 Returns a CGI::Ex object.
1288 A hash of passed form info. Defaults to CGI::Ex::get_form.
1292 The current cookies. Defaults to CGI::Ex::get_cookies.
1294 =item C<login_template>
1296 Should return either a template filename to use for the login template, or it
1297 should return a reference to a string that contains the template. The contents
1298 will be used in login_print and passed to the template engine.
1300 Default login_template is the values of login_header, login_form, login_script, and
1301 login_script concatenated together.
1303 Values from login_hash_common will be passed to the template engine, and will
1304 also be used to fill in the form.
1306 The basic values are capable of handling most needs so long as appropriate
1307 headers and css styles are used.
1309 =item C<login_header>
1311 Should return a header to use in the default login_template. The default
1312 value will try to PROCESS a file called login_header.tt that should be
1313 located in directory specified by the template_include_path method.
1315 It should ideally supply css styles that format the login_form as desired.
1317 =item C<login_footer>
1319 Same as login_header - but for the footer. Will look for login_footer.tt by
1324 An html chunk that contains the necessary form fields to login the user. The
1325 basic chunk has a username text entry, password text entry, save password checkbox,
1326 and submit button, and any hidden fields necessary for logging in the user.
1328 =item C<login_script>
1330 Contains javascript that will attach to the form from login_form. This script
1331 is capable of taking the login_fields and creating an md5 cram which prevents
1332 the password from being passed plaintext.
1334 =item C<text_user, text_pass, text_save>
1336 The text items shown in the default login template. The default values are:
1338 text_user "Username:"
1339 text_pass "Password:"
1340 text_save "Save Password ?"
1342 =item C<disable_simple_cram>
1344 Disables simple cram type from being an available type. Default is
1345 false. If set, then one of use_plaintext, use_crypt, or
1346 secure_hash_keys should be set. Setting this option allows for
1347 payloads to be generated by the server only - otherwise a user who
1348 understands the algorithm could generate a valid simple_cram cookie
1349 with a custom payload.
1351 Another option would be to only accept payloads from tokens if use_blowfish
1352 is set and armor was equal to "blowfish."
1358 This module may be distributed under the same terms as Perl itself.
1362 Paul Seamons <perl at seamons dot com>
This page took 0.136343 seconds and 4 git commands to generate.