]>
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);
24 ###----------------------------------------------------------------###
27 my $class = shift || croak
"Usage: ".__PACKAGE__
."->new";
28 my $self = ref($_[0]) ? shift() : (@_ % 2) ? {} : {@_};
29 return bless {%$self}, $class;
34 $self = $self->new(@_) if ! ref $self;
35 delete $self->{'_last_auth_data'};
37 # shortcut that will print a js file as needed (such as the md5.js)
38 if ($self->script_name . $self->path_info eq $self->js_uri_path . "/CGI/Ex/md5.js") {
39 $self->cgix->print_js('CGI/Ex/md5.js');
40 eval { die "Printed Javascript" };
44 my $form = $self->form;
47 if ($form->{$self->key_logout} && ! $self->{'_logout_looking_for_user'}) {
48 local $self->{'_logout_looking_for_user'} = 1;
49 local $self->{'no_set_cookie'} = 1;
50 local $self->{'no_cookie_verify'} = 1;
51 $self->check_valid_auth; # verify the logout so we can capture the username if possible
55 if ($self->bounce_on_logout) {
56 my $key_c = $self->key_cookie;
57 $self->delete_cookie({key
=> $key_c}) if $self->cookies->{$key_c};
58 my $user = $self->last_auth_data ? $self->last_auth_data->{'user'} : undef;
59 $self->location_bounce($self->logout_redirect(defined($user) ? $user : ''));
60 eval { die "Logging out" };
64 $self->handle_failure;
72 my $form_user = delete $form->{$self->key_user};
73 if (defined $form_user) {
74 if (delete $form->{$self->key_loggedout}) { # don't validate the form on a logout
75 $data = $self->new_auth_data({user
=> $form_user, error
=> 'Logged out'});
76 } elsif (defined $form->{ $self->key_pass }) {
77 $data = $self->verify_token({
80 test_pass
=> delete $form->{ $self->key_pass },
81 expires_min
=> delete($form->{ $self->key_save }) ? -1 : delete($form->{ $self->key_expires_min }) || undef,
85 } elsif (! length $form_user) {
86 $data = $self->new_auth_data({user
=> '', error
=> 'Invalid user'});
88 $data = $self->verify_token({token
=> $form_user, from
=> 'form'});
92 # no valid form data ? look in the cookie
93 if (! ref($data) # no form
94 || ($data->error && $data->{'allow_cookie_match'})) { # had form with error - but we can check if form user matches existing cookie
95 my $cookie = $self->cookies->{$self->key_cookie};
96 if (defined($cookie) && length($cookie)) {
97 my $form_data = $data;
98 $data = $self->verify_token({token
=> $cookie, from
=> 'cookie'});
99 if (defined $form_user) { # they had form data
100 my $user = $self->cleanup_user($form_user);
101 if (! $data || $user ne $data->{'user'}) { # but the cookie didn't match
102 $data = $self->{'_last_auth_data'} = $form_data; # restore old form data failure
103 $data->{'user'} = $user if ! defined $data->{'user'};
111 return $self->handle_failure({had_form_data
=> defined($form_user)});
115 my $_key = $self->key_cookie;
116 my $_val = $self->generate_token($data);
117 my $use_session = $self->use_session_cookie($_key, $_val); # default false
118 if ($self->use_plaintext || ($data->{'type'} && $data->{'type'} eq 'crypt')) {
119 $use_session = 1 if ! defined($use_session) && ! defined($data->{'expires_min'});
124 expires
=> ($use_session ? '' : '+20y'), # non-cram cookie types are session cookies unless save was set (thus setting expires_min)
127 return $self->handle_success({is_form
=> ($data->{'from'} eq 'form' ? 1 : 0)});
132 my $args = shift || {};
133 if (my $meth = $self->{'handle_success'}) {
134 return $meth->($self, $args);
136 my $form = $self->form;
139 if (my $redirect = $form->{ $self->key_redirect }) {
140 $self->location_bounce($redirect);
141 eval { die "Success login - bouncing to redirect" };
144 # if they have cookies we are done
145 } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
149 # need to verify cookies are set-able
150 } elsif ($args->{'is_form'}) {
151 $form->{$self->key_verify} = $self->server_time;
152 my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);
154 $self->location_bounce($url);
155 eval { die "Success login - bouncing to test cookie" };
162 if (my $meth = $self->{'success_hook'}) {
163 return $meth->($self);
170 if (my $meth = $self->{'logout_hook'}) {
171 return $meth->($self);
178 my $args = shift || {};
179 if (my $meth = $self->{'handle_failure'}) {
180 return $meth->($self, $args);
182 my $form = $self->form;
184 # make sure the cookie is gone
185 my $key_c = $self->key_cookie;
186 $self->delete_cookie({name
=> $key_c}) if $self->cookies->{$key_c};
188 # no valid login and we are checking for cookies - see if they have cookies
189 if (my $value = delete $form->{$self->key_verify}) {
190 if (abs(time() - $value) < 15) {
191 $self->no_cookies_print;
196 # oh - you're still here - well then - ask for login credentials
197 my $key_r = $self->key_redirect;
198 local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
199 local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
201 my $data = $self->last_auth_data;
202 eval { die defined($data) ? $data : "Requesting credentials" };
204 # allow for a sleep to help prevent brute force
205 sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
213 if (my $meth = $self->{'failure_hook'}) {
214 return $meth->($self);
219 sub check_valid_auth
{
221 $self = $self->new(@_) if ! ref $self;
223 local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
224 local $self->{'login_print'} = sub {}; # check only - don't login if not
225 local $self->{'set_cookie'} = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
226 return $self->get_valid_auth;
229 ###----------------------------------------------------------------###
231 sub script_name
{ shift-
>{'script_name'} || $ENV{'SCRIPT_NAME'} || '' }
233 sub path_info
{ shift-
>{'path_info'} || $ENV{'PATH_INFO'} || '' }
235 sub server_time
{ time }
239 $self->{'cgix'} = shift if @_ == 1;
240 return $self->{'cgix'} ||= CGI
::Ex-
>new;
245 $self->{'form'} = shift if @_ == 1;
246 return $self->{'form'} ||= $self->cgix->get_form;
251 $self->{'cookies'} = shift if @_ == 1;
252 return $self->{'cookies'} ||= $self->cgix->get_cookies;
258 return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
259 local $args->{'value'} = '';
260 local $args->{'expires'} = '-10y' if ! $self->use_session_cookie($args->{'name'}, '');
261 $self->set_cookie($args);
262 delete $self->cookies->{$args->{'name'}};
268 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
269 my $key = $args->{'name'};
270 my $val = $args->{'value'};
271 my $dom = $args->{'domain'} || $self->cookie_domain;
272 my $sec = $args->{'secure'} || $self->cookie_secure;
273 $self->cgix->set_cookie({
276 -path
=> $args->{'path'} || $self->cookie_path($key, $val) || '/',
277 ($dom ? (-domain
=> $dom) : ()),
278 ($sec ? (-secure
=> $sec) : ()),
279 ($args->{'expires'} ? (-expires
=> $args->{'expires'}): ()),
281 $self->cookies->{$key} = $val;
284 sub location_bounce
{
287 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
288 return $self->cgix->location_bounce($url);
291 ###----------------------------------------------------------------###
293 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
294 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
295 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
296 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
297 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
298 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
299 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
300 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
301 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
302 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
303 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
304 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
305 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
306 #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"}'
307 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
308 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
309 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
310 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
311 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
312 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
313 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
314 sub cookie_path
{ shift-
>{'cookie_path'} }
315 sub cookie_domain
{ shift-
>{'cookie_domain'} }
316 sub cookie_secure
{ shift-
>{'cookie_secure'} }
317 sub use_session_cookie
{ shift-
>{'use_session_cookie'} }
318 sub disable_simple_cram
{ shift-
>{'disable_simple_cram'} }
319 sub complex_plaintext
{ shift-
>{'complex_plaintext'} }
321 sub logout_redirect
{
322 my ($self, $user) = @_;
323 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
324 return $self->{'logout_redirect'} || $self->script_name ."?$form";
329 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
332 ###----------------------------------------------------------------###
334 sub no_cookies_print
{
336 $self->cgix->print_content_type;
337 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
343 my $hash = $self->login_hash_common;
344 my $file = $self->login_template;
346 ### allow for a hooked override
347 if (my $meth = $self->{'login_print'}) {
348 $meth->($self, $file, $hash);
352 ### process the document
353 my $args = $self->template_args;
354 $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_include_path,
355 my $t = $self->template_obj($args);
357 $t->process_simple($file, $hash, \
$out) || die $t->error;
359 ### fill in form fields
360 require CGI
::Ex
::Fill
;
361 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
364 $self->cgix->print_content_type;
371 my ($self, $args) = @_;
372 return $self->{'template_obj'} || do {
373 require Template
::Alloy
;
374 Template
::Alloy-
>new($args);
378 sub template_args
{ $_[0]->{'template_args'} ||= {} }
380 sub template_include_path
{ $_[0]->{'template_include_path'} || '' }
382 sub login_hash_common
{
384 my $form = $self->form;
385 my $data = $self->last_auth_data;
386 $data = {no_data
=> 1} if ! ref $data;
390 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
392 key_user
=> $self->key_user,
393 key_pass
=> $self->key_pass,
394 key_time
=> $self->key_time,
395 key_save
=> $self->key_save,
396 key_expires_min
=> $self->key_expires_min,
397 key_redirect
=> $self->key_redirect,
398 form_name
=> $self->form_name,
399 script_name
=> $self->script_name,
400 path_info
=> $self->path_info,
401 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
402 $self->key_user => $data->{'user'} || '',
403 $self->key_pass => '', # don't allow for this to get filled into the form
404 $self->key_time => $self->server_time,
405 $self->key_expires_min => $self->expires_min,
406 text_user
=> $self->text_user,
407 text_pass
=> $self->text_pass,
408 text_save
=> $self->text_save,
409 text_submit
=> $self->text_submit,
410 hide_save
=> $self->hide_save,
414 ###----------------------------------------------------------------###
419 if (my $meth = $self->{'verify_token'}) {
420 return $meth->($self, $args);
422 my $token = delete $args->{'token'}; die "Missing token" if ! length $token;
423 my $data = $self->new_auth_data({token
=> $token, %$args});
426 # make sure the token is parsed to usable data
427 if (ref $token) { # token already parsed
428 $data->add_data({%$token, armor
=> 'none'});
430 } elsif (my $meth = $self->{'parse_token'}) {
431 if (! $meth->($self, $args)) {
432 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
433 $data->{'allow_cookie_match'} = 1;
437 if (! $self->parse_token($token, $data)) {
438 $data->error('Invalid token') if ! $data->error; # add error if not already added
439 $data->{'allow_cookie_match'} = 1;
446 if (! defined($data->{'user'})) {
447 $data->error('Missing user');
448 } elsif (! defined($data->{'user'} = $self->cleanup_user($data->{'user'}))
449 || ! length($data->{'user'})) {
450 $data->error('Missing cleaned user');
451 } elsif (! defined $data->{'test_pass'}) {
452 $data->error('Missing test_pass');
453 } elsif (! $self->verify_user($data->{'user'})) {
454 $data->error('Invalid user');
456 return $data if $data->error;
460 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
461 $data->add_data({details
=> $@});
462 $data->error('Could not get pass');
463 } elsif (ref $pass eq 'HASH') {
465 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
466 : exists($extra->{'password'}) ? delete($extra->{'password'})
467 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
468 $data->error('Invalid login') if ! defined $pass && ! $data->error;
469 $data->add_data($extra);
471 return $data if $data->error;
472 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
476 if ($meth = $self->{'verify_password'}) {
477 if (! $meth->($self, $pass, $data)) {
478 $data->error('Password failed verification') if ! $data->error;
481 if (! $self->verify_password($pass, $data)) {
482 $data->error('Password failed verification') if ! $data->error;
485 return $data if $data->error;
488 # validate the payload
489 if ($meth = $self->{'verify_payload'}) {
490 if (! $meth->($self, $data->{'payload'}, $data)) {
491 $data->error('Payload failed custom verification') if ! $data->error;
494 if (! $self->verify_payload($data->{'payload'}, $data)) {
495 $data->error('Payload failed verification') if ! $data->error;
504 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
508 my ($self, $token, $data) = @_;
511 for my $armor ('none', 'base64', 'blowfish') {
512 my $copy = ($armor eq 'none') ? $token
513 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
514 : ($bkey = $self->use_blowfish) ? decrypt_blowfish
($token, $bkey)
516 if ($self->complex_plaintext && $copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / ([^/]*) / (.*) $|x
) {
527 } elsif ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / ([^/]*) / ([a-fA-F0-9
]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
534 secure_hash
=> $6 || '',
539 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
552 sub verify_password
{
553 my ($self, $pass, $data) = @_;
556 ### looks like a secure_hash cram
557 if ($data->{'secure_hash'}) {
558 $data->add_data(type
=> 'secure_hash_cram');
559 my $array = eval {$self->secure_hash_keys };
561 $err = 'secure_hash_keys not found';
562 } elsif (! @$array) {
563 $err = 'secure_hash_keys empty';
564 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
565 $err = 'Invalid secure hash';
569 my $real = $pass =~ /^[a-fA-F0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
570 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
571 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
572 if ($data->{'expires_min'} > 0
573 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
574 $err = 'Login expired';
575 } elsif (lc($data->{'test_pass'}) ne $sum) {
576 $err = 'Invalid login';
580 ### looks like a simple_cram
581 } elsif ($data->{'cram_time'}) {
582 $data->add_data(type
=> 'simple_cram');
583 die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
584 my $real = $pass =~ /^[a-fA-F0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
585 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
586 my $sum = md5_hex
($str .'/'. $real);
587 if ($data->{'expires_min'} > 0
588 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
589 $err = 'Login expired';
590 } elsif (lc($data->{'test_pass'}) ne $sum) {
591 $err = 'Invalid login';
595 } elsif ($data->{'plain_time'}
596 && $data->{'expires_min'} > 0
597 && ($self->server_time - $data->{'plain_time'}) > $data->{'expires_min'} * 60) {
598 $err = 'Login expired';
601 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
602 && crypt($data->{'test_pass'}, $1) eq $pass) {
603 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
605 ### failed plaintext crypt
606 } elsif ($self->use_crypt) {
607 $err = 'Invalid login';
608 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/ ? 0 : 1));
610 ### plaintext and md5
612 my $is_md5_t = $data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/;
613 my $is_md5_r = $pass =~ /^[a-fA-F0-9]{32}$/;
614 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
615 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
616 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
617 $err = 'Invalid login'
621 $data->error($err) if $err;
625 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
629 my $data = shift || $self->last_auth_data;
630 die "Can't generate a token off of a failed auth" if ! $data;
631 die "Can't generate a token for a user which contains a \"/\"" if $data->{'user'} =~ m
{/};
633 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
635 my $user = $data->{'user'} || die "Missing user";
636 my $load = $self->generate_payload($data);
637 die "User can not contain a \"/\." if $user =~ m
|/|;
638 die "Payload can not contain a \"/\. Please encode it in generate_payload." if $load =~ m
|/|;
640 ### do kinds that require staying plaintext
641 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
642 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
643 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
644 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
645 $token = $self->complex_plaintext ? join('/', $user, $self->server_time, $exp, $load, $pass) : "$user/$pass";
647 ### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
649 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-fA-F0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
650 : die "Missing real_pass";
652 if (! $data->{'prefer_simple_cram'}
653 && ($array = eval { $self->secure_hash_keys })
655 my $rand1 = int(rand @$array);
656 my $rand2 = int(rand 100000);
657 my $str = join("/", $user, $self->server_time, $exp, $load);
658 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
659 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
661 die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
662 my $str = join("/", $user, $self->server_time, $exp, $load);
663 my $sum = md5_hex
($str .'/'. $real);
664 $token = $str .'/'. $sum;
668 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
669 $token = encrypt_blowfish
($token, $key);
671 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
672 $token = encode_base64
($token, '');
678 sub generate_payload
{
681 if (my $meth = $self->{'generate_payload'}) {
682 return $meth->($self, $args);
684 return defined($args->{'payload'}) ? $args->{'payload'} : '';
690 if (my $meth = $self->{'verify_user'}) {
691 return $meth->($self, $user);
699 if (my $meth = $self->{'cleanup_user'}) {
700 return $meth->($self, $user);
705 sub get_pass_by_user
{
708 if (my $meth = $self->{'get_pass_by_user'}) {
709 return $meth->($self, $user);
712 die "Please override get_pass_by_user";
716 my ($self, $payload, $data) = @_;
717 if (my $meth = $self->{'verify_payload'}) {
718 return $meth->($self, $payload, $data);
723 ###----------------------------------------------------------------###
725 sub encrypt_blowfish
{
726 my ($str, $key) = @_;
728 require Crypt
::Blowfish
;
729 my $cb = Crypt
::Blowfish-
>new($key);
731 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
734 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
739 sub decrypt_blowfish
{
740 my ($enc, $key) = @_;
742 require Crypt
::Blowfish
;
743 my $cb = Crypt
::Blowfish-
>new($key);
746 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
752 ###----------------------------------------------------------------###
756 return $self->{'login_template'} if $self->{'login_template'};
759 map {ref $_ ? $$_ : /\[%/ ? $_ : $_ ? "[% TRY; PROCESS '$_'; CATCH %]<!-- [% error %] -->[% END %]\n" : ''}
760 $self->login_header, $self->login_form, $self->login_script, $self->login_footer;
764 sub login_header
{ shift-
>{'login_header'} || 'login_header.tt' }
765 sub login_footer
{ shift-
>{'login_footer'} || 'login_footer.tt' }
769 return $self->{'login_form'} if defined $self->{'login_form'};
770 return \
q{<div class="login_chunk">
771 <span class="login_error">[% error %]</span>
772 <form class="login_form" name="[% form_name %]" method="POST" action="[% script_name %][% path_info %]">
773 <input type="hidden" name="[% key_redirect %]" value="">
774 <input type="hidden" name="[% key_time %]" value="">
775 <input type="hidden" name="[% key_expires_min %]" value="">
776 <table class="login_table">
777 <tr class="login_username">
778 <td>[% text_user %]</td>
779 <td><input name="[% key_user %]" type="text" size="30" value=""></td>
781 <tr class="login_password">
782 <td>[% text_pass %]</td>
783 <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
785 [% IF ! hide_save ~%]
786 <tr class="login_save">
788 <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
792 <tr class="login_submit">
793 <td colspan="2" align="right">
794 <input type="submit" value="[% text_submit %]">
803 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
804 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
805 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
806 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
807 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
811 return $self->{'login_script'} if defined $self->{'login_script'};
812 return '' if $self->use_plaintext || $self->disable_simple_cram;
813 return \
q{<form name="[% form_name %]_jspost" style="margin:0px" method="POST">
814 <input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
816 <script src="[% md5_js_path %]"></script>
818 if (document.md5_hex) document.[% form_name %].onsubmit = function () {
819 var f = document.[% form_name %];
820 var u = f.[% key_user %].value;
821 var p = f.[% key_pass %].value;
822 var t = f.[% key_time %].value;
823 var s = f.[% key_save %] && f.[% key_save %].checked ? -1 : f.[% key_expires_min %].value;
825 var str = u+'/'+t+'/'+s+'/'+'';
826 var sum = document.md5_hex(str +'/' + document.md5_hex(p));
828 var f2 = document.[% form_name %]_jspost;
829 f2.[% key_user %].value = str +'/'+ sum;
830 f2.[% key_redirect %].value = f.[% key_redirect %].value;
831 f2.action = f.action;
839 ###----------------------------------------------------------------###
841 package CGI
::Ex
::Auth
::Data
;
845 'bool' => sub { ! shift-
>error },
847 '""' => sub { shift-
>as_string },
851 my ($class, $args) = @_;
852 return bless {%{ $args || {} }}, $class;
857 my $args = @_ == 1 ? shift : {@_};
858 @{ $self }{keys %$args} = values %$args;
864 $self->{'error'} = shift;
865 $self->{'error_caller'} = [caller];
867 return $self->{'error'};
872 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
875 ###----------------------------------------------------------------###
885 ### authorize the user
886 my $auth = CGI::Ex::Auth->get_valid_auth({
887 get_pass_by_user => \&get_pass_by_user,
891 sub get_pass_by_user {
894 my $pass = some_way_of_getting_password($user);
898 ### OR - if you are using a OO based CGI or Application
900 sub require_authentication {
903 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
904 get_pass_by_user => sub {
905 my ($auth, $user) = @_;
906 return $self->get_pass($user);
912 my ($self, $user) = @_;
913 return $self->loopup_and_cache_pass($user);
918 CGI::Ex::Auth allows for auto-expiring, safe and easy web based
919 logins. Auth uses javascript modules that perform MD5 hashing to cram
920 the password on the client side before passing them through the
923 For the stored cookie you can choose to use simple cram mechanisms,
924 secure hash cram tokens, auto expiring logins (not cookie based),
925 and Crypt::Blowfish protection. You can also choose to keep
926 passwords plaintext and to use perl's crypt for testing
927 passwords. Or you can completely replace the cookie parsing/generating
928 and let Auth handle requesting, setting, and storing the cookie.
930 A theoretical downside to this module is that it does not use a
931 session to preserve state so get_pass_by_user has to happen on every
932 request (any authenticated area has to verify authentication each time
933 - unless the verify_token method is completely overridden). In theory
934 you should be checking the password everytime a user makes a request
935 to make sure the password is still valid. A definite plus is that you
936 don't need to use a session if you don't want to. It is up to the
937 interested reader to add caching to the get_pass_by_user method.
939 In the end, the only truly secure login method is across an https
940 connection. Any connection across non-https (non-secure) is
941 susceptible to cookie hijacking or tcp hijacking - though the
942 possibility of this is normally small and typically requires access to
943 a machine somewhere in your TCP chain. If in doubt - you should try
944 to use https - but even then you need to guard the logged in area
945 against cross-site javascript exploits. A discussion of all security
946 issues is far beyond the scope of this documentation.
954 Constructor. Takes a hashref of properties as arguments.
956 Many of the methods which may be overridden in a subclass,
957 or may be passed as properties to the new constuctor such as in the following:
960 get_pass_by_user => \&my_pass_sub,
961 key_user => 'my_user',
962 key_pass => 'my_pass',
963 login_header => \"<h1>My Login</h1>",
966 The following methods will look for properties of the same name. Each of these will be
967 described separately.
1006 template_include_path
1022 =item C<generate_token>
1024 Takes either an auth_data object from a auth_data returned by verify_token,
1025 or a hashref of arguments.
1027 Possible arguments are:
1029 user - the username we are generating the token for
1030 real_pass - the password of the user (if use_plaintext is false
1031 and use_crypt is false, the password can be an md5sum
1032 of the user's password)
1033 use_blowfish - indicates that we should use Crypt::Blowfish to protect
1034 the generated token. The value of this argument is used
1035 as the key. Default is false.
1036 use_base64 - indicates that we should use Base64 encoding to protect
1037 the generated token. Default is true. Will not be
1038 used if use_blowfish is true.
1039 use_plaintext - indicates that we should keep the password in plaintext
1040 use_crypt - also indicates that we should keep the password in plaintext
1041 expires_min - says how many minutes until the generated token expires.
1042 Values <= 0 indicate to not ever expire. Used only on cram
1044 payload - a payload that will be passed to generate_payload and then
1045 will be added to cram type tokens. It cannot contain a /.
1047 - If the secure_hash_keys method returns keys, and it is a non-plaintext
1048 token, generate_token will create a secure_hash_cram. Set
1049 this value to true to tell it to use a simple_cram. This
1050 is generally only useful in testing.
1052 The following are types of tokens that can be generated by generate_token. Each type includes
1053 pseudocode and a sample of a generated that token.
1057 real_pass := "123qwe"
1058 token := join("/", user, real_pass);
1061 token == "paul/123qwe"
1064 token == "cGF1bC8xMjNxd2U="
1066 use_blowfish := "foobarbaz"
1067 token == "6da702975190f0fe98a746f0d6514683"
1069 Notes: This token will be used if either use_plaintext or use_crypt is set.
1070 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1071 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1072 token will not be able to be verified.
1076 real_pass := "123qwe"
1077 server_time := 1148512991 # a time in seconds since epoch
1078 expires_min := 6 * 60
1079 payload := "something"
1081 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1082 str := join("/", user, server_time, expires_min, payload, md5_pass)
1083 md5_str := md5(sum_str)
1084 token := join("/", user, server_time, expires_min, payload, md5_str)
1087 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1090 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1092 Notes: use_blowfish is available as well
1096 real_pass := "123qwe"
1097 server_time := 1148514034 # a time in seconds since epoch
1098 expires_min := 6 * 60
1099 payload := "something"
1100 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1101 rand1 := 3 # int(rand(length(secure_hash)))
1102 rand2 := 39163 # int(rand(100000))
1104 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1106 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1107 sh_str2 := join(".", "sh", rand1, rand2)
1108 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1109 md5_str := md5(sum_str)
1110 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1113 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1115 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1116 "secure_hash_keys" property of the CGI::Ex::Auth object.
1118 =item C<get_valid_auth>
1120 Performs the core logic. Returns an auth object on successful login.
1121 Returns false on errored login (with the details of the error stored in
1122 $@). If a false value is returned, execution of the CGI should be halted.
1123 get_valid_auth WILL NOT automatically stop execution.
1125 $auth->get_valid_auth || exit;
1127 Optionally, the class and a list of arguments may be passed. This will create a
1128 new object using the passed arguments, and then run get_valid_auth.
1130 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1132 =item C<check_valid_auth>
1134 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1135 This allows for obtaining login data without forcing an html login
1138 =item C<login_print>
1140 Called if login errored. Defaults to printing a very basic (but
1141 adequate) page loaded from login_template..
1143 You will want to override it with a template from your own system.
1144 The hook that is called will be passed the step to print (currently
1145 only "get_login_info" and "no_cookies"), and a hash containing the
1146 form variables as well as the following:
1148 =item C<login_hash_common>
1150 Passed to the template swapped during login_print.
1152 %$form, # any keys passed to the login script
1153 error # The text "Login Failed" if a login occurred
1154 login_data # A login data object if they failed authentication.
1155 key_user # $self->key_user, # the username fieldname
1156 key_pass # $self->key_pass, # the password fieldname
1157 key_time # $self->key_time, # the server time field name
1158 key_save # $self->key_save, # the save password checkbox field name
1159 key_redirect # $self->key_redirect, # the redirect fieldname
1160 form_name # $self->form_name, # the name of the form
1161 script_name # $self->script_name, # where the server will post back to
1162 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1163 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1164 $self->key_user # $data->{'user'}, # the username (if any)
1165 $self->key_pass # '', # intentional blankout
1166 $self->key_time # $self->server_time, # the server's time
1167 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1168 text_user # $self->text_user # template text Username:
1169 text_pass # $self->text_pass # template text Password:
1170 text_save # $self->text_save # template text Save Password ?
1171 text_submit # $self->text_submit # template text Login
1172 hide_save # $self->hide_save # 0
1174 =item C<bounce_on_logout>
1176 Default 0. If true, will location bounce to script returned by logout_redirect
1177 passing the key key_logout. If false, will simply show the login screen.
1179 =item C<key_loggedout>
1181 Key to bounce with in the form during a logout should bounce_on_logout return true.
1182 Default is "loggedout".
1186 If the form hash contains a true value in this field name, the current user will
1187 be logged out. Default is "cea_logout".
1191 The name of the auth cookie. Default is "cea_user".
1195 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1199 The form field name used to pass the username. Default is "cea_user".
1203 The form field name used to pass the password. Default is "cea_pass".
1207 Works in conjunction with key_expires_min. If key_save is true, then
1208 the cookie will be set to be saved for longer than the current session
1209 (If it is a plaintext variety it will be given a 20 year life rather
1210 than being a session cookie. If it is a cram variety, the expires_min
1211 portion of the cram will be set to -1). If it is set to false, the cookie
1212 will be available only for the session (If it is a plaintext variety, the cookie
1213 will be session based and will be removed on the next loggout. If it is
1214 a cram variety then the cookie will only be good for expires_min minutes.
1216 Default is "cea_save".
1218 =item C<key_expires_min>
1220 The name of the form field that contains how long cram type cookies will be valid
1221 if key_save contains a false value.
1223 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1225 This value will have no effect when use_plaintext or use_crypt is set.
1227 A value of -1 means no expiration.
1229 =item C<failed_sleep>
1231 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1232 if validation failed because of expired tokens. Default value is 0.
1233 Setting to 0 disables any sleeping.
1237 The name of the html login form to attach the javascript to. Default is "cea_form".
1239 =item C<verify_token>
1241 This method verifies the token that was passed either via the form or via cookies.
1242 It will accept plaintext or crammed tokens (A listing of the available algorithms
1243 for creating tokes is listed below). It also allows for armoring the token with
1244 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1245 can be found under generate_token.
1247 =item C<parse_token>
1249 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1250 Returns true if it was able to parse the passed token.
1252 =item C<cleanup_user>
1254 Called by verify_token. Default is to do no modification. Allows for usernames to
1255 be lowercased, or canonized in some other way. Should return the cleaned username.
1257 =item C<verify_user>
1259 Called by verify_token. Single argument is the username. May or may not be an
1260 initial check to see if the username is ok. The username will already be cleaned at
1261 this point. Default return is true.
1263 =item C<get_pass_by_user>
1265 Called by verify_token. Given the cleaned, verified username, should return a
1266 valid password for the user. It can always return plaintext. If use_crypt is
1267 enabled, it should return the crypted password. If use_plaintext and use_crypt
1268 are not enabled, it may return the md5 sum of the password.
1270 get_pass_by_user => sub {
1271 my ($auth_obj, $user) = @_;
1272 my $pass = $some_obj->get_pass({user => $user});
1276 Alternately, get_pass_by_user may return a hashref of data items that
1277 will be added to the data object if the token is valid. The hashref
1278 must also contain a key named real_pass or password that contains the
1279 password. Note that keys passed back in the hashref that are already
1280 in the data object will override those in the data object.
1282 get_pass_by_user => sub {
1283 my ($auth_obj, $user) = @_;
1284 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1287 user_id => $user_id,
1291 =item C<verify_password>
1293 Called by verify_token. Passed the password to check as well as the
1294 auth data object. Should return true if the password matches.
1295 Default method can handle md5, crypt, cram, secure_hash_cram, and
1296 plaintext (all of the default types supported by generate_token). If
1297 a property named verify_password exists, it will be used and called as
1298 a coderef rather than using the default method.
1300 =item C<verify_payload>
1302 Called by verify_token. Passed the password to check as well as the
1303 auth data object. Should return true if the payload is valid.
1304 Default method returns true without performing any checks on the
1305 payload. If a property named verify_password exists, it will be used
1306 and called as a coderef rather than using the default method.
1311 Returns a CGI::Ex object.
1315 A hash of passed form info. Defaults to CGI::Ex::get_form.
1319 The current cookies. Defaults to CGI::Ex::get_cookies.
1321 =item C<login_template>
1323 Should return either a template filename to use for the login template, or it
1324 should return a reference to a string that contains the template. The contents
1325 will be used in login_print and passed to the template engine.
1327 Default login_template is the values of login_header, login_form, login_script, and
1328 login_script concatenated together.
1330 Values from login_hash_common will be passed to the template engine, and will
1331 also be used to fill in the form.
1333 The basic values are capable of handling most needs so long as appropriate
1334 headers and css styles are used.
1336 =item C<login_header>
1338 Should return a header to use in the default login_template. The default
1339 value will try to PROCESS a file called login_header.tt that should be
1340 located in directory specified by the template_include_path method.
1342 It should ideally supply css styles that format the login_form as desired.
1344 =item C<login_footer>
1346 Same as login_header - but for the footer. Will look for login_footer.tt by
1351 An html chunk that contains the necessary form fields to login the user. The
1352 basic chunk has a username text entry, password text entry, save password checkbox,
1353 and submit button, and any hidden fields necessary for logging in the user.
1355 =item C<login_script>
1357 Contains javascript that will attach to the form from login_form. This script
1358 is capable of taking the login_fields and creating an md5 cram which prevents
1359 the password from being passed plaintext.
1361 =item C<text_user, text_pass, text_save>
1363 The text items shown in the default login template. The default values are:
1365 text_user "Username:"
1366 text_pass "Password:"
1367 text_save "Save Password ?"
1369 =item C<disable_simple_cram>
1371 Disables simple cram type from being an available type. Default is
1372 false. If set, then one of use_plaintext, use_crypt, or
1373 secure_hash_keys should be set. Setting this option allows for
1374 payloads to be generated by the server only - otherwise a user who
1375 understands the algorithm could generate a valid simple_cram cookie
1376 with a custom payload.
1378 Another option would be to only accept payloads from tokens if use_blowfish
1379 is set and armor was equal to "blowfish."
1385 This module may be distributed under the same terms as Perl itself.
1389 Paul Seamons <perl at seamons dot com>
This page took 0.131685 seconds and 4 git commands to generate.