3 ### CGI Extended Application
5 ###----------------------------------------------------------------###
6 # Copyright 2004 - Paul Seamons #
7 # Distributed under the Perl Artistic License without warranty #
8 ###----------------------------------------------------------------###
10 ### See perldoc at bottom
14 use vars
qw($USE_PLAINTEXT
21 use CGI
::Ex
::Dump
qw(debug);
22 use MIME
::Base64
qw(encode_base64 decode_base64);
26 $CHECK_CRYPTED = 1 if ! defined $CHECK_CRYPTED;
27 $FAILED_SLEEP = 2 if ! defined $FAILED_SLEEP;
28 $EXPIRE_LOGINS = 6 * 3600 if ! defined $EXPIRE_LOGINS;
29 #if ($ENV{MOD_PERL}) {
30 # require Digest::SHA1;
31 # require Digest::MD5;
35 ###----------------------------------------------------------------###
38 my $class = shift || __PACKAGE__
;
39 my $self = ref($_[0]) ? shift : {@_};
47 ###----------------------------------------------------------------###
51 $self = __PACKAGE__-
>new($self) if ! UNIVERSAL
::isa
($self, __PACKAGE__
);
53 ### shortcut that will print a js file as needed
54 if ($ENV{PATH_INFO
} && $ENV{PATH_INFO
} =~ m
|^/js/(CGI
/Ex/\w
+\
.js
)$|) {
55 $self->cgix->print_js($1);
59 my $form = $self->form;
60 my $cookies = $self->cookies;
61 my $key_l = $self->key_logout;
62 my $key_c = $self->key_cookie;
63 my $key_u = $self->key_user;
64 my $key_p = $self->key_pass;
65 my $key_chk = $self->key_cookie_check;
66 my $had_form_info = 0;
68 ### if they've passed us information - try and use it
69 if ($form->{$key_l}) {
72 } elsif (exists($form->{$key_u}) && exists($form->{$key_p})) {
73 if ($self->verify_userpass($form->{$key_u}, $form->{$key_p})) {
74 my $has_cookies = scalar keys %$cookies;
75 my $user = $form->{$key_u};
76 my $str = encode_base64
(join(":", delete($form->{$key_u}), delete($form->{$key_p})), "");
77 my $key_s = $self->key_save;
78 $self->set_cookie($str, delete($form->{$key_s}));
79 #return $self->success($user); # assume that cookies will work - if not next page will cause login
80 #### this may actually be the nicer thing to do in the common case - except for the nasty looking
81 #### url - all things considered - should really get location boucing to work properly while being
82 #### able to set a cookie at the same time
85 return $self->success($user); # assuming if they have cookies - the one we set will work
87 $form->{$key_chk} = time();
88 my $key_r = $self->key_redirect;
89 if (! $form->{$key_r}) {
90 my $script = $ENV{SCRIPT_NAME
} || die "Missing SCRIPT_NAME";
91 my $info = $ENV{PATH_INFO
} || '';
92 my $query = $self->cgix->make_form($form);
93 $form->{$key_r} = $script . $info . ($query ? "?$query" : "");
95 $self->location_bounce($form->{$key_r});
100 $self->delete_cookie;
103 ### otherwise look for an already set cookie
104 } elsif ($cookies->{$key_c}) {
105 my ($user, $pass) = split /:/, decode_base64
($cookies->{$key_c}), 2;
106 return $self->success($user) if $self->verify_userpass($user, $pass);
107 $self->delete_cookie;
109 ### cases to handle no cookies
110 } elsif ($form->{$key_chk}) {
111 my $value = delete $form->{$key_chk};
112 if ($self->allow_htauth) {
113 die "allow_htauth is not implemented - yet";
114 } elsif (abs(time() - $value) < 3600) {
115 # fail down to below where we ask for auth
116 # this is assuming that all webservers in the cluster are within 3600 of each other
118 $self->hook_print("no_cookies", $form);
123 ### oh - you're still here - well then - ask for login credentials
124 my $key_r = $self->key_redirect;
125 if (! $form->{$key_r}) {
126 my $script = $ENV{SCRIPT_NAME
} || die "Missing SCRIPT_NAME";
127 my $info = $ENV{PATH_INFO
} || '';
128 my $query = $self->cgix->make_form($form);
129 $form->{$key_r} = $script . $info . ($query ? "?$query" : "");
131 $form->{login_error
} = $had_form_info;
132 $self->hook_print("get_login_info", $form);
136 ###----------------------------------------------------------------###
143 ### copy the form and add various pieces
145 $FORM->{payload
} = $self->payload;
146 $FORM->{error
} = ($form->{login_error
}) ? "Login Failed" : "";
147 $FORM->{key_user
} = $self->key_user;
148 $FORM->{key_pass
} = $self->key_pass;
149 $FORM->{key_save
} = $self->key_save;
150 $FORM->{key_redirect
} = $self->key_redirect;
151 $FORM->{form_name
} = $self->form_name;
152 $FORM->{script_name
} = $ENV{SCRIPT_NAME
};
153 $FORM->{path_info
} = $ENV{PATH_INFO
} || '';
154 $FORM->{login_script
} = $self->login_script($FORM);
155 delete $FORM->{$FORM->{key_pass
}};
157 ### allow for custom hook
158 if (my $meth = $self->{hook_print
}) {
159 $self->$meth($page, $FORM);
163 ### no hook - give basic functionality
165 if ($page eq 'no_cookies') {
166 $content = qq{<div style="border: 2px solid black;background:red;color:white">You do not appear to have cookies enabled.</div>};
167 } elsif ($page eq 'get_login_info') {
168 $content = $self->basic_login_page($FORM);
170 $content = "No content for page \"$page\"";
173 $self->cgix->print_content_type();
178 ###----------------------------------------------------------------###
183 $self->{user
} = $ENV{REMOTE_USER
} = $user;
184 $self->hook_success($user);
190 return $self->{user
};
197 if ($meth = $self->{hook_success
}) {
202 ###----------------------------------------------------------------###
206 my $key_c = $self->key_cookie;
207 $self->cgix->set_cookie({
217 my $key_c = $self->key_cookie;
218 my $value = shift || '';
219 my $save_pass = shift;
220 $self->cgix->set_cookie({
223 ($save_pass ? (-expires
=> '+10y') : ()),
228 sub location_bounce
{
231 return $self->cgix->location_bounce($url);
234 ###----------------------------------------------------------------###
238 $self->{key_logout
} = shift if $#_ != -1;
239 return $self->{key_logout
} ||= 'logout';
244 $self->{key_cookie
} = shift if $#_ != -1;
245 return $self->{key_cookie
} ||= 'ce_auth';
248 sub key_cookie_check
{
250 $self->{key_cookie_check
} = shift if $#_ != -1;
251 return $self->{key_cookie_check
} ||= 'ccheck';
256 $self->{key_user
} = shift if $#_ != -1;
257 return $self->{key_user
} ||= 'ce_user';
262 $self->{key_pass
} = shift if $#_ != -1;
263 return $self->{key_pass
} ||= 'ce_pass';
268 $self->{key_save
} = shift if $#_ != -1;
269 return $self->{key_save
} ||= 'ce_save';
274 $self->{key_redirect
} = shift if $#_ != -1;
275 return $self->{key_redirect
} ||= 'redirect';
280 $self->{form_name
} = shift if $#_ != -1;
281 return $self->{form_name
} ||= 'ce_form';
286 $self->{allow_htauth
} = shift if $#_ != -1;
287 return $self->{allow_htauth
} ||= 0;
293 my $time = shift || time();
295 my @payload = ($time);
296 if ($meth = $self->{hook_payload
}) {
297 push @payload, $self->$meth($user);
299 return join "/", @payload;
302 ###----------------------------------------------------------------###
304 sub verify_userpass
{
308 my $host = shift || $self->host;
310 if ($meth = $self->{hook_verify_userpass
}) {
311 return $self->$meth($user, $pass, $host);
313 return $self->hook_verify_userpass($user, $pass, $host);
317 sub hook_verify_userpass
{
320 my $pass_test = shift;
321 my $host = shift || $self->host;
323 return undef if ! defined $user;
324 return undef if ! defined $pass_test;
325 my $pass_real = $self->hook_get_pass_by_user($user, $host);
326 return undef if ! defined $pass_real;
328 my $type_real = ($pass_real =~ m/^(md5|sha1)\((.+)\)$/) ? $1 : 'plainorcrypt';
330 my $type_test = ($pass_test =~ m/^(md5|sha1)\((.+)\)$/) ? $1 : 'plainorcrypt';
333 ### if both types were plaintext - check if the equal
334 if ($type_real eq 'plainorcrypt'
335 && $type_test eq 'plainorcrypt') {
336 return 1 if $pass_real eq $pass_test;
337 if ($CHECK_CRYPTED && $pass_real =~ m
|^([./0-9A-Za-z
]{2})(.{,11})$|) {
338 return 1 if crypt($pass_test, $1) eq $pass_real;
343 ### if test type is plaintext - then hash it and compare it alone
344 if ($type_test eq 'plainorcrypt') {
345 $pass_test = $self->enc_func($type_real, $pass_test); # encode same as real
346 $pass_test = "$type_real($pass_test)";
347 return $pass_test eq $pass_real;
349 ### if real type is plaintext - then hash it to get ready for test
350 } elsif ($type_real eq 'plainorcrypt') {
351 $pass_real = $self->enc_func($type_test, $pass_real);
352 $pass_real = "$type_test($pass_real)";
353 $type_real = $type_test;
356 ### the types should be the same (unless a system stored sha1 and md5 passwords)
357 if ($type_real ne $type_test) {
358 warn "Test types for user \"$user\" are of two different types - very bad";
362 ### no payload - compare directly
363 if ($hash_test !~ m
|^(.+)/([^/]+)$|) {
364 return lc($pass_test) eq lc($pass_real);
366 ### and finally - check the payload (allows for expiring login)
368 my $payload = $1; # payload can be anything
369 my $compare = $2; # a checksum which is the enc of the payload + '/' + enc of password
370 my @payload = split /\//, $payload;
372 return 0 if $self->enc_func($type_test, "$payload/$hash_real") ne $compare;
374 ### if no save password && greater than expire time- expire
375 if ($EXPIRE_LOGINS && ! $payload[1] && $payload[0] =~ m/^(\d+)/) {
376 return 0 if time() > $1 + $EXPIRE_LOGINS;
381 return 0; # nothing should make it this far
388 if ($type eq 'md5') {
390 return &Digest
::MD5
::md5_hex
($str);
391 } elsif ($type eq 'sha1') {
392 require Digest
::SHA1
;
393 return &Digest
::SHA1
::sha1_hex
($str);
397 sub set_hook_get_pass_by_user
{
399 $self->{hook_get_pass_by_user
} = shift;
402 sub hook_get_pass_by_user
{
405 my $host = shift || $self->host;
407 if ($meth = $self->{hook_get_pass_by_user
}) {
408 return $self->$meth($user, $host);
410 die "hook_get_pass_by_user is a virtual method - please override - or use set_hook_get_pass_by_user";
413 ###----------------------------------------------------------------###
417 $self->{cgix
} = shift if $#_ != -1;
418 return $self->{cgix
} ||= do {
420 CGI
::Ex-
>new(); # return of the do
427 $self->{form
} = shift || die "Invalid form";
429 return $self->{form
} ||= $self->cgix->get_form;
435 $self->{cookies
} = shift || die "Invalid cookies";
437 return $self->{cookies
} ||= $self->cgix->get_cookies;
442 return $self->{host
} = shift if $#_ != -1;
443 return $self->{host
} ||= do {
444 my $host = $ENV{HTTP_HOST
} || die "Missing \$ENV{HTTP_HOST}";
446 $host =~ s/:\d*$//; # remove port number
447 $host =~ s/\.+$//; # remove qualified dot
448 $host =~ s/[^\w\.\-]//g; # remove odd characters
449 $host; # return of the do
453 ###----------------------------------------------------------------###
455 sub basic_login_page
{
459 my $text = $self->basic_login_template();
460 $self->cgix->swap_template(\
$text, $form);
461 $self->cgix->fill(\
$text, $form);
466 sub basic_login_template
{
470 <span class="error" style="color:red">[% error %]</span>
471 <form name="[% form_name %]" method="get" action="[% script_name %]">
472 <table border="0" class="login_table">
475 <td><input name="[% key_user %]" type="text" size="30" value=""></td>
479 <td><input name="[% key_pass %]" type="password" size="30" value=""></td>
483 <input type="checkbox" name="[% key_save %]" value="1"> Save Password ?
487 <td colspan="2" align="right">
488 <input type="hidden" name="[% key_redirect %]">
489 <input type="hidden" name="payload">
490 <input type="submit" value="Submit">
505 $self->{login_type
} = defined($_[0]) ? lc(shift) : undef;
507 $self->{login_type
} = do {
509 if ($USE_PLAINTEXT) {
511 } elsif (eval {require Digest
::SHA1
}) {
513 } elsif (eval {require Digest
::MD5
}) {
518 $type; # return of the do
519 } if ! defined $self->{login_type
};
520 return $self->{login_type
};
527 my $type = $self->login_type;
528 return if ! $type || $type !~ /^(sha1|md5)$/;
531 <script src="$form->{script_name}/js/CGI
/Ex/$type.js
"></script>
533 function send_it () {
534 var f = document.$form->{form_name};
535 var s = (f.$form->{key_save}.checked) ? 1 : 0;
536 var l = f.payload.value + '/' + s;
537 var r = f.$form->{key_redirect}.value;
538 var q = document.$form->{form_name}.action;
539 var sum = document.${type}_hex(l+'/'+document.${type}_hex(f.$form->{key_pass}.value));
540 q += '?$form->{key_user}='+escape(f.$form->{key_user}.value);
541 q += '&$form->{key_save}='+escape(s);
542 q += '&$form->{key_pass}='+escape('$type('+l+'/'+sum+')');
546 if (document.${type}_hex) document.$form->{form_name}.onsubmit = function () { return send_it() }
551 ###----------------------------------------------------------------###
553 ### return arguments to add on to a url to allow login (for emails)
554 sub auth_string_sha1 {
558 my $save = shift || 0;
559 my $time = shift || time;
560 my $payload = $self->payload($time);
562 require Digest::SHA1;
564 if ($pass =~ /^sha1\((.+)\)$/) {
567 $pass = &Digest::SHA1::sha1_hex($pass);
569 $pass = &Digest::SHA1::sha1_hex("$payload/$save/$pass");
571 return $self->cgix->make_form({
572 $self->key_user => $user,
573 $self->key_pass => "sha1
($payload/$save/$pass)",
574 $self->key_save => $save,
578 ###----------------------------------------------------------------###
586 CGI::Ex::Auth - Handle logins nicely.
590 ### authorize the user
591 my $auth = $self->auth({
592 hook_get_pass_by_user => \&get_pass_by_user,
593 hook_print => \&my_print,
594 login_type => 'sha1',
596 ### login_type may be sha1, md5, or plaintext
599 sub get_pass_by_user {
601 my $username = shift;
603 my $password = some_way_of_getting_password;
610 my $form = shift; # form includes login_script at this point
611 my $content = get_content_from_somewhere;
612 $auth->cgix->swap_template(\$content, $form);
613 $auth->cgix->print_content_type;
619 CGI::Ex::Auth allows for autoexpiring, safe logins. Auth uses
620 javascript modules that perform SHA1 and MD5 encoding to encode
621 the password on the client side before passing them through the
624 If SHA1 is used the storage of the password can be described by
627 my $pass = "plaintextpassword
";
628 my $save = ($save_the_password) ? 1 : 0;
630 my $store = sha1_hex("$time/$save/" . sha1_hex($pass));
632 This allows for passwords to be stored as sha1 in a database.
633 Passwords stored in the database this way are still susceptible to bruteforce
634 attack, but are much more secure than storing plain text.
636 If MD5 is used, the above procedure is replaced with md5_hex.
638 A downside to this module is that it does not use a session to preserve state
639 so authentication has to happen on every request. A plus is that you don't
640 need to use a session. With later releases, a method will be added to allow
641 authentication to look inside of a stored session somewhat similar to
650 Constructor. Takes a hash or hashref of properties as arguments.
654 Called automatically near the end of new.
656 =item C<require_auth>
658 Performs the core logic. Returns true on successful login.
659 Returns false on failed login. If a false value is returned,
660 execution of the CGI should be halted. require_auth WILL
661 NOT automatically stop execution.
663 $auth->require_auth || exit;
667 Called if login failed. Defaults to printing a very basic page.
668 You will want to override it with a template from your own system.
669 The hook that is called will be passed the step to print (currently
670 only "get_login_info
" and "no_cookies
"), and a hash containing the
671 form variables as well as the following:
673 payload - $self->payload
674 error - The error that occurred (if any)
675 key_user - $self->key_user;
676 key_pass - $self->key_pass;
677 key_save - $self->key_save;
678 key_redirect - $self->key_redirect;
679 form_name - $self->form_name;
680 script_name - $ENV{SCRIPT_NAME}
681 path_info - $ENV{PATH_INFO} || ''
682 login_script - $self->login_script($FORM); # The javascript that does the login
686 Method called on successful login. Sets $self->user as well as $ENV{REMOTE_USER}.
690 Returns the user that was successfully logged in (undef if no success).
692 =item C<hook_success>
694 Called from success. May be overridden or a subref may be given as a property.
698 If a key is passed the form hash that matches this key, the current user will
699 be logged out. Default is "logout
".
703 The name of the auth cookie. Default is "ce_auth
".
705 =item C<key_cookie_check>
707 A field name used during a bounce to see if cookies exist. Default is "ccheck
".
711 The form field name used to pass the username. Default is "ce_user
".
715 The form field name used to pass the password. Default is "ce_pass
".
719 The form field name used to pass whether they would like to save the cookie for
720 a longer period of time. Default is "ce_save
". The value of this form field
721 should be 1 or 0. If it is zero, the cookie installed will be a session cookie
722 and will expire in $EXPIRE_LOGINS seconds (default of 6 hours).
726 The name of the html login form to attach the javascript to. Default is "ce_form
".
730 Additional variables to store in the cookie. Can be used for anything. Should be
731 kept small. Default is time (should always use time as the first argument). Used
732 for autoexpiring the cookie and to prevent bruteforce attacks.
734 =item C<verify_userpass>
736 Called to verify the passed form information or the stored cookie. Calls hook_verify_userpass.
738 =item C<hook_verify_userpass>
740 Called by verify_userpass. Arguments are the username, cookie or info to be tested,
741 and the hostname. Default method calls hook_get_pass_by_user to get the real password.
742 Then based upon how the real password is stored (sha1, md5, plaintext, or crypted) and
743 how the login info was passed from the html form (or javascript), will attempt to compare
744 the two and return success or failure. It should be noted that if the javascript method
745 used is SHA1 and the password is stored crypted or md5'ed - the comparison will not work
746 and the login will fail. SHA1 logins require either plaintext password or sha1 stored passwords.
747 MD5 logins require either plaintext password or md5 stored passwords. Plaintext logins
748 allow for SHA1 or MD5 or crypted or plaintext storage - but should be discouraged because
749 they are plaintext and the users password can be discovered.
751 =item C<hook_get_pass_by_user>
753 Called by hook_verify_userpass. Arguments are the username and hostname. Should return
754 a sha1 password, md5 password, plaintext password, or crypted password depending
755 upon which system is being used to get the information from the user.
757 =item C<set_hook_get_pass_by_user>
759 Allows for setting the subref used by hook_get_pass_by_user.x
763 Returns a CGI::Ex object.
767 A hash of passed form info. Defaults to CGI::Ex::get_form.
771 The current cookies. Defaults to CGI::Ex::get_cookies.
775 What host are we on. Defaults to a cleaned $ENV{HTTP_HOST}.
777 =item C<basic_login_page>
779 Calls the basic_login_template, swaps in the form variables (including
780 form name, login_script, etc). Then prints content_type, the content, and
783 =item C<basic_login_template>
785 Returns a bare essentials form that will handle the login. Has place
786 holders for all of the form name, and login variables, and errors and
787 login javascript. Variable place holders are of the form
788 [% login_script %] which should work with Template::Toolkit or CGI::Ex::swap_template.
792 Either sha1, md5, or plaintext. If global $USE_PLAINTEXT is set,
793 plaintext password will be used. login_type will then look for
794 Digest::SHA1, then Digest::MD5, and then fail to plaintext.
796 SHA1 comparison will work with passwords stored as plaintext password,
797 or stored as the string "sha1
(".sha1_hex($password).")".
799 MD5 comparison will work with passwords stored as plaintext password,
800 or stored as the string "md5
(".md5_hex($password).")".
802 Plaintext comparison will work with passwords stored as sha1(string),
803 md5(string), plaintext password string, or crypted password.
805 =item C<login_script>
807 Returns a chunk of javascript that will encode the password before
808 the html form is ever submitted. It does require that $ENV{PATH_TRANSLATED}
809 is not modified before calling the require_auth method so that any
810 external javascript files may be served (also by the require_auth).
812 =item C<auth_string_sha1>
814 Arguments are username, password, save_password, and time. This will
815 return a valid login string. You probably will want to pass 1 for the
816 save_password or else the login will only be good for 6 hours.
818 my $login = $self->auth->auth_string_sha1($user, $pass, 1);
819 my $url = "http
://$ENV{HTTP_HOST
}$ENV{SCRIPT_NAME
}?$login";
823 Using plaintext allows for the password to be passed in the querystring.
824 It should at least be Base64 encoded. I'll add that soon - BUT - really
825 you should be using the SHA1 or MD5 login types.
829 Paul Seamons <perlspam at seamons dot com>