#=============================================================================
# LibWeb::Admin -- a component of LibWeb--a Perl library/toolkit for building
#                  World Wide Web applications.

package LibWeb::Admin;

# Copyright (C) 2000  Colin Kong
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#=============================================================================

# For debugging purposes. Should be commented out in production release.


# Use standard library.
use SelfLoader;
use strict;
use vars qw(@ISA $VERSION);

# Use custom library.
require LibWeb::Session;

#Inheritance.
@ISA = qw(LibWeb::Session);

$VERSION = '0.01';

sub new {
    #
    # Params: $class [, $rc_file]
    #
    # - $class is the class/package name of this package, be it a string
    #   or a reference.
    # - $rc_file is the absolute path to the rc file for LibWeb.
    #
    # Usage: my $object = new LibWeb::Admin([$rc_file]);
    #
    my ($class, $Class, $self);
    $class = shift;
    $Class = ref($class) || $class;

    # Inherit instance variables from the base class.
    $self = $Class->SUPER::new(shift);
    bless($self, $Class);
}

sub DESTROY {}

sub _authenticateLogin {
    #
    # Params:
    # (\$uid, \$usrName, $db)
    #
    # Post:
    # 1. Send the prepared auth. cookie: session ID, issue time,
    #    expiration time, user name, IP, UID, MAC, where all elements are encrypted
    #    (one-way encrypted; except for the expiration time, user name and UID which
    #    are encrypted as ciphers (two-way encrypted) for later decryption during
    #    authentication check and for generating logout cookies.
    #    
    # 2. Update database: `LAST_LOGIN' (internet address, IP and date/time) and
    #    `NUM_LOGIN_ATTEMPT' for that user IS NOT done here since we want to make
    #    sure client Web browser accepts cookie first.  This task is delegated
    #    to sub is_login(1) which should be called by client codes when user is
    #    FIRST login.  Subsequent authenticate checks should call islogin() instead
    #    of is_login(1);
    #
    # 3. Return 1 upon success.
    #
    # Note: how a MAC is generated.  Could use MD5 or SHA etc.
    # MAC = MD5("secret key " +
    #           MD5("session ID" + "issue time" + "expiration time" +
    #               "user name" + "IP address" + "user id" + "secret key")
    #          ),
    #       where session ID = PID(which is $$) + UID(which is $$uid).
    #
    
    #============== #1 =====================
    my ($self, $crypt, $uid, $usrName, $db, $sid, $issueTime, $expireTime, $user,
	$ip, $cuid, $macKey, $preMAC, $MAC, $dummyCookie, $auth_cookie);
    $self = shift;
    ($uid, $usrName, $db) = @_;
    $crypt = LibWeb::Crypt->new();
    my(
       $cipher_key, $cipher_algorithm, $cipher_format,
       $digest_key, $digest_algorithm, $digest_format
      )
      = (
	 $self->{CIPHER_KEY}, $self->{CIPHER_ALGORITHM}, $self->{CIPHER_FORMAT},
	 $self->{DIGEST_KEY}, $self->{DIGEST_ALGORITHM}, $self->{DIGEST_FORMAT}
	);

    ($sid, $issueTime, $expireTime, $user, $ip, $cuid, $macKey) =
      ( 
       $crypt->generate_digest(
			      -data => $$ + $$uid,
			      -key => $digest_key,
			      -algorithm => $digest_algorithm,
			      -format => $digest_format
			     ),
       $crypt->generate_digest(
			      -data => time(),
			      -key => $digest_key,
			      -algorithm => $digest_algorithm,
			      -format => $digest_format
			     ),
       $crypt->encrypt_cipher(
			      -data => time() + $self->{LOGIN_DURATION_ALLOWED},
			      -key => $cipher_key,
			      -algorithm => $cipher_algorithm,
			      -format => $cipher_format
			     ),
       $crypt->encrypt_cipher(
			      -data => $$usrName,
			      -key => $cipher_key,
			      -algorithm => $cipher_algorithm,
			      -format => $cipher_format
			     ),
       $crypt->generate_digest( 
			      -data => $ENV{REMOTE_ADDR},
			      -key => $digest_key,
			      -algorithm => $digest_algorithm,
			      -format => $digest_format
			     ),
       $crypt->encrypt_cipher(
			      -data => $$uid,
			      -key => $cipher_key,
			      -algorithm => $cipher_algorithm,
			      -format => $cipher_format
			     ),
       $self->{MAC_KEY}
      );
    $preMAC =
      $crypt->generate_MAC(
			   -data => $sid.$issueTime.$expireTime.$user.$ip.$cuid.$macKey,
			   -key => $macKey,
			   -algorithm => $digest_algorithm,
			   -format => $digest_format
			  );
    $MAC = $crypt->generate_MAC(
				-data => $macKey.$preMAC,
				-key => $macKey,
				-algorithm => $digest_algorithm,
				-format => $digest_format
			       );
    $dummyCookie =
      "B=" .
	$crypt->generate_digest(
			       -data => rand( $self->{RAND_RANGE} ),
			       -key => $digest_key,
			       -algorithm => $digest_algorithm,
			       -format => $digest_format
			      ) .
				"; path=/";
    # CGI::Cookie has problem with characters `=' and `&' or a problem with my
    # understanding of autoescaping?  Therefore prepare the auth cookie manually
    # instead.
    $auth_cookie =
      "C=z=$sid&y=$issueTime&x=$expireTime&w=$user&v=$ip&u=$cuid&t=$MAC; path=/";
    LibWeb::CGI->new()->send_cookie([$dummyCookie, $auth_cookie]);
    return 1;
}

sub _handleLogin {
    #
    # Params:
    # (\$uid, \$usrname, \$cryptRealPass, \$guess, \$numLoginAttempt, $db)
    #
    # Pre:
    # 1. None.
    #
    # Post:
    # 1. Writing...
    #
    my ($self, $uid, $usrName, $cryptRealPass, $guess, $numLoginAttempt, $db);
    $self = shift;
    ($uid, $usrName, $cryptRealPass, $guess, $numLoginAttempt, $db) = @_;

    # Prevent further login attempt if reached max login attempt allowed.
    $self->fatal(-msg => 'Maximum login attempts reached.',
		 -alertMsg => "Max guess ($$guess) for account ($$usrName) reached.",
		 -helpMsg => $self->{HHTML}->exceeded_max_login_attempt(),
		 -cookie => $self->prepare_deauth_cookie())
      unless ($$numLoginAttempt < $self->{MAX_LOGIN_ATTEMPT_ALLOWED} ||
	      $$numLoginAttempt == $self->{LOGIN_INDICATOR});

    # Compare crypted guess with crypted real password.
    my $cryptGuess = crypt($$guess, $$cryptRealPass);
    if ($cryptGuess eq $$cryptRealPass) {

	# Alert admin if more than one login per account at a time.
	if ($$numLoginAttempt == $self->{LOGIN_INDICATOR}) {
#	    my $sql_statement = "update $self->{USER_LOG_TABLE} " .
#	                        "set $self->{USER_LOG_TABLE_NUM_LOGIN_ATTEMPT}=0 " .
#		                "where $self->{USER_LOG_TABLE_UID}='$$uid'";
#	    $db->do( -sql => $sql_statement );
	    $self->fatal(
			 -alertMsg => "Attempt to use guess [$$guess] to log in " .
			              "as user [$$usrName] while account's login" .
			              "indicator is high!",
			 -isDisplay => 0
			);
	}

	$self->_authenticateLogin($uid, $usrName, $db);
    }
    elsif ($cryptGuess ne $$cryptRealPass) {
	$self->_failLogin($uid, $usrName, $guess, $numLoginAttempt, $db);
    }
}

sub is_logout {
    #
    # Params:
    # none.
    #
    # Check to see if authenication cookies have been removed from
    # client Web browser and return true (1).  Otherwise, print
    # $self->{HHTML}->logout_failed() and exit the program.
    #
    my ($self, $sid, $issueTime, $expireTime, $cryptUsrname, $guessIP, $guessCUID,
	$guessMAC);
    $self = shift;
    ($sid, $issueTime, $expireTime, $cryptUsrname, $guessIP, $guessCUID, $guessMAC)
      = $self->_getAuthInfoFromCookie();
    $self->fatal(-msg => 'Could not logout.',
		 -alertMsg => 'Auth cookie is still defined after logout()!!!',
		 -helpMsg => $self->{HHTML}->logout_failed(),
		 -cookie => $self->prepare_deauth_cookie())
      if ( defined($sid) || defined($issueTime) || defined($expireTime) ||
	   defined($cryptUsrname) || defined($guessIP) || defined($guessCUID) ||
	   defined($guessMAC) );
    return 1;
}

sub login {
    #
    # Params:
    # (user_name, guess).
    #
    # Pre:
    # 1. None.
    #
    # Post:
    #
    # 1. Check for correct password.  If correct, send the special
    #    authentication cookie object to client Web browser and
    #    return 1; alert admin and print out error page and exit ow.
    #
    my ($self, $usrName, $guess, $uid, $cryptRealPass, $numLoginAttempt, $db,
	$bindCols, $sqlStatement, $fetchFunc, $alertMsg);
    $self = shift;
    $usrName = shift;
    $guess = shift;

    require LibWeb::Database;
    $db = new LibWeb::Database();

    # Fetch encrypted user password and numLoginAttempt from database.
    $bindCols = [\$uid, \$cryptRealPass, \$numLoginAttempt];
    $sqlStatement =
      "select $self->{USER_PROFILE_TABLE}.$self->{USER_PROFILE_TABLE_UID}, ".
	"$self->{USER_PROFILE_TABLE}.$self->{USER_PROFILE_TABLE_PASS}, ".
	  "$self->{USER_LOG_TABLE}.$self->{USER_LOG_TABLE_NUM_LOGIN_ATTEMPT} from ". 
	    "$self->{USER_PROFILE_TABLE},$self->{USER_LOG_TABLE} ".
	      "where  $self->{USER_PROFILE_TABLE_NAME} = '$usrName' ".
		"and $self->{USER_LOG_TABLE}.$self->{USER_LOG_TABLE_UID} = ".
		  "$self->{USER_PROFILE_TABLE}.$self->{USER_PROFILE_TABLE_UID}";
    $fetchFunc = $db->query(
			    -sql => $sqlStatement,
			    -bind_cols => $bindCols
			   );
    &$fetchFunc;
    if (defined($uid) && defined($cryptRealPass) && defined($numLoginAttempt)) {
	$self->_handleLogin(\$uid, \$usrName, \$cryptRealPass,
			    \$guess, \$numLoginAttempt, $db);
	return 1;
    }
    else { # No such user.
	$db->finish();
	$alertMsg = "User name ($usrName) and guess ($guess) non-exist.\n";
	$self->fatal(-msg => 'Login incorrect.', alertMsg => $alertMsg,
		     -helpMsg => $self->{HHTML}->login_failed(),
		     -cookie => $self->prepare_deauth_cookie());
    }
}

sub logout {
    #
    # Params:
    # None.
    #
    # Pre:
    #  1. None.
    #
    # Post:
    #  1. Check to see if user is logged in.  Get user name from cookie on client
    #     Web browser (decrypt).  Fatal if not logged in or no auth cookie.
    #  2. Flush 'NUM_LOGIN_ATTEMPT' to 0 in database.  This also indicates that
    #     the user is currently offline (logout).
    #  3. Send the prepared DeAuth. cookies for nullifying all cookies on client
    #     Web browser by preparing zero/null auth cookies with an expiration date
    #     in the past.  Also set dummy cookie's value to zero.
    #  4. Return 1 upon success.
    #
    my ($self, $usrName, $uid, $sqlStatement, $db);
    $self = shift;
    #=================== #1 =============================
    ($usrName, $uid) = $self->is_login();
    #=================== #2 =============================
    require LibWeb::Database;
    $db = new LibWeb::Database();
    $sqlStatement = "update $self->{USER_LOG_TABLE} " .
                    "set $self->{USER_LOG_TABLE_NUM_LOGIN_ATTEMPT} = 0 " .
		    "where $self->{USER_LOG_TABLE_UID} = $uid";  
    $db->do( -sql => $sqlStatement );
    $db->finish();
    #=================== #3 =============================
    # Remove auth. cookie from client Web browser and reset dummy cookie to 0.
    LibWeb::CGI->new()->send_cookie($self->prepare_deauth_cookie());
    return 1;
}

# Selfloading methods declaration.
sub LibWeb::Admin::_failLogin ;
sub LibWeb::Admin::_is_user_email_registered ;
sub LibWeb::Admin::_is_user_name_registered ;
sub LibWeb::Admin::add_new_user ;
1;
__DATA__

sub _failLogin {
    #
    # Actively fail a login attempt.
    #
    # Params:
    # (\$uid, \$usrName, \$guess, \$numLoginAttempt, $db)
    #
    # Pre:
    # 1. None.
    #
    # Post:
    # 1. None.
    #
    my ($self, $uid, $usrName, $guess, $numLoginAttempt, $db, $sqlStatement,
	$alertMsg);
    $self = shift;
    ($uid, $usrName, $guess, $numLoginAttempt, $db) = @_;
    $$numLoginAttempt++;
    $sqlStatement = "update $self->{USER_LOG_TABLE} " .
                    "set $self->{USER_LOG_TABLE_NUM_LOGIN_ATTEMPT}=".
		    $$numLoginAttempt .
	            " where $self->{USER_LOG_TABLE_UID}=$$uid";
    $alertMsg = "Incorrect guess ($$guess) for user account: $$usrName.\n";
    $db->do( -sql => $sqlStatement );
    $db->finish();
    $self->fatal(-msg => 'Login incorrect.', -alertMsg => $alertMsg,
		 -helpMsg => $self->{HHTML}->login_failed(),
		 -cookie => $self->prepare_deauth_cookie());
    return undef;
}

sub _is_user_email_registered {
    #
    # Params:
    # $email (scalar).
    #
    # Pre:
    # 1. None.
    #
    # Post:
    # 1. Print an error message and abort if $email is already registered.
    # 2. Otherwise, return 1.
    #
    my ($self, $email, $db, $sql_statement, $fetch, $uid);
    $self = shift;
    $email = shift;

    require LibWeb::Database;
    $db = new LibWeb::Database();

    $sql_statement = "select $self->{USER_PROFILE_TABLE_UID} ".
                     "from $self->{USER_PROFILE_TABLE} where ".
	             "$self->{USER_PROFILE_TABLE_EMAIL} = '$email'";
    $fetch = $db->query(
			-sql => $sql_statement,
			-bind_cols => [\$uid]
		       );
    &$fetch;
    $db->finish();
    return 0 unless defined($uid);
    $self->fatal(-msg => 'The email has already been registered.',
		 -input => $email,
		 -helpMsg => $self->{HHTML}->hit_back_and_edit());
}

sub _is_user_name_registered {
    #
    # Check a user name against database to see if the user name is in use already.
    #
    # Params:
    # $user_name (scalar).
    #
    # Pre:
    # 1. None.
    #
    # Post:
    # 1. Print an error message and abort if $user_name is already registered.
    # 2. Otherwise, return 0.
    #
    my ($self, $user_name, $db, $sql_statement, $fetch, $uid);
    $self = shift;
    $user_name = shift;

    require LibWeb::Database;
    $db = new LibWeb::Database();

    $sql_statement = "select $self->{USER_PROFILE_TABLE_UID} ".
                     "from $self->{USER_PROFILE_TABLE} where ".
	             "$self->{USER_PROFILE_TABLE_NAME} = '$user_name'";
    $fetch = $db->query(
			-sql => $sql_statement,
			-bind_cols => [\$uid]
		       );
    &$fetch;
    $db->finish();
    return 0 unless defined($uid);
    $self->fatal(-msg => 'The user name has already been registered.',
		 -input => $user_name,
		 -helpMsg => $self->{HHTML}->hit_back_and_edit());
}

sub add_new_user {
    #
    # Add a new user to database.
    #
    # Params:
    # (-user=>'user_name', password=>'user_password', email=>'user_email').
    #
    # Pre:
    # 1. None.
    #
    # Post:
    # 1. Sanitize `user_name'.  Print out an error msg and abort if fails.
    # 2. Print out an error msg and abort if user name is already registered.
    # 3. Sanitize email address; print out an error msg and abort if fails.
    # 4. Print out an error msg and abort if email is already registered.
    # 5. Add user to database.
    # 6. Notify admin by email that a user has been added if
    #    $self->{IS_NOTIFY_ADMIN_WHEN_ADDED_NEW_USER} is true.
    # 7. Return user_name upon success.
    #
    my ($self, $user_name, $password, $email, $sanitized_user_name, $crypt_pass, $db,
	$sql_statement, );
    $self = shift;
    ($user_name, $password, $email)
      = $self->rearrange(['USER', 'PASSWORD', 'EMAIL'], @_);
    require LibWeb::Database;
    $db = new LibWeb::Database();
    #========================= #1. ============================
    # Check to see if user name is valid.
    $sanitized_user_name = $self->sanitize( -text => $user_name,
					    -allow => ['_', '-'] );
    $self->fatal(-msg => 'User name cannot contain special characters.',
		 -input => $user_name,
		 -alertMsg => 'LibWeb::Admin::add_new_user()',
		 -helpMsg => $self->{HHTML}->special_characters_not_allowed())
      unless ($user_name eq $sanitized_user_name);
    # Since sanitize() doesn't replace normal spaces with empty token.
    $sanitized_user_name =~ s:\s+::g;

    #========================= #2. ============================
    $self->_is_user_name_registered($sanitized_user_name);

    #========================= #3. ============================
    # Check to see if email is in valid format.
    $email = $self->sanitize(-email => $email);

    #========================= #4. ============================
    # Check to see if email is already registered.
    $self->_is_user_email_registered($email)
      unless $self->{IS_ALLOW_MULTI_REGISTRATION};

    #========================= #5. ============================
    # Add user to database.
    $crypt_pass = LibWeb::Crypt->new()->encrypt_password($password);
    $sql_statement = "insert into $self->{USER_PROFILE_TABLE} " .
	             "set $self->{USER_PROFILE_TABLE_NAME} = '$user_name', " .
		     "$self->{USER_PROFILE_TABLE_PASS} = '$crypt_pass', " .
		     "$self->{USER_PROFILE_TABLE_EMAIL} = '$email'";
    $db->do( -sql => $sql_statement );
    $sql_statement = "insert into $self->{USER_LOG_TABLE} " .
	             "set $self->{USER_LOG_TABLE_NUM_LOGIN_ATTEMPT}=0";
    $db->do( -sql => $sql_statement );

    $db->finish();

    #========================= #6. ============================
    # Notify admin.
    $self->fatal(-alertMsg => "Added new user: $user_name password: $password from ".
		              "$ENV{REMOTE_ADDR} $ENV{REMOTE_HOST} at ".localtime(),
		 -isDisplay => 0)
      if $self->{IS_NOTIFY_ADMIN_WHEN_ADDED_NEW_USER};

    return $user_name;
}

1;
__END__

=pod

=head1 NAME

LibWeb::Admin - USER AUTHENTICATION FOR WEB APPLICATIONS

=head1 SUPPORTED PLATFORMS

=over 2

=item BSD, Linux, Solaris and Windows.

=back

=head1 REQUIRE

=over 2

=item *

LibWeb::CGI

=item *

LibWeb::Database

=back

=head1 ISA

=over 2

=item *

LibWeb::Session

=back

=head1 SYNOPSIS

    use LibWeb::Admin;
    my $a = LibWeb::Admin->new();
    $a->login( $user_name, $guess_password );
             ...
    my ( $user_name, $uid ) = $a->is_login();
             ...
    $a->logout();
             ...
    $a->is_logout();

=head1 ABSTRACT

This class manages user authentication for web applications written
based on the interfaces and frameworks defined in LibWeb, a Perl
library/toolkit for programming web applications.  It is
responsible for managing user login, logout and new sign-up.  Therefore
you may want to use this module in the login script for your site.

The current version of LibWeb::Admin.pm is available at

   http://libweb.sourceforge.net
   ftp://libweb.sourceforge/pub/libweb

Several LibWeb applications (LEAPs) have be written, released and
are available at

   http://leaps.sourceforge.net
   ftp://leaps.sourceforge.net/pub/leaps

=head1 TYPOGRAPHICAL CONVENTIONS AND TERMINOLOGY

Variables in all-caps (e.g. MAX_LOGIN_ATTEMPT_ALLOWED) are those variables
set through LibWeb's rc file.  Please read L<LibWeb::Core> for
more information.  `Sanitize' means escaping any illegal character
possibly entered by user in a HTML form.  This will make Perl's taint
mode happy and more importantly make your site more secure.
Definition for illegal characters is given in L<LibWeb::Core>.  All
`error/help messages' mentioned can be found at L<LibWeb::HTML::Error> and
they can be customized by ISA (making a sub-class of) LibWeb::HTML::Default.
Please see L<LibWeb::HTML::Default> for details.

=head1 DESCRIPTION

=head2 HANDLING USER LOGIN

Fetch the user name and password from a HTML form and pass them to
login():

  $a->login( $user_name, $guess );

If the password is correct and the user name exists in the
database, this will send an authentication cookie to the client web browser
and return 1; send an alert e-mail to the site administrator and print
out an error message and exit otherwise.

=head2 HANDLING USER SESSION AFTER LOGIN

At the top of every web application that requires user authentication,

  my ( $user_name, $uid ) = $a->is_login();

to retrieve user name and user ID from cookie.  This will send an alert
e-mail to the site administrator and redirect the user to a login page
if no authentication cookie is found or it has been tampered with.  I would
recommend you use LibWeb::Session instead which is specifically designed for
that purpose and therefore runs a little bit faster,

  use LibWeb::Session;
  my $a = new LibWeb::Session();
  my ( $user_name, $uid ) = $a->is_login();

LibWeb::Admin should be used by login scripts; whereas LibWeb::Session should
be used by any web applications once the user has logged in.  Read
L<LibWeb::Session> for details.

To update the database (set the login indicator to high) when the user is
first login,

  my ( $user_name, $uid ) = $a->is_login(1);

This is probably done in `my control panel' or `my page' of some
sorts which is the first script invoked after password authentication.


=head2 HANDLING USER LOGOUT

  $a->logout();

This will check to see if the user is logged in.  Send an alert e-mail
to the site administrator and print out an error message if the
remote user is not logged in or has no authentication cookie.
Otherwise, this will flush B<NUM_LOGIN_ATTEMPT> to 0 in database
(indicating that the user has logged out).  This will also send
de-authentication cookies to nullify all cookies on client web browser.
Return 1 upon success.

=head2 ADDING NEW USER TO DATABASE

  $a->add_new_user(
                   -user => 'user_name',
                   -password => 'password',
                   -email => 'user_email'
                  );

Print out an error message and abort if,

=over 2

=item *

`user_name' contains illegal characters other than `_' and `-' or

=item *

`user_name' is already registered or

=item *

`user_email' does not conform to the standard format defined in L<LibWeb::Core> or

=item *

`user_email' is already registered if B<IS_ALLOW_MULTI_REGISTRATION> is set to 0.

=back

If the parameters pass all the tests, this will encrypt the password, add that
with the user name to the database and notify the site administrator by e-mail if
B<IS_NOTIFY_ADMIN_WHEN_ADDED_NEW_USER> is set to 1.  Return the registered
user_name upon success.

=head1 AUTHORS

=over 2

=item Colin Kong (colin.kong@toronto.edu)

=back

=head1 CREDITS

=head1 BUGS

=head1 SEE ALSO


L<LibWeb::Core>, L<LibWeb::CGI>, L<LibWeb::Crypt>, L<LibWeb::Database>,
L<LibWeb::HTML::Default>, L<LibWeb::Session>, L<LibWeb::Themes::Default>.

=cut
