5 CGI::Ex::Auth - Handle logins nicely.
9 ###----------------------------------------------------------------###
10 # Copyright 2004-2012 - 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 || !$self->check_form_user_against_cookie($user, $data->{'user'}, $data)) { # 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 exists $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';
261 if (my $dom = $ENV{HTTP_HOST
}) {
264 local $args->{'domain'} = $dom;
265 $self->set_cookie($args);
266 local $args->{'domain'} = ".$dom";
267 $self->set_cookie($args);
269 while ($dom =~ s/^[\w\-]*\.// and $dom =~ /\./);
271 $self->set_cookie($args);
272 delete $self->cookies->{$args->{'name'}};
278 return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
279 my $key = $args->{'name'};
280 my $val = $args->{'value'};
281 my $dom = $args->{'domain'} || $self->cookie_domain;
282 my $sec = $args->{'secure'} || $self->cookie_secure;
283 $self->cgix->set_cookie({
286 -path
=> $args->{'path'} || $self->cookie_path($key, $val) || '/',
287 ($dom ? (-domain
=> $dom) : ()),
288 ($sec ? (-secure
=> $sec) : ()),
289 ($args->{'expires'} ? (-expires
=> $args->{'expires'}): ()),
291 $self->cookies->{$key} = $val;
294 sub location_bounce
{
297 return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
298 return $self->cgix->location_bounce($url);
301 ###----------------------------------------------------------------###
303 sub key_logout
{ shift-
>{'key_logout'} ||= 'cea_logout' }
304 sub key_cookie
{ shift-
>{'key_cookie'} ||= 'cea_user' }
305 sub key_user
{ shift-
>{'key_user'} ||= 'cea_user' }
306 sub key_pass
{ shift-
>{'key_pass'} ||= 'cea_pass' }
307 sub key_time
{ shift-
>{'key_time'} ||= 'cea_time' }
308 sub key_save
{ shift-
>{'key_save'} ||= 'cea_save' }
309 sub key_expires_min
{ shift-
>{'key_expires_min'} ||= 'cea_expires_min' }
310 sub form_name
{ shift-
>{'form_name'} ||= 'cea_form' }
311 sub key_verify
{ shift-
>{'key_verify'} ||= 'cea_verify' }
312 sub key_redirect
{ shift-
>{'key_redirect'} ||= 'cea_redirect' }
313 sub key_loggedout
{ shift-
>{'key_loggedout'} ||= 'loggedout' }
314 sub bounce_on_logout
{ shift-
>{'bounce_on_logout'} ||= 0 }
315 sub secure_hash_keys
{ shift-
>{'secure_hash_keys'} ||= [] }
316 #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"}'
317 sub no_cookie_verify
{ shift-
>{'no_cookie_verify'} ||= 0 }
318 sub use_crypt
{ shift-
>{'use_crypt'} ||= 0 }
319 sub use_blowfish
{ shift-
>{'use_blowfish'} ||= '' }
320 sub use_plaintext
{ my $s = shift; $s->use_crypt || ($s->{'use_plaintext'} ||= 0) }
321 sub use_base64
{ my $s = shift; $s->{'use_base64'} = 1 if ! defined $s->{'use_base64'}; $s->{'use_base64'} }
322 sub expires_min
{ my $s = shift; $s->{'expires_min'} = 6 * 60 if ! defined $s->{'expires_min'}; $s->{'expires_min'} }
323 sub failed_sleep
{ shift-
>{'failed_sleep'} ||= 0 }
324 sub cookie_path
{ shift-
>{'cookie_path'} }
325 sub cookie_domain
{ shift-
>{'cookie_domain'} }
326 sub cookie_secure
{ shift-
>{'cookie_secure'} }
327 sub use_session_cookie
{ shift-
>{'use_session_cookie'} }
328 sub disable_simple_cram
{ shift-
>{'disable_simple_cram'} }
329 sub complex_plaintext
{ shift-
>{'complex_plaintext'} }
331 sub logout_redirect
{
332 my ($self, $user) = @_;
333 my $form = $self->cgix->make_form({$self->key_loggedout => 1, (length($user) ? ($self->key_user => $user) : ()) });
334 return $self->{'logout_redirect'} || $self->script_name ."?$form";
339 return $self->{'js_uri_path'} ||= $self->script_name ."/js";
342 ###----------------------------------------------------------------###
344 sub no_cookies_print
{
346 return $self->{'no_cookies_print'}->($self) if $self->{'no_cookies_print'};
347 $self->cgix->print_content_type;
348 print qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
353 my $hash = $self->login_hash_common;
354 my $file = $self->login_template;
356 ### allow for a hooked override
357 if (my $meth = $self->{'login_print'}) {
358 $meth->($self, $file, $hash);
362 ### process the document
363 my $args = $self->template_args;
364 $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_include_path,
365 my $t = $self->template_obj($args);
367 $t->process_simple($file, $hash, \
$out) || die $t->error;
369 ### fill in form fields
370 require CGI
::Ex
::Fill
;
371 CGI
::Ex
::Fill
::fill
({text
=> \
$out, form
=> $hash});
374 $self->cgix->print_content_type;
381 my ($self, $args) = @_;
382 return $self->{'template_obj'} || do {
383 require Template
::Alloy
;
384 Template
::Alloy-
>new($args);
388 sub template_args
{ $_[0]->{'template_args'} ||= {} }
390 sub template_include_path
{ $_[0]->{'template_include_path'} || '' }
392 sub login_hash_common
{
394 my $form = $self->form;
395 my $data = $self->last_auth_data;
396 $data = {no_data
=> 1} if ! ref $data;
400 error
=> ($form->{'had_form_data'}) ? "Login Failed" : "",
402 key_user
=> $self->key_user,
403 key_pass
=> $self->key_pass,
404 key_time
=> $self->key_time,
405 key_save
=> $self->key_save,
406 key_expires_min
=> $self->key_expires_min,
407 key_redirect
=> $self->key_redirect,
408 form_name
=> $self->form_name,
409 script_name
=> $self->script_name,
410 path_info
=> $self->path_info,
411 md5_js_path
=> $self->js_uri_path ."/CGI/Ex/md5.js",
412 $self->key_user => $data->{'user'} || '',
413 $self->key_pass => '', # don't allow for this to get filled into the form
414 $self->key_time => $self->server_time,
415 $self->key_expires_min => $self->expires_min,
416 text_user
=> $self->text_user,
417 text_pass
=> $self->text_pass,
418 text_save
=> $self->text_save,
419 text_submit
=> $self->text_submit,
420 hide_save
=> $self->hide_save,
424 ###----------------------------------------------------------------###
429 if (my $meth = $self->{'verify_token'}) {
430 return $meth->($self, $args);
432 my $token = delete $args->{'token'}; die "Missing token" if ! length $token;
433 my $data = $self->new_auth_data({token
=> $token, %$args});
436 # make sure the token is parsed to usable data
437 if (ref $token) { # token already parsed
438 $data->add_data({%$token, armor
=> 'none'});
440 } elsif (my $meth = $self->{'parse_token'}) {
441 if (! $meth->($self, $args)) {
442 $data->error('Invalid custom parsed token') if ! $data->error; # add error if not already added
443 $data->{'allow_cookie_match'} = 1;
447 if (! $self->parse_token($token, $data)) {
448 $data->error('Invalid token') if ! $data->error; # add error if not already added
449 $data->{'allow_cookie_match'} = 1;
456 if (! defined($data->{'user'})) {
457 $data->error('Missing user');
458 } elsif (! defined($data->{'user'} = $self->cleanup_user($data->{'user'}))
459 || ! length($data->{'user'})) {
460 $data->error('Missing cleaned user');
461 } elsif (! defined $data->{'test_pass'}) {
462 $data->error('Missing test_pass');
463 } elsif (! $self->verify_user($data->{'user'})) {
464 $data->error('Invalid user');
466 return $data if $data->error;
470 if (! defined($pass = eval { $self->get_pass_by_user($data->{'user'}) })) {
471 $data->add_data({details
=> $@});
472 $data->error('Could not get pass');
473 } elsif (ref $pass eq 'HASH') {
475 $pass = exists($extra->{'real_pass'}) ? delete($extra->{'real_pass'})
476 : exists($extra->{'password'}) ? delete($extra->{'password'})
477 : do { $data->error('Data returned by get_pass_by_user did not contain real_pass or password'); undef };
478 $data->error('Invalid login') if ! defined $pass && ! $data->error;
479 $data->add_data($extra);
481 return $data if $data->error;
482 $data->add_data({real_pass
=> $pass}); # store - to allow generate_token to not need to relookup the pass
486 if ($meth = $self->{'verify_password'}) {
487 if (! $meth->($self, $pass, $data)) {
488 $data->error('Password failed verification') if ! $data->error;
491 if (! $self->verify_password($pass, $data)) {
492 $data->error('Password failed verification') if ! $data->error;
495 return $data if $data->error;
498 # validate the payload
499 if ($meth = $self->{'verify_payload'}) {
500 if (! $meth->($self, $data->{'payload'}, $data)) {
501 $data->error('Payload failed custom verification') if ! $data->error;
504 if (! $self->verify_payload($data->{'payload'}, $data)) {
505 $data->error('Payload failed verification') if ! $data->error;
514 return $self->{'_last_auth_data'} = CGI
::Ex
::Auth
::Data-
>new(@_);
518 my ($self, $token, $data) = @_;
521 for my $armor ('none', 'base64', 'blowfish') {
522 my $copy = ($armor eq 'none') ? $token
523 : ($armor eq 'base64') ? $self->use_base64 ? eval { local $^W; decode_base64
($token) } : next
524 : ($bkey = $self->use_blowfish) ? decrypt_blowfish
($token, $bkey)
526 if ($self->complex_plaintext && $copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / ([^/]*) / (.*) $|x
) {
537 } elsif ($copy =~ m
|^ ([^/]+) / (\d
+) / (-?\d+) / ([^/]*) / ([a-fA-F0-9
]{32}) (?: / (sh\
.\d
+\
.\d
+))? $|x
) {
544 secure_hash
=> $6 || '',
549 } elsif ($copy =~ m
|^ ([^/]+) / (.*) $|x
) {
562 sub verify_password
{
563 my ($self, $pass, $data) = @_;
566 ### looks like a secure_hash cram
567 if ($data->{'secure_hash'}) {
568 $data->add_data(type
=> 'secure_hash_cram');
569 my $array = eval {$self->secure_hash_keys };
571 $err = 'secure_hash_keys not found';
572 } elsif (! @$array) {
573 $err = 'secure_hash_keys empty';
574 } elsif ($data->{'secure_hash'} !~ /^sh\.(\d+)\.(\d+)$/ || $1 > $#$array) {
575 $err = 'Invalid secure hash';
579 my $real = $pass =~ /^[a-fA-F0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
580 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
581 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
582 if ($data->{'expires_min'} > 0
583 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
584 $err = 'Login expired';
585 } elsif (lc($data->{'test_pass'}) ne $sum) {
586 $err = 'Invalid login';
590 ### looks like a simple_cram
591 } elsif ($data->{'cram_time'}) {
592 $data->add_data(type
=> 'simple_cram');
593 die "Type simple_cram disabled during verify_password" if $self->disable_simple_cram;
594 my $real = $pass =~ /^[a-fA-F0-9]{32}$/ ? lc($pass) : md5_hex
($pass);
595 my $str = join("/", @{$data}{qw(user cram_time expires_min payload)});
596 my $sum = md5_hex
($str .'/'. $real);
597 if ($data->{'expires_min'} > 0
598 && ($self->server_time - $data->{'cram_time'}) > $data->{'expires_min'} * 60) {
599 $err = 'Login expired';
600 } elsif (lc($data->{'test_pass'}) ne $sum) {
601 $err = 'Invalid login';
605 } elsif ($data->{'plain_time'}
606 && $data->{'expires_min'} > 0
607 && ($self->server_time - $data->{'plain_time'}) > $data->{'expires_min'} * 60) {
608 $err = 'Login expired';
611 } elsif ($pass =~ m
|^([./0-9A-Za-z]{2})([./0-9A-Za-z
]{11})$|
612 && crypt($data->{'test_pass'}, $1) eq $pass) {
613 $data->add_data(type
=> 'crypt', was_plaintext
=> 1);
615 ### failed plaintext crypt
616 } elsif ($self->use_crypt) {
617 $err = 'Invalid login';
618 $data->add_data(type
=> 'crypt', was_plaintext
=> ($data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/ ? 0 : 1));
620 ### plaintext and md5
622 my $is_md5_t = $data->{'test_pass'} =~ /^[a-fA-F0-9]{32}$/;
623 my $is_md5_r = $pass =~ /^[a-fA-F0-9]{32}$/;
624 my $test = $is_md5_t ? lc($data->{'test_pass'}) : md5_hex
($data->{'test_pass'});
625 my $real = $is_md5_r ? lc($pass) : md5_hex
($pass);
626 $data->add_data(type
=> ($is_md5_r ? 'md5' : 'plaintext'), was_plaintext
=> ($is_md5_t ? 0 : 1));
627 $err = 'Invalid login'
631 $data->error($err) if $err;
635 sub last_auth_data
{ shift-
>{'_last_auth_data'} }
639 my $data = shift || $self->last_auth_data;
640 die "Can't generate a token off of a failed auth" if ! $data;
641 die "Can't generate a token for a user which contains a \"/\"" if $data->{'user'} =~ m
{/};
643 my $exp = defined($data->{'expires_min'}) ? $data->{'expires_min'} : $self->expires_min;
645 my $user = $data->{'user'} || die "Missing user";
646 my $load = $self->generate_payload($data);
647 die "User can not contain a \"/\." if $user =~ m
|/|;
648 die "Payload can not contain a \"/\. Please encode it in generate_payload." if $load =~ m
|/|;
650 ### do kinds that require staying plaintext
651 if ( (defined($data->{'use_plaintext'}) ? $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
652 || (defined($data->{'use_crypt'}) && $data->{'use_crypt'})
653 || (defined($data->{'type'}) && $data->{'type'} eq 'crypt')) {
654 my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
655 $token = $self->complex_plaintext ? join('/', $user, $self->server_time, $exp, $load, $pass) : "$user/$pass";
657 ### all other types go to cram - secure_hash_cram, simple_cram, plaintext and md5
659 my $real = defined($data->{'real_pass'}) ? ($data->{'real_pass'} =~ /^[a-fA-F0-9]{32}$/ ? lc($data->{'real_pass'}) : md5_hex
($data->{'real_pass'}))
660 : die "Missing real_pass";
662 if (! $data->{'prefer_simple_cram'}
663 && ($array = eval { $self->secure_hash_keys })
665 my $rand1 = int(rand @$array);
666 my $rand2 = int(rand 100000);
667 my $str = join("/", $user, $self->server_time, $exp, $load);
668 my $sum = md5_hex
($str .'/'. $real .('/sh.'.$array->[$rand1].'.'.$rand2));
669 $token = $str .'/'. $sum . '/sh.'.$rand1.'.'.$rand2;
671 die "Type simple_cram disabled during generate_token" if $self->disable_simple_cram;
672 my $str = join("/", $user, $self->server_time, $exp, $load);
673 my $sum = md5_hex
($str .'/'. $real);
674 $token = $str .'/'. $sum;
678 if (my $key = $data->{'use_blowfish'} || $self->use_blowfish) {
679 $token = encrypt_blowfish
($token, $key);
681 } elsif (defined($data->{'use_base64'}) ? $data->{'use_base64'} : $self->use_base64) {
682 $token = encode_base64
($token, '');
688 sub generate_payload
{
691 if (my $meth = $self->{'generate_payload'}) {
692 return $meth->($self, $args);
694 return defined($args->{'payload'}) ? $args->{'payload'} : '';
700 if (my $meth = $self->{'verify_user'}) {
701 return $meth->($self, $user);
709 if (my $meth = $self->{'cleanup_user'}) {
710 return $meth->($self, $user);
715 sub check_form_user_against_cookie
{
716 my ($self, $form_user, $cookie_user, $data) = @_;
717 return if ! defined($form_user) || ! defined($cookie_user);
718 return $form_user eq $cookie_user;
721 sub get_pass_by_user
{
724 if (my $meth = $self->{'get_pass_by_user'}) {
725 return $meth->($self, $user);
728 die "Please override get_pass_by_user";
732 my ($self, $payload, $data) = @_;
733 if (my $meth = $self->{'verify_payload'}) {
734 return $meth->($self, $payload, $data);
739 ###----------------------------------------------------------------###
741 sub encrypt_blowfish
{
742 my ($str, $key) = @_;
744 require Crypt
::Blowfish
;
745 my $cb = Crypt
::Blowfish-
>new($key);
747 $str .= (chr 0) x
(8 - length($str) % 8); # pad to multiples of 8
750 $enc .= unpack "H16", $cb->encrypt($1) while $str =~ /\G(.{8})/g; # 8 bytes at a time
755 sub decrypt_blowfish
{
756 my ($enc, $key) = @_;
758 require Crypt
::Blowfish
;
759 my $cb = Crypt
::Blowfish-
>new($key);
762 $str .= $cb->decrypt(pack "H16", $1) while $enc =~ /\G([A-Fa-f0-9]{16})/g;
768 ###----------------------------------------------------------------###
772 return $self->{'login_template'} if $self->{'login_template'};
775 map {ref $_ ? $$_ : /\[%/ ? $_ : $_ ? "[% TRY; PROCESS '$_'; CATCH %]<!-- [% error %] -->[% END %]\n" : ''}
776 $self->login_header, $self->login_form, $self->login_script, $self->login_footer;
780 sub login_header
{ shift-
>{'login_header'} || 'login_header.tt' }
781 sub login_footer
{ shift-
>{'login_footer'} || 'login_footer.tt' }
785 return $self->{'login_form'} if defined $self->{'login_form'};
786 return \
q{<div class="login_chunk">
787 <span class="login_error">[% error %]</span>
788 <form class="login_form" name="[% form_name %]" method="POST" action="[% script_name %][% path_info %]">
789 <input type="hidden" name="[% key_redirect %]" value="">
790 <input type="hidden" name="[% key_time %]" value="">
791 <input type="hidden" name="[% key_expires_min %]" value="">
792 <table class="login_table">
793 <tr class="login_username">
794 <td>[% text_user %]</td>
795 <td><input name="[% key_user %]" type="text" size="30" value=""></td>
797 <tr class="login_password">
798 <td>[% text_pass %]</td>
799 <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
801 [% IF ! hide_save ~%]
802 <tr class="login_save">
804 <input type="checkbox" name="[% key_save %]" value="1"> [% text_save %]
808 <tr class="login_submit">
809 <td colspan="2" align="right">
810 <input type="submit" value="[% text_submit %]">
819 sub text_user
{ my $self = shift; return defined($self->{'text_user'}) ? $self->{'text_user'} : 'Username:' }
820 sub text_pass
{ my $self = shift; return defined($self->{'text_pass'}) ? $self->{'text_pass'} : 'Password:' }
821 sub text_save
{ my $self = shift; return defined($self->{'text_save'}) ? $self->{'text_save'} : 'Save Password ?' }
822 sub hide_save
{ my $self = shift; return defined($self->{'hide_save'}) ? $self->{'hide_save'} : 0 }
823 sub text_submit
{ my $self = shift; return defined($self->{'text_submit'}) ? $self->{'text_submit'} : 'Login' }
827 return $self->{'login_script'} if defined $self->{'login_script'};
828 return '' if $self->use_plaintext || $self->disable_simple_cram;
829 return \
q{<form name="[% form_name %]_jspost" style="margin:0px" method="POST">
830 <input type="hidden" name="[% key_user %]"><input type="hidden" name="[% key_redirect %]">
832 <script src="[% md5_js_path %]"></script>
834 if (document.md5_hex) document.[% form_name %].onsubmit = function () {
835 var f = document.[% form_name %];
836 var u = f.[% key_user %].value;
837 var p = f.[% key_pass %].value;
838 var t = f.[% key_time %].value;
839 var s = f.[% key_save %] && f.[% key_save %].checked ? -1 : f.[% key_expires_min %].value;
841 var str = u+'/'+t+'/'+s+'/'+'';
842 var sum = document.md5_hex(str +'/' + document.md5_hex(p));
844 var f2 = document.[% form_name %]_jspost;
845 f2.[% key_user %].value = str +'/'+ sum;
846 f2.[% key_redirect %].value = f.[% key_redirect %].value;
847 f2.action = f.action;
855 ###----------------------------------------------------------------###
857 package CGI
::Ex
::Auth
::Data
;
861 'bool' => sub { ! shift-
>error },
863 '""' => sub { shift-
>as_string },
867 my ($class, $args) = @_;
868 return bless {%{ $args || {} }}, $class;
873 my $args = @_ == 1 ? shift : {@_};
874 @{ $self }{keys %$args} = values %$args;
880 $self->{'error'} = shift;
881 $self->{'error_caller'} = [caller];
883 return $self->{'error'};
888 return $self->error || ($self->{'user'} && $self->{'type'}) ? "Valid auth data" : "Unverified auth data";
891 ###----------------------------------------------------------------###
901 ### authorize the user
902 my $auth = CGI::Ex::Auth->get_valid_auth({
903 get_pass_by_user => \&get_pass_by_user,
907 sub get_pass_by_user {
910 my $pass = some_way_of_getting_password($user);
914 ### OR - if you are using a OO based CGI or Application
916 sub require_authentication {
919 return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
920 get_pass_by_user => sub {
921 my ($auth, $user) = @_;
922 return $self->get_pass($user);
928 my ($self, $user) = @_;
929 return $self->loopup_and_cache_pass($user);
934 CGI::Ex::Auth allows for auto-expiring, safe and easy web based
935 logins. Auth uses javascript modules that perform MD5 hashing to cram
936 the password on the client side before passing them through the
939 For the stored cookie you can choose to use simple cram mechanisms,
940 secure hash cram tokens, auto expiring logins (not cookie based),
941 and Crypt::Blowfish protection. You can also choose to keep
942 passwords plaintext and to use perl's crypt for testing
943 passwords. Or you can completely replace the cookie parsing/generating
944 and let Auth handle requesting, setting, and storing the cookie.
946 A theoretical downside to this module is that it does not use a
947 session to preserve state so get_pass_by_user has to happen on every
948 request (any authenticated area has to verify authentication each time
949 - unless the verify_token method is completely overridden). In theory
950 you should be checking the password everytime a user makes a request
951 to make sure the password is still valid. A definite plus is that you
952 don't need to use a session if you don't want to. It is up to the
953 interested reader to add caching to the get_pass_by_user method.
955 In the end, the only truly secure login method is across an https
956 connection. Any connection across non-https (non-secure) is
957 susceptible to cookie hijacking or tcp hijacking - though the
958 possibility of this is normally small and typically requires access to
959 a machine somewhere in your TCP chain. If in doubt - you should try
960 to use https - but even then you need to guard the logged in area
961 against cross-site javascript exploits. A discussion of all security
962 issues is far beyond the scope of this documentation.
970 Constructor. Takes a hashref of properties as arguments.
972 Many of the methods which may be overridden in a subclass,
973 or may be passed as properties to the new constuctor such as in the following:
976 get_pass_by_user => \&my_pass_sub,
977 key_user => 'my_user',
978 key_pass => 'my_pass',
979 login_header => \"<h1>My Login</h1>",
982 The following methods will look for properties of the same name. Each of these will be
983 described separately.
1022 template_include_path
1038 =item C<generate_token>
1040 Takes either an auth_data object from a auth_data returned by verify_token,
1041 or a hashref of arguments.
1043 Possible arguments are:
1045 user - the username we are generating the token for
1046 real_pass - the password of the user (if use_plaintext is false
1047 and use_crypt is false, the password can be an md5sum
1048 of the user's password)
1049 use_blowfish - indicates that we should use Crypt::Blowfish to protect
1050 the generated token. The value of this argument is used
1051 as the key. Default is false.
1052 use_base64 - indicates that we should use Base64 encoding to protect
1053 the generated token. Default is true. Will not be
1054 used if use_blowfish is true.
1055 use_plaintext - indicates that we should keep the password in plaintext
1056 use_crypt - also indicates that we should keep the password in plaintext
1057 expires_min - says how many minutes until the generated token expires.
1058 Values <= 0 indicate to not ever expire. Used only on cram
1060 payload - a payload that will be passed to generate_payload and then
1061 will be added to cram type tokens. It cannot contain a /.
1063 - If the secure_hash_keys method returns keys, and it is a non-plaintext
1064 token, generate_token will create a secure_hash_cram. Set
1065 this value to true to tell it to use a simple_cram. This
1066 is generally only useful in testing.
1068 The following are types of tokens that can be generated by generate_token. Each type includes
1069 pseudocode and a sample of a generated that token.
1073 real_pass := "123qwe"
1074 token := join("/", user, real_pass);
1077 token == "paul/123qwe"
1080 token == "cGF1bC8xMjNxd2U="
1082 use_blowfish := "foobarbaz"
1083 token == "6da702975190f0fe98a746f0d6514683"
1085 Notes: This token will be used if either use_plaintext or use_crypt is set.
1086 The real_pass can also be the md5_sum of the password. If real_pass is an md5_sum
1087 of the password but the get_pass_by_user hook returns the crypt'ed password, the
1088 token will not be able to be verified.
1092 real_pass := "123qwe"
1093 server_time := 1148512991 # a time in seconds since epoch
1094 expires_min := 6 * 60
1095 payload := "something"
1097 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1098 str := join("/", user, server_time, expires_min, payload, md5_pass)
1099 md5_str := md5(sum_str)
1100 token := join("/", user, server_time, expires_min, payload, md5_str)
1103 token == "paul/1148512991/360/something/16d0ba369a4c9781b5981eb89224ce30"
1106 token == "cGF1bC8xMTQ4NTEyOTkxLzM2MC9zb21ldGhpbmcvMTZkMGJhMzY5YTRjOTc4MWI1OTgxZWI4OTIyNGNlMzA="
1108 Notes: use_blowfish is available as well
1112 real_pass := "123qwe"
1113 server_time := 1148514034 # a time in seconds since epoch
1114 expires_min := 6 * 60
1115 payload := "something"
1116 secure_hash := ["aaaa", "bbbb", "cccc", "dddd"]
1117 rand1 := 3 # int(rand(length(secure_hash)))
1118 rand2 := 39163 # int(rand(100000))
1120 md5_pass := md5_sum(real_pass) # if it isn't already a 32 digit md5 sum
1122 sh_str1 := join(".", "sh", secure_hash[rand1], rand2)
1123 sh_str2 := join(".", "sh", rand1, rand2)
1124 str := join("/", user, server_time, expires_min, payload, md5_pass, sh_str1)
1125 md5_str := md5(sum_str)
1126 token := join("/", user, server_time, expires_min, payload, md5_str, sh_str2)
1129 token == "paul/1148514034/360/something/06db2914c9fd4e11499e0652bcf67dae/sh.3.39163"
1131 Notes: use_blowfish is available as well. The secure_hash keys need to be set in the
1132 "secure_hash_keys" property of the CGI::Ex::Auth object.
1134 =item C<get_valid_auth>
1136 Performs the core logic. Returns an auth object on successful login.
1137 Returns false on errored login (with the details of the error stored in
1138 $@). If a false value is returned, execution of the CGI should be halted.
1139 get_valid_auth WILL NOT automatically stop execution.
1141 $auth->get_valid_auth || exit;
1143 Optionally, the class and a list of arguments may be passed. This will create a
1144 new object using the passed arguments, and then run get_valid_auth.
1146 CGI::Ex::Auth->get_valid_auth({key_user => 'my_user'}) || exit;
1148 =item C<check_valid_auth>
1150 Runs get_valid_auth with login_print and location_bounce set to do nothing.
1151 This allows for obtaining login data without forcing an html login
1154 =item C<login_print>
1156 Called if login errored. Defaults to printing a very basic (but
1157 adequate) page loaded from login_template..
1159 You will want to override it with a template from your own system.
1160 The hook that is called will be passed the step to print (currently
1161 only "get_login_info" and "no_cookies"), and a hash containing the
1162 form variables as well as the following:
1164 =item C<login_hash_common>
1166 Passed to the template swapped during login_print.
1168 %$form, # any keys passed to the login script
1169 error # The text "Login Failed" if a login occurred
1170 login_data # A login data object if they failed authentication.
1171 key_user # $self->key_user, # the username fieldname
1172 key_pass # $self->key_pass, # the password fieldname
1173 key_time # $self->key_time, # the server time field name
1174 key_save # $self->key_save, # the save password checkbox field name
1175 key_redirect # $self->key_redirect, # the redirect fieldname
1176 form_name # $self->form_name, # the name of the form
1177 script_name # $self->script_name, # where the server will post back to
1178 path_info # $self->path_info, # $ENV{PATH_INFO} if any
1179 md5_js_path # $self->js_uri_path ."/CGI/Ex/md5.js", # script for cramming
1180 $self->key_user # $data->{'user'}, # the username (if any)
1181 $self->key_pass # '', # intentional blankout
1182 $self->key_time # $self->server_time, # the server's time
1183 $self->key_expires_min # $self->expires_min # how many minutes crams are valid
1184 text_user # $self->text_user # template text Username:
1185 text_pass # $self->text_pass # template text Password:
1186 text_save # $self->text_save # template text Save Password ?
1187 text_submit # $self->text_submit # template text Login
1188 hide_save # $self->hide_save # 0
1190 =item C<bounce_on_logout>
1192 Default 0. If true, will location bounce to script returned by logout_redirect
1193 passing the key key_logout. If false, will simply show the login screen.
1195 =item C<key_loggedout>
1197 Key to bounce with in the form during a logout should bounce_on_logout return true.
1198 Default is "loggedout".
1202 If the form hash contains a true value in this field name, the current user will
1203 be logged out. Default is "cea_logout".
1207 The name of the auth cookie. Default is "cea_user".
1211 A field name used during a bounce to see if cookies exist. Default is "cea_verify".
1215 The form field name used to pass the username. Default is "cea_user".
1219 The form field name used to pass the password. Default is "cea_pass".
1223 Works in conjunction with key_expires_min. If key_save is true, then
1224 the cookie will be set to be saved for longer than the current session
1225 (If it is a plaintext variety it will be given a 20 year life rather
1226 than being a session cookie. If it is a cram variety, the expires_min
1227 portion of the cram will be set to -1). If it is set to false, the cookie
1228 will be available only for the session (If it is a plaintext variety, the cookie
1229 will be session based and will be removed on the next loggout. If it is
1230 a cram variety then the cookie will only be good for expires_min minutes.
1232 Default is "cea_save".
1234 =item C<key_expires_min>
1236 The name of the form field that contains how long cram type cookies will be valid
1237 if key_save contains a false value.
1239 Default key name is "cea_expires_min". Default field value is 6 * 60 (six hours).
1241 This value will have no effect when use_plaintext or use_crypt is set.
1243 A value of -1 means no expiration.
1245 =item C<failed_sleep>
1247 Number of seconds to sleep if the passed tokens are invalid. Does not apply
1248 if validation failed because of expired tokens. Default value is 0.
1249 Setting to 0 disables any sleeping.
1253 The name of the html login form to attach the javascript to. Default is "cea_form".
1255 =item C<verify_token>
1257 This method verifies the token that was passed either via the form or via cookies.
1258 It will accept plaintext or crammed tokens (A listing of the available algorithms
1259 for creating tokes is listed below). It also allows for armoring the token with
1260 base64 encoding, or using blowfish encryption. A listing of creating these tokens
1261 can be found under generate_token.
1263 =item C<parse_token>
1265 Used by verify_token to remove armor from the passed tokens and split the token into its parts.
1266 Returns true if it was able to parse the passed token.
1268 =item C<cleanup_user>
1270 Called by verify_token. Default is to do no modification. Allows for usernames to
1271 be lowercased, or canonized in some other way. Should return the cleaned username.
1273 =item C<verify_user>
1275 Called by verify_token. Single argument is the username. May or may not be an
1276 initial check to see if the username is ok. The username will already be cleaned at
1277 this point. Default return is true.
1279 =item C<get_pass_by_user>
1281 Called by verify_token. Given the cleaned, verified username, should return a
1282 valid password for the user. It can always return plaintext. If use_crypt is
1283 enabled, it should return the crypted password. If use_plaintext and use_crypt
1284 are not enabled, it may return the md5 sum of the password.
1286 get_pass_by_user => sub {
1287 my ($auth_obj, $user) = @_;
1288 my $pass = $some_obj->get_pass({user => $user});
1292 Alternately, get_pass_by_user may return a hashref of data items that
1293 will be added to the data object if the token is valid. The hashref
1294 must also contain a key named real_pass or password that contains the
1295 password. Note that keys passed back in the hashref that are already
1296 in the data object will override those in the data object.
1298 get_pass_by_user => sub {
1299 my ($auth_obj, $user) = @_;
1300 my ($pass, $user_id) = $some_obj->get_pass({user => $user});
1303 user_id => $user_id,
1307 =item C<verify_password>
1309 Called by verify_token. Passed the password to check as well as the
1310 auth data object. Should return true if the password matches.
1311 Default method can handle md5, crypt, cram, secure_hash_cram, and
1312 plaintext (all of the default types supported by generate_token). If
1313 a property named verify_password exists, it will be used and called as
1314 a coderef rather than using the default method.
1316 =item C<verify_payload>
1318 Called by verify_token. Passed the password to check as well as the
1319 auth data object. Should return true if the payload is valid.
1320 Default method returns true without performing any checks on the
1321 payload. If a property named verify_password exists, it will be used
1322 and called as a coderef rather than using the default method.
1327 Returns a CGI::Ex object.
1331 A hash of passed form info. Defaults to CGI::Ex::get_form.
1335 The current cookies. Defaults to CGI::Ex::get_cookies.
1337 =item C<login_template>
1339 Should return either a template filename to use for the login template, or it
1340 should return a reference to a string that contains the template. The contents
1341 will be used in login_print and passed to the template engine.
1343 Default login_template is the values of login_header, login_form, login_script, and
1344 login_script concatenated together.
1346 Values from login_hash_common will be passed to the template engine, and will
1347 also be used to fill in the form.
1349 The basic values are capable of handling most needs so long as appropriate
1350 headers and css styles are used.
1352 =item C<login_header>
1354 Should return a header to use in the default login_template. The default
1355 value will try to PROCESS a file called login_header.tt that should be
1356 located in directory specified by the template_include_path method.
1358 It should ideally supply css styles that format the login_form as desired.
1360 =item C<login_footer>
1362 Same as login_header - but for the footer. Will look for login_footer.tt by
1367 An html chunk that contains the necessary form fields to login the user. The
1368 basic chunk has a username text entry, password text entry, save password checkbox,
1369 and submit button, and any hidden fields necessary for logging in the user.
1371 =item C<login_script>
1373 Contains javascript that will attach to the form from login_form. This script
1374 is capable of taking the login_fields and creating an md5 cram which prevents
1375 the password from being passed plaintext.
1377 =item C<text_user, text_pass, text_save>
1379 The text items shown in the default login template. The default values are:
1381 text_user "Username:"
1382 text_pass "Password:"
1383 text_save "Save Password ?"
1385 =item C<disable_simple_cram>
1387 Disables simple cram type from being an available type. Default is
1388 false. If set, then one of use_plaintext, use_crypt, or
1389 secure_hash_keys should be set. Setting this option allows for
1390 payloads to be generated by the server only - otherwise a user who
1391 understands the algorithm could generate a valid simple_cram cookie
1392 with a custom payload.
1394 Another option would be to only accept payloads from tokens if use_blowfish
1395 is set and armor was equal to "blowfish."
1401 This module may be distributed under the same terms as Perl itself.
1405 Paul Seamons <perl at seamons dot com>