###########################################################
# 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
###
###########################################################

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