###########################################################
# CGI::Session::Auth
# Authenticated sessions for CGI scripts
###########################################################
#
# $Id: Auth.pm 28 2007-09-02 12:49:06Z geewiz $
#

package CGI::Session::Auth;
use base qw(Exporter);
use lib( '/www/perl_modules');

use 5.008;
use strict;
use warnings;
use Carp;
use Digest::MD5 qw( md5_hex );
use ActiveDirectory;


our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);

our $VERSION = do { q$Revision: 28 $ =~ /Revision: (\d+)/; sprintf "1.%03d", $1; };

###########################################################
###
### general methods
###
###########################################################

###########################################################

sub new {
    
    ##
    ## class constructor
    ## see POD below
    ##
    
    my $class = shift;
    my ($params) = @_;
    
    $class = ref($class) if ref($class);
    # check required params
    my %classParams = (
        Session => ['CGI::Session'],
        CGI => ['CGI', 'CGI::Simple'],
    );
    foreach my $classParam (keys %classParams) {
        croak "Missing $classParam parameter" unless exists $params->{$classParam};
        croak "$classParam parameter is not a " . join(' or ', @{$classParams{$classParam}}) . " object"
           unless grep { $params->{$classParam}->isa($_) } @{$classParams{$classParam}};
    }
    
    my $self = {
    	
    	#
    	# general parameters
    	#
    	
        # parameter "Session": CGI::Session object
        session => $params->{Session},
        # parameter "CGI": CGI object
        cgi => $params->{CGI},
        # parameter "LoginVarPrefix": prefix of login form variables (default: 'log_')
        lvprefix => $params->{LoginVarPrefix} || 'log_',
        # parameter "IPAuth": enable IP address based authentication (default: 0)
        ipauth => $params->{IPAuth} || 0,
        # parameter "Log": enable logging (default: 0)
        log => $params->{Log} || 0,

		#
		# class members
		#
				        
        # the current URL
        url => $params->{CGI}->url,
        # logged-in status
        logged_in => 0,
        # user id
        userid => '',
        # user profile data
        profile => {},
        # Log::Log4perl logger, see "log" above
		logger => undef,
    };
    
    bless $self, $class;
    
    if ( $self->{log}) {
    	require Log::Log4perl;
		$self->{logger} = Log::Log4perl->get_logger($class);
		$self->_debug("logging enabled");
    }

    return $self;
}

###########################################################

sub authenticate {

	##
    ## authenticate current visitor
	##
	
    my $self = shift;
    
    # is this already a session by an authorized user?
    if ( $self->_session->param("~logged-in") ) {
        $self->_debug("User is already logged in in this session");
        # set flag
        $self->_loggedIn(1);
        # load user profile
        my $userid = $self->_session->param('~userid');
        $self->_loadProfile($userid);
        return 1;
    }
    else {
        $self->_debug("User is not logged in in this session");
        # reset flag
        $self->_loggedIn(0);
    }
    
    # maybe someone's trying to log in?
    my $lg_name = $self->_cgi->param( $self->{lvprefix} . "username" );
    my $lg_pass = $self->_cgi->param( $self->{lvprefix} . "password" );
    
    if ($lg_name && $lg_pass) {
        # Yes! Login data coming in.
        $self->_debug("User trying to log in");
        if ($self->_login( $lg_name, $lg_pass )) {
            $self->_debug("login successful, userid: ", $self->{userid});
            $self->_loggedIn(1);
            $self->_session->param("~userid", $self->{userid});
            $self->_session->clear(["~login-trials"]);
            return 1;
        }
        else {
            # the login seems to have failed :-(
            $self->_debug("Login failed");
            my $trials = $self->_session->param("~login-trials") || 0;
            return $self->_session->param("~login-trials", ++$trials);
        }
    }
    
    # or maybe we can authenticate the visitor by his IP address?
    if ($self->{ipauth}) {
        # we may check the IP
        if ($self->_ipAuth()) {
            $self->_debug("IP authentication successful, userid: ", $self->{userid});
            $self->_loggedIn(1);
            $self->_session->param("~userid", $self->{userid});
            $self->_session->clear(["~login-trials"]);
            return 1;
        }
    }
    
}

###########################################################

sub sessionCookie {
    
    ##
    ## make cookie with session id
    ##
    
    my $self = shift;
    
    my $cookie = $self->_cgi->cookie($self->_session->name() => $self->_session->id );
    return $cookie;
}

###########################################################

sub loggedIn {
    
    ##
    ## get internal logged-in flag
    ##
    
    my $self = shift;
    
    return $self->_loggedIn;
}

###########################################################

sub profile {
    
    ##
    ## accessor to user profile fields
    ##
    
    my $self = shift;
    my $key = shift;
    
    if (@_) {
        my $value = shift;
        $self->{profile}{$key} = $value;
        $self->_debug("set profile field '$key' to '$value'");
    }
    
    return $self->{profile}{$key};
}

###########################################################

sub hasUsername {
    
    ##
    ## check for given user name
    ##
    
    my $self = shift;
    my ($username) = @_;
    
    return ($self->{profile}{username} eq $username);
}

###########################################################

sub logout {
    
    ##
    ## revoke users logged-in status
    ##
    
    my $self = shift;
    
    $self->_loggedIn(0);
    $self->_info("User '", $self->{profile}{username}, "' logged out");
}

###########################################################

sub uniqueUserID {
    
    ##
    ## generate a unique 32-character user ID
    ##
    
    my ($username) = @_;
    
    return md5_hex(localtime, $username);
}

###########################################################
###
### backend specific methods
###
###########################################################

###########################################################

##</code><code>##

sub _login {
    
    ##
    ## check login credentials and load user profile
    ##
    
    my $self = shift;
    my ($username, $password) = @_;
    
    # allow only the guest user, for real applications use a subclass
#    if ( ($username eq 'guest') && ( $password eq 'guest' ) ) {
#        $self->_info("User '$username' logged in");
#        $self->{userid} = "guest";
#        $self->_loadProfile($self->{userid});
#        return 1;
#    }

	 #  load my Active Directory object
	 my $ad_handle = com::corp::ActiveDirectory->new('WIN');	

	 if ( $ad_handle->login($username,$password) ) {

        $self->_info("User '$username' logged in");
        $self->{userid} = "guest";

		#  send user info via ->getUserInfo hash_ref
		$self->_loadProfile($self->{userid}, $ad_handle->getUserInfo);

		return 1;
	 }

  
    return 0;
}

###########################################################

##</code><code>##

sub _ipAuth {
    
    ##
    ## authenticate by the visitors IP address
    ##
    
    return 0;
}

###########################################################

sub _loadProfile {
    
    ##
    ## load the user profile for a given user id
    ##
    
    my $self = shift;
    my ($userid, $user_info) = @_;
    
    # store some dummy values
    $self->{userid} = $userid;
    $self->{profile}{username} = 'guest';
	$self->{profile}{user_info} = $user_info;

}

###########################################################

sub saveProfile {

    ##
    ## save probably modified user profile
    ##

}

###########################################################

sub isGroupMember {
    
    ##
    ## check if user is in given group
    ##
    
    # abstract class w/o group functions, for real applications use a subclass
    return 0;
}

###########################################################
###
### internal methods
###
###########################################################

###########################################################

sub _debug {
	
	##
	## log debug message
	##
	
	my $self = shift;
	
	$self->{logger}->debug(@_) if $self->{logger};
}

###########################################################

sub _info {
	
	##
	## log info message
	##
	
	my $self = shift;
	
	$self->{logger}->info(@_) if $self->{logger};
}

###########################################################

sub _session {
    
    ##
    ## get reference on CGI::Session object
    ##
    
    my $self = shift;
    
    return $self->{session};
}

###########################################################

sub _cgi {
    
    ##
    ## get reference on CGI object
    ##
    
    my $self = shift;
    
    return $self->{cgi};
}

###########################################################

sub _encpw {

    ##
    ## encrypt password
    ##
    
    my ($self, $password) = @_;

    return md5_hex($password);
}

###########################################################

sub _loggedIn {
    
    ##
    ## accessor to internal logged-in flag and session parameter
    ##
    
    my $self = shift;
    
    if (@_) {
        # set internal flag
        if ($self->{logged_in} = shift) {
            # set session parameter
            $self->_session->param("~logged-in", 1);
        }
        else {
            # clear session parameter
            $self->_session->clear(["~logged-in"]);
        }
        $self->_debug("(re)set logged_in: ", $self->{logged_in});
    }
    
    # return internal flag
    return $self->{logged_in};
}

###########################################################

sub _url {
    
    my $self = shift;
    
    return $self->{url};
}

##</code><code>##

#!/usr/bin/perl -w

package testapp;
use base qw( CGI::Application );

use strict;
use CGI;
use CGI::Session;
use CGI::Session::Auth;
use CGI::Carp;
use Data::Dumper::HTML qw(dumper_html);


sub setup {
	my $self = shift;
	
	$self->start_mode('free');
	$self->mode_param('cmd');
	$self->run_modes(
    	'free' => 'showFreePage',
    	'secret' => 'showSecretPage',
    	'logout' => 'showLogoutPage',
	);

	# new session object
	my $session = new CGI::Session(undef, $self->query, {Directory=>'/tmp'});
	$self->param('_session' => $session);
	
	# new authentication object
	my $auth = new CGI::Session::Auth({
		CGI => $self->query,
		Session => $session
	});
	$self->param('_auth' => $auth);
	$auth->authenticate();
	
	# send session cookie	
	$self->header_props( -cookie => $auth->sessionCookie() );
}

sub _auth {
	my $self = shift;
	
	return $self->param('_auth');
}

sub showFreePage {
	my $self = shift;

	return <<HTML;
<html>
<head><title>Free page</title></head>
<body>
<h1>Free accessible page</h1>
<p><a href="testapp.pl?cmd=secret">Secret page</a></p>
</body>
</html>
HTML
}

sub showSecretPage {
	my $self = shift;

	if (! $self->_auth->loggedIn) {
		$self->showLoginPage;
	}
	else {
		$self->showSecretData;
	}
}

sub showLoginPage {
	my $self = shift;

	
	return <<HTML;
<html>
<head><title>Not logged in</title></head>
<body>
<h1>You are not logged in</h1>
<p>Please log in to see the secret page:</p>
<form action="testapp.pl" method="POST">
<input type="hidden" name="cmd" value="secret">
<p><input type="text" size="30" name="log_username" value="username"></p>
<p><input type="text" size="30" name="log_password" value="password"></p>
<p><input type="submit"></p>
</form>
</body>
</html>
HTML
}

sub showSecretData {
	my $self = shift;

my $var = dumper_html($self->_auth);
	
	return <<HTML;
<html>
<head><title>Secret page</title></head>
<body>
<h1>Secret data</h1>
<p>$var</p>
<p>There's more than one way to do it!</p>
<p><a href="testapp.pl?cmd=logout">Log out</a></p>
</body>
</html>
HTML
}

sub showLogoutPage {
	my $self = shift;
	
	$self->_auth->logout();
	
	return <<HTML;
<html>
<head><title>Logged out</title></head>
<body>
<h1>You have logged out.</h1>
<p><a href="testapp.pl?cmd=secret">Secret page</a></p>
</body>
</html>
HTML
}

1;

package main;

my $app = new testapp;
$app->run();