]>
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 $self->cgix->set_cookie({
275 -path
=> $args->{'path'} || $self->cookie_path($key, $val) || '/',
276 ($dom ? (-domain
=> $dom) : ()),
277 ($args->{'expires'} ? (-expires
=> $args->{'expires'}): ()),
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 cookie_path
{ shift-
>{'cookie_path'} }
313 sub cookie_domain
{ shift-
>{'cookie_domain'} }
314 sub use_session_cookie
{ shift-
>{'use_session_cookie'} }
315 sub disable_simple_cram
{ shift-
>{'disable_simple_cram'} }
317 sub logout_redirect
{
318 my ($self, $user) = @_;
319 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
320 return $self->{'logout_redirect'} || $self->script_name ."?$form";
325 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
328 ###----------------------------------------------------------------###
330 sub no_cookies_print
{
332 $self->cgix->print_content_type;
333 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
339 my $hash = $self->login_hash_common;
340 my $file = $self->login_template;
342 ### allow for a hooked override
343 if (my $meth = $self->{'login_print'}) {
344 $meth->($self, $file, $hash);
348 ### process the document
349 my $args = $self->template_args;
350 $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_include_path,
351 my $t = $self->template_obj($args);
353 $t->process_simple($file, $hash, \
$out) || die $t->error;
355 ### fill in form fields
356 require CGI
::Ex
::Fill
;
357 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
360 $self->cgix->print_content_type;
367 my ($self, $args) = @_;
368 return $self->{'template_obj'} || do {
369 require Template
::Alloy
;
370 Template
::Alloy-
>new($args);
374 sub template_args
{ $_[0]->{'template_args'} ||= {} }
376 sub template_include_path
{ $_[0]->{'template_include_path'} || '' }
378 sub login_hash_common
{
380 my $form = $self->form;
381 my $data = $self->last_auth_data;
382 $data = {no_data
=> 1} if ! ref $data;
386 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
388 key_user
=> $self->key_user,
389 key_pass
=> $self->key_pass,
390 key_time
=> $self->key_time,
391 key_save
=> $self->key_save,
392 key_expires_min
=> $self->key_expires_min,
393 key_redirect
=> $self->key_redirect,
394 form_name
=> $self->form_name,
395 script_name
=> $self->script_name,
396 path_info
=> $self->path_info,
397 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
398 $self->key_user => $data->{'user'} || '',
399 $self->key_pass => '', # don't allow for this to get filled into the form
400 $self->key_time => $self->server_time,
401 $self->key_expires_min => $self->expires_min,
402 text_user
=> $self->text_user,
403 text_pass
=> $self->text_pass,
404 text_save
=> $self->text_save,
405 text_submit
=> $self->text_submit,
406 hide_save
=> $self->hide_save,
410 ###----------------------------------------------------------------###
415 if (my $meth = $self->{'verify_token'}) {
416 return $meth->($self, $args);
418 my $token = delete $args->{'token'}; die "Missing token" if ! length $token;
419 my $data = $self->new_auth_data({token
=> $token, %$args});
422 # make sure the token is parsed to usable data
423 if (ref $token) { # token already parsed
424 $data->add_data({%$token, armor
=> 'none'});
426 } elsif (my $meth = $self->{'parse_token'}) {
427 if (! $meth->($self, $args)) {
428 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
429 $data->{'allow_cookie_match'} = 1;
433 if (! $self->parse_token($token, $data)) {
434 $data->error('Invalid token') if ! $data->error; # add error if not already added
435 $data->{'allow_cookie_match'} = 1;
442 if (! defined($data->{'user'})) {
443 $data->error('Missing user');
444 } elsif (! defined($data->{'user'} = $self->cleanup_user($data->{'user'}))
445 || ! length($data->{'user'})) {
446 $data->error('Missing cleaned user');
447 } elsif (! defined $data->{'test_pass'}) {
448 $data->error('Missing test_pass');
449 } elsif (! $self->verify_user($data->{'user'})) {
450 $data->error('Invalid user');
452 return $data if $data->error;
456 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
457 $data->add_data({details
=> $@});
458 $data->error('Could not get pass');
459 } elsif (ref $pass eq 'HASH') {
461 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
462 : exists($extra->{'password'}) ? delete($extra->{'password'})
463 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
464 $data->error('Invalid login') if ! defined $pass && ! $data->error;
465 $data->add_data($extra);
467 return $data if $data->error;
468 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
472 if ($meth = $self->{'verify_password'}) {
473 if (! $meth->($self, $pass, $data)) {
474 $data->error('Password failed verification') if ! $data->error;
477 if (! $self->verify_password($pass, $data)) {
478 $data->error('Password failed verification') if ! $data->error;
481 return $data if $data->error;
484 # validate the payload
485 if ($meth = $self->{'verify_payload'}) {
486 if (! $meth->($self, $data->{'payload'}, $data)) {
487 $data->error('Payload failed custom verification') if ! $data->error;
490 if (! $self->verify_payload($data->{'payload'}, $data)) {
491 $data->error('Payload failed verification') if ! $data->error;
500 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
504 my ($self, $token, $data) = @_;
507 for my $armor ('none', 'base64', 'blowfish') {
508 my $copy = ($armor eq 'none') ? $token
509 : ($armor eq 'base64') ? eval { local $^W; decode_base64
($token) }
510 : ($bkey = $self->use_blowfish) ? decrypt_blowfish
($token, $bkey)
512 if ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / (.*) / ([a-fA-F0-9]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
519 secure_hash
=> $6 || '',
524 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
537 sub verify_password
{
538 my ($self, $pass, $data) = @_;
541 ### looks like a secure_hash cram
542 if ($data->{'secure_hash'}) {
543 $data->add_data(type
=> 'secure_hash_cram');
544 my $array = eval {$self->secure_hash_keys };
546 $err = 'secure_hash_keys not found';
547 } elsif (! @$array) {
548 $err = 'secure_hash_keys empty';
549 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
550 $err = 'Invalid secure hash';
554 my $real = $pass =~ /^[a-f0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
555 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
556 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
557 if ($data->{'expires_min'} > 0
558 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
559 $err = 'Login expired';
560 } elsif (lc($data->{'test_pass'}) ne $sum) {
561 $err = 'Invalid login';
565 ### looks like a simple_cram
566 } elsif ($data->{'cram_time'}) {
567 $data->add_data(type
=> 'simple_cram');
568 die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
569 my $real = $pass =~ /^[a-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);
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 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
581 && crypt($data->{'test_pass'}, $1) eq $pass) {
582 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
584 ### failed plaintext crypt
585 } elsif ($self->use_crypt) {
586 $err = 'Invalid login';
587 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-f0-9]{32}$/ ? 0 : 1));
589 ### plaintext and md5
591 my $is_md5_t = $data->{'test_pass'} =~ /^[a-f0-9]{32}$/;
592 my $is_md5_r = $pass =~ /^[a-f0-9]{32}$/;
593 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
594 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
595 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
596 $err = 'Invalid login'
600 $data->error($err) if $err;
604 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
608 my $data = shift || $self->last_auth_data;
609 die "Can't generate a token off of a failed auth" if ! $data;
610 die "Can't generate a token for a user which contains a \"/\"" if $data->{'user'} =~ m
{/};
613 ### do kinds that require staying plaintext
614 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
615 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
616 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
617 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
618 $token = $data->{'user'} .'/'. $pass;
620 ### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
622 my $user = $data->{'user'} || die "Missing user";
623 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-f0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
624 : die "Missing real_pass";
625 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
626 my $load = $self->generate_payload($data);
627 die "Payload can not contain a \"/\. Please escape it in generate_payload." if $load =~ m
|/|;
628 die "User can not contain a \"/\." if $user =~ m
|/|;
631 if (! $data->{'prefer_simple_cram'}
632 && ($array = eval { $self->secure_hash_keys })
634 my $rand1 = int(rand @$array);
635 my $rand2 = int(rand 100000);
636 my $str = join("/", $user, $self->server_time, $exp, $load);
637 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
638 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
640 die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
641 my $str = join("/", $user, $self->server_time, $exp, $load);
642 my $sum = md5_hex
($str .'/'. $real);
643 $token = $str .'/'. $sum;
647 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
648 $token = encrypt_blowfish
($token, $key);
650 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
651 $token = encode_base64
($token, '');
657 sub generate_payload
{
660 if (my $meth = $self->{'generate_payload'}) {
661 return $meth->($self, $args);
663 return defined($args->{'payload'}) ? $args->{'payload'} : '';
669 if (my $meth = $self->{'verify_user'}) {
670 return $meth->($self, $user);
678 if (my $meth = $self->{'cleanup_user'}) {
679 return $meth->($self, $user);
684 sub get_pass_by_user
{
687 if (my $meth = $self->{'get_pass_by_user'}) {
688 return $meth->($self, $user);
691 die "Please override get_pass_by_user";
695 my ($self, $payload, $data) = @_;
696 if (my $meth = $self->{'verify_payload'}) {
697 return $meth->($self, $payload, $data);
702 ###----------------------------------------------------------------###
704 sub encrypt_blowfish
{
705 my ($str, $key) = @_;
707 require Crypt
::Blowfish
;
708 my $cb = Crypt
::Blowfish-
>new($key);
710 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
713 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
718 sub decrypt_blowfish
{
719 my ($enc, $key) = @_;
721 require Crypt
::Blowfish
;
722 my $cb = Crypt
::Blowfish-
>new($key);
725 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
731 ###----------------------------------------------------------------###
735 return $self->{'login_template'} if $self->{'login_template'};
738 map {ref $_ ? $$_ : /\[%/ ? $_ : $_ ? "[% TRY; PROCESS '$_'; CATCH %]<!-- [% error %] -->[% END %]\n" : ''}
739 $self->login_header, $self->login_form, $self->login_script, $self->login_footer;
743 sub login_header
{ shift-
>{'login_header'} || 'login_header.tt' }
744 sub login_footer
{ shift-
>{'login_footer'} || 'login_footer.tt' }
748 return $self->{'login_form'} if defined $self->{'login_form'};
749 return \
q{<div class="login_chunk">
750 <span class="login_error">[% error %]</span>
751 <form class="login_form" name="[% form_name %]" method="POST" action="[% script_name %][% path_info %]">
752 <input type="hidden" name="[% key_redirect %]" value="">
753 <input type="hidden" name="[% key_time %]" value="">
754 <input type="hidden" name="[% key_expires_min %]" value="">
755 <table class="login_table">
756 <tr class="login_username">
757 <td>[% text_user %]</td>
758 <td><input name="[% key_user %]" type="text" size="30" value=""></td>
760 <tr class="login_password">
761 <td>[% text_pass %]</td>
762 <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
764 [% IF ! hide_save ~%]
765 <tr class="login_save">
767 <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
771 <tr class="login_submit">
772 <td colspan="2" align="right">
773 <input type="submit" value="[% text_submit %]">
782 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
783 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
784 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
785 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
786 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
790 return $self->{'login_script'} if defined $self->{'login_script'};
791 return '' if $self->use_plaintext || $self->disable_simple_cram;
792 return \
q{<form name="[% form_name %]_jspost" style="margin:0px" method="POST">
793 <input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
795 <script src="[% md5_js_path %]"></script>
797 if (document.md5_hex) document.[% form_name %].onsubmit = function () {
798 var f = document.[% form_name %];
799 var u = f.[% key_user %].value;
800 var p = f.[% key_pass %].value;
801 var t = f.[% key_time %].value;
802 var s = f.[% key_save %] && f.[% key_save %].checked ? -1 : f.[% key_expires_min %].value;
804 var str = u+'/'+t+'/'+s+'/'+'';
805 var sum = document.md5_hex(str +'/' + document.md5_hex(p));
807 var f2 = document.[% form_name %]_jspost;
808 f2.[% key_user %].value = str +'/'+ sum;
809 f2.[% key_redirect %].value = f.[% key_redirect %].value;
810 f2.action = f.action;
818 ###----------------------------------------------------------------###
820 package CGI
::Ex
::Auth
::Data
;
824 'bool' => sub { ! shift-
>error },
826 '""' => sub { shift-
>as_string },
830 my ($class, $args) = @_;
831 return bless {%{ $args || {} }}, $class;
836 my $args = @_ == 1 ? shift : {@_};
837 @{ $self }{keys %$args} = values %$args;
843 $self->{'error'} = shift;
844 $self->{'error_caller'} = [caller];
846 return $self->{'error'};
851 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
854 ###----------------------------------------------------------------###
864 ### authorize the user
865 my $auth = CGI::Ex::Auth->get_valid_auth({
866 get_pass_by_user => \&get_pass_by_user,
870 sub get_pass_by_user {
873 my $pass = some_way_of_getting_password($user);
877 ### OR - if you are using a OO based CGI or Application
879 sub require_authentication {
882 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
883 get_pass_by_user => sub {
884 my ($auth, $user) = @_;
885 return $self->get_pass($user);
891 my ($self, $user) = @_;
892 return $self->loopup_and_cache_pass($user);
897 CGI::Ex::Auth allows for auto-expiring, safe and easy web based
898 logins. Auth uses javascript modules that perform MD5 hashing to cram
899 the password on the client side before passing them through the
902 For the stored cookie you can choose to use simple cram mechanisms,
903 secure hash cram tokens, auto expiring logins (not cookie based),
904 and Crypt::Blowfish protection. You can also choose to keep
905 passwords plaintext and to use perl's crypt for testing
906 passwords. Or you can completely replace the cookie parsing/generating
907 and let Auth handle requesting, setting, and storing the cookie.
909 A theoretical downside to this module is that it does not use a
910 session to preserve state so get_pass_by_user has to happen on every
911 request (any authenticated area has to verify authentication each time
912 - unless the verify_token method is completely overridden). In theory
913 you should be checking the password everytime a user makes a request
914 to make sure the password is still valid. A definite plus is that you
915 don't need to use a session if you don't want to. It is up to the
916 interested reader to add caching to the get_pass_by_user method.
918 In the end, the only truly secure login method is across an https
919 connection. Any connection across non-https (non-secure) is
920 susceptible to cookie hijacking or tcp hijacking - though the
921 possibility of this is normally small and typically requires access to
922 a machine somewhere in your TCP chain. If in doubt - you should try
923 to use https - but even then you need to guard the logged in area
924 against cross-site javascript exploits. A discussion of all security
925 issues is far beyond the scope of this documentation.
933 Constructor. Takes a hashref of properties as arguments.
935 Many of the methods which may be overridden in a subclass,
936 or may be passed as properties to the new constuctor such as in the following:
939 get_pass_by_user => \&my_pass_sub,
940 key_user => 'my_user',
941 key_pass => 'my_pass',
942 login_header => \"<h1>My Login</h1>",
945 The following methods will look for properties of the same name. Each of these will be
946 described separately.
984 template_include_path
1000 =item C<generate_token>
1002 Takes either an auth_data object from a auth_data returned by verify_token,
1003 or a hashref of arguments.
1005 Possible arguments are:
1007 user - the username we are generating the token for
1008 real_pass - the password of the user (if use_plaintext is false
1009 and use_crypt is false, the password can be an md5sum
1010 of the user's password)
1011 use_blowfish - indicates that we should use Crypt::Blowfish to protect
1012 the generated token. The value of this argument is used
1013 as the key. Default is false.
1014 use_base64 - indicates that we should use Base64 encoding to protect
1015 the generated token. Default is true. Will not be
1016 used if use_blowfish is true.
1017 use_plaintext - indicates that we should keep the password in plaintext
1018 use_crypt - also indicates that we should keep the password in plaintext
1019 expires_min - says how many minutes until the generated token expires.
1020 Values <= 0 indicate to not ever expire. Used only on cram
1022 payload - a payload that will be passed to generate_payload and then
1023 will be added to cram type tokens. It cannot contain a /.
1025 - If the secure_hash_keys method returns keys, and it is a non-plaintext
1026 token, generate_token will create a secure_hash_cram. Set
1027 this value to true to tell it to use a simple_cram. This
1028 is generally only useful in testing.
1030 The following are types of tokens that can be generated by generate_token. Each type includes
1031 pseudocode and a sample of a generated that token.
1035 real_pass := "123qwe"
1036 token := join("/", user, real_pass);
1039 token == "paul/123qwe"
1042 token == "cGF1bC8xMjNxd2U="
1044 use_blowfish := "foobarbaz"
1045 token == "6da702975190f0fe98a746f0d6514683"
1047 Notes: This token will be used if either use_plaintext or use_crypt is set.
1048 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1049 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1050 token will not be able to be verified.
1054 real_pass := "123qwe"
1055 server_time := 1148512991 # a time in seconds since epoch
1056 expires_min := 6 * 60
1057 payload := "something"
1059 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1060 str := join("/", user, server_time, expires_min, payload, md5_pass)
1061 md5_str := md5(sum_str)
1062 token := join("/", user, server_time, expires_min, payload, md5_str)
1065 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1068 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1070 Notes: use_blowfish is available as well
1074 real_pass := "123qwe"
1075 server_time := 1148514034 # a time in seconds since epoch
1076 expires_min := 6 * 60
1077 payload := "something"
1078 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1079 rand1 := 3 # int(rand(length(secure_hash)))
1080 rand2 := 39163 # int(rand(100000))
1082 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1084 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1085 sh_str2 := join(".", "sh", rand1, rand2)
1086 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1087 md5_str := md5(sum_str)
1088 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1091 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1093 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1094 "secure_hash_keys" property of the CGI::Ex::Auth object.
1096 =item C<get_valid_auth>
1098 Performs the core logic. Returns an auth object on successful login.
1099 Returns false on errored login (with the details of the error stored in
1100 $@). If a false value is returned, execution of the CGI should be halted.
1101 get_valid_auth WILL NOT automatically stop execution.
1103 $auth->get_valid_auth || exit;
1105 Optionally, the class and a list of arguments may be passed. This will create a
1106 new object using the passed arguments, and then run get_valid_auth.
1108 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1110 =item C<check_valid_auth>
1112 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1113 This allows for obtaining login data without forcing an html login
1116 =item C<login_print>
1118 Called if login errored. Defaults to printing a very basic (but
1119 adequate) page loaded from login_template..
1121 You will want to override it with a template from your own system.
1122 The hook that is called will be passed the step to print (currently
1123 only "get_login_info" and "no_cookies"), and a hash containing the
1124 form variables as well as the following:
1126 =item C<login_hash_common>
1128 Passed to the template swapped during login_print.
1130 %$form, # any keys passed to the login script
1131 error # The text "Login Failed" if a login occurred
1132 login_data # A login data object if they failed authentication.
1133 key_user # $self->key_user, # the username fieldname
1134 key_pass # $self->key_pass, # the password fieldname
1135 key_time # $self->key_time, # the server time field name
1136 key_save # $self->key_save, # the save password checkbox field name
1137 key_redirect # $self->key_redirect, # the redirect fieldname
1138 form_name # $self->form_name, # the name of the form
1139 script_name # $self->script_name, # where the server will post back to
1140 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1141 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1142 $self->key_user # $data->{'user'}, # the username (if any)
1143 $self->key_pass # '', # intentional blankout
1144 $self->key_time # $self->server_time, # the server's time
1145 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1146 text_user # $self->text_user # template text Username:
1147 text_pass # $self->text_pass # template text Password:
1148 text_save # $self->text_save # template text Save Password ?
1149 text_submit # $self->text_submit # template text Login
1150 hide_save # $self->hide_save # 0
1152 =item C<bounce_on_logout>
1154 Default 0. If true, will location bounce to script returned by logout_redirect
1155 passing the key key_logout. If false, will simply show the login screen.
1157 =item C<key_loggedout>
1159 Key to bounce with in the form during a logout should bounce_on_logout return true.
1160 Default is "loggedout".
1164 If the form hash contains a true value in this field name, the current user will
1165 be logged out. Default is "cea_logout".
1169 The name of the auth cookie. Default is "cea_user".
1173 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1177 The form field name used to pass the username. Default is "cea_user".
1181 The form field name used to pass the password. Default is "cea_pass".
1185 Works in conjunction with key_expires_min. If key_save is true, then
1186 the cookie will be set to be saved for longer than the current session
1187 (If it is a plaintext variety it will be given a 20 year life rather
1188 than being a session cookie. If it is a cram variety, the expires_min
1189 portion of the cram will be set to -1). If it is set to false, the cookie
1190 will be available only for the session (If it is a plaintext variety, the cookie
1191 will be session based and will be removed on the next loggout. If it is
1192 a cram variety then the cookie will only be good for expires_min minutes.
1194 Default is "cea_save".
1196 =item C<key_expires_min>
1198 The name of the form field that contains how long cram type cookies will be valid
1199 if key_save contains a false value.
1201 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1203 This value will have no effect when use_plaintext or use_crypt is set.
1205 A value of -1 means no expiration.
1207 =item C<failed_sleep>
1209 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1210 if validation failed because of expired tokens. Default value is 0.
1211 Setting to 0 disables any sleeping.
1215 The name of the html login form to attach the javascript to. Default is "cea_form".
1217 =item C<verify_token>
1219 This method verifies the token that was passed either via the form or via cookies.
1220 It will accept plaintext or crammed tokens (A listing of the available algorithms
1221 for creating tokes is listed below). It also allows for armoring the token with
1222 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1223 can be found under generate_token.
1225 =item C<parse_token>
1227 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1228 Returns true if it was able to parse the passed token.
1230 =item C<cleanup_user>
1232 Called by verify_token. Default is to do no modification. Allows for usernames to
1233 be lowercased, or canonized in some other way. Should return the cleaned username.
1235 =item C<verify_user>
1237 Called by verify_token. Single argument is the username. May or may not be an
1238 initial check to see if the username is ok. The username will already be cleaned at
1239 this point. Default return is true.
1241 =item C<get_pass_by_user>
1243 Called by verify_token. Given the cleaned, verified username, should return a
1244 valid password for the user. It can always return plaintext. If use_crypt is
1245 enabled, it should return the crypted password. If use_plaintext and use_crypt
1246 are not enabled, it may return the md5 sum of the password.
1248 get_pass_by_user => sub {
1249 my ($auth_obj, $user) = @_;
1250 my $pass = $some_obj->get_pass({user => $user});
1254 Alternately, get_pass_by_user may return a hashref of data items that
1255 will be added to the data object if the token is valid. The hashref
1256 must also contain a key named real_pass or password that contains the
1257 password. Note that keys passed back in the hashref that are already
1258 in the data object will override those in the data object.
1260 get_pass_by_user => sub {
1261 my ($auth_obj, $user) = @_;
1262 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1265 user_id => $user_id,
1269 =item C<verify_password>
1271 Called by verify_token. Passed the password to check as well as the
1272 auth data object. Should return true if the password matches.
1273 Default method can handle md5, crypt, cram, secure_hash_cram, and
1274 plaintext (all of the default types supported by generate_token). If
1275 a property named verify_password exists, it will be used and called as
1276 a coderef rather than using the default method.
1278 =item C<verify_payload>
1280 Called by verify_token. Passed the password to check as well as the
1281 auth data object. Should return true if the payload is valid.
1282 Default method returns true without performing any checks on the
1283 payload. If a property named verify_password exists, it will be used
1284 and called as a coderef rather than using the default method.
1289 Returns a CGI::Ex object.
1293 A hash of passed form info. Defaults to CGI::Ex::get_form.
1297 The current cookies. Defaults to CGI::Ex::get_cookies.
1299 =item C<login_template>
1301 Should return either a template filename to use for the login template, or it
1302 should return a reference to a string that contains the template. The contents
1303 will be used in login_print and passed to the template engine.
1305 Default login_template is the values of login_header, login_form, login_script, and
1306 login_script concatenated together.
1308 Values from login_hash_common will be passed to the template engine, and will
1309 also be used to fill in the form.
1311 The basic values are capable of handling most needs so long as appropriate
1312 headers and css styles are used.
1314 =item C<login_header>
1316 Should return a header to use in the default login_template. The default
1317 value will try to PROCESS a file called login_header.tt that should be
1318 located in directory specified by the template_include_path method.
1320 It should ideally supply css styles that format the login_form as desired.
1322 =item C<login_footer>
1324 Same as login_header - but for the footer. Will look for login_footer.tt by
1329 An html chunk that contains the necessary form fields to login the user. The
1330 basic chunk has a username text entry, password text entry, save password checkbox,
1331 and submit button, and any hidden fields necessary for logging in the user.
1333 =item C<login_script>
1335 Contains javascript that will attach to the form from login_form. This script
1336 is capable of taking the login_fields and creating an md5 cram which prevents
1337 the password from being passed plaintext.
1339 =item C<text_user, text_pass, text_save>
1341 The text items shown in the default login template. The default values are:
1343 text_user "Username:"
1344 text_pass "Password:"
1345 text_save "Save Password ?"
1347 =item C<disable_simple_cram>
1349 Disables simple cram type from being an available type. Default is
1350 false. If set, then one of use_plaintext, use_crypt, or
1351 secure_hash_keys should be set. Setting this option allows for
1352 payloads to be generated by the server only - otherwise a user who
1353 understands the algorithm could generate a valid simple_cram cookie
1354 with a custom payload.
1356 Another option would be to only accept payloads from tokens if use_blowfish
1357 is set and armor was equal to "blowfish."
1363 This module may be distributed under the same terms as Perl itself.
1367 Paul Seamons <perl at seamons dot com>
This page took 0.13144 seconds and 4 git commands to generate.