#!/usr/bin/perl -Tw -I. -I/usr/local/positive/Perl

use strict;
use Pos::defaults ();

package Pos::Webtop::Auth;

=head1 Auth object

Create this object to auth users via various authTypes

=head1 METHODS

=over 4

=item B<new>

Constructor, does the obvious.

=cut

our $authenticator = "UserAuthenticator";

sub new 
{
	my $this = shift;
	my $class = ref($this) || $this;
	my ($self,$db,$dbw) = @{{@_}}{qw/self dbReader dbWriter/};

	if ( not defined $self )
	{
		$self = {};
		bless($self,$class);
	}

	$self->{'dbr'} = $db;
	$self->{'dbw'} = $dbw;

	return $self;	
}

=item B<authenticate>

send in a userName, password, and authType ('STANDARD' for example).
Returns userId on success, undef on fail. (be ware of the 0 user it may be valid!)

=cut

# replaced with a version that calls to radius

sub authenticate
{
	my $self = shift;
	my ($userName,$password,$authType,$isExpired,$trialExpired, $challenge) = @{{@_}}{qw/userName password authType isExpired trialExpired challenge/};

	$authType = 'DEFAULT' unless defined $authType;
	
	if (uc($authType) eq 'DISABLED')
	{
		warn ref($self) . "::authenticate(): auth type was DISABLED";
		return undef;
	}
	
	my %authTypes = (
		'DEFAULT'  => 0,
		'DISABLED' => 1, 
		'STANDARD' => 2,
		'SECURID'  => 3,
		'NTLM'     => 4,
		'PhoneFactor - Standard'    => 6,
		'PhoneFactor - SecurID'		 => 7,
		'PhoneFactor - NTLM'        => 9,
	);

	# note that at the time of this writing, the radius server only understands
	# prefix 00 (automatic without cache checking) and 08 (automatic with cache checking)
	# it is a trivial change to turn on the other auth types but there is no reason to
	# do it at this time.  We will go ahead and send them here since it will not matter.

	my $rusername = sprintf( "\%02lu\%s", $authTypes{uc($authType)}, $userName );
	my $rpassword = $password;

	# get the radius information from the defaults lib
	
	my $port   = Pos::defaults::getPosRadiusPort();
	my $server = Pos::defaults::getPosRadiusServer();
	my $secret = Pos::defaults::getPosRadiusSecret();

	# We call the sheep wrapper util for authenticateRadiusAttribute to do the actual auth... this
	# program calls our radauth lib that I modified to watch for an attribute on response.  OUR radius server
	# will return the value "provision" in the reply message if this account needs to be provisioned.  If we
	# need to provision the account we then call the sheep utility provision.pl with the undecorated username
	# and use the result code of the provision.pl to determine if we auth the session.  The radius attribute
	# for Reply-Message is 18.

	# escape the baddies

	$rusername =~ s/(\W)/\\$1/g;
	$rpassword =~ s/(\W)/\\$1/g;
	$secret    =~ s/(\W)/\\$1/g;
	$server    =~ s/(\W)/\\$1/g;
	$port      =~ s/(\W)/\\$1/g;
	
	my $oldPath = $ENV{'PATH'};
	my $oldLd = $ENV{'LD_LIBRARY_PATH'};
	
	$ENV{'PATH'} = '/usr/local/bin:/usr/bin:/bin';
	$ENV{'LD_LIBRARY_PATH'} = "/usr/local/positive/Library";

	#if the timeout is too less then phonefactor auth's will fail. So i made it 60 seconds
	"/usr/local/positive/Binary/AuthenticateRadiusAttribute $rusername $rpassword $secret $server $port 60 18|" =~ /^(.*)$/;
	#warn " running $1\n";
	open(RAD,$1);

	my $response = <RAD>;
	# FIXME: when we support binary (not treated as single line string) attributes like integers and octet streams, we
	# will need to change how we read the value from the stdout of the helper binary -- right now we are doing a simple line read.
	my $attributeValue = <RAD>;
	close(RAD);

	$response = "" unless defined $response;
	$attributeValue = "" unless defined $attributeValue;
	chomp $response;
	chomp $attributeValue;

	my $doAuth = 0;

	if ( $response eq 'GOOD' )
	{
		# Even if GOOD was returned, check to see if the attribute value is set to expired
		if ($attributeValue eq 'expired')
		{
			warn ref($self) . "::authenticate(): user $userName has an expired password.";

			if (defined($isExpired))
			{
				$$isExpired = 1;
			}
		}

		$doAuth = 1;
	}
	else
	{
		# the user may belong to a company with an expired trial.. check the 8 ball
		if ( $attributeValue eq 'trialExpired' )
		{
			warn ref($self) . "::authenticate(): user $userName is in a company with an expired trial.";

			if (defined($trialExpired))
			{
				$$trialExpired = 1;
			}
		}
		#
		# we got a access-challenge back from radius
		#
		elsif ( $attributeValue eq 'challenge' )
		{
			warn ref($self) . "::authenticate(): got access-challenge from AuthenticateRadiusAttribute";

			if (defined($challenge))
			{
				$$challenge = 1;
			}
		}
		# if it failed, we need to see if it was because provision changes need to happen...
		elsif ( $attributeValue eq 'provision' )
		{
			# call the provisioner 

			my $cusername = $userName;
			$cusername =~ s/(\W)/\\$1/g;
			"/usr/local/positive/Binary/provision.pl $cusername" =~ /^(.*)$/;
			system($1);

			my $exitValue = $? >> 8;

			if ( $exitValue == 0 )
			{
				# provisioner worked
				$doAuth = 1;
			}
			else
			{
				warn ref($self) . "::authenticate(): our radius server told us to provision the user, but provisioning failed.";
			}
		}
	}
	
	# reset env
	$ENV{'PATH'} = $oldPath;
	defined($oldLd) and $ENV{'LD_LIBRARY_PATH'} = $oldLd;
	
	if ( not $doAuth )
	{
		return undef;
	}

	my $db = $self->{'dbr'}; # reader!
	# FIXME: if we ever move to a slave / master setup with replication, it may take longer for the 
	# replication to get to our reader server for a newly provisioned user than it takes to run the polyps...
	# we could potentially have a race condition where the provision is completed but the userid
	# is not found in the following query. 
	my ($userId) = $db->query( sql=> "select user_id from users where user_name_key = upper('" . $db->escape( dirty=> $userName ) . "')" );

	return $userId;
}

#sub authenticate
#{
#	my $self = shift;
#	my ($userName,$password,$authType) = @{{@_}}{qw/userName password authType/};
#
#	foreach (
#		[$userName,'userName'],
#		[$password,'password'],
#		[$authType,'authType']
#	)
#	{
#		my ($val,$name) = @{ $_ };
#		
#		if ( not defined $val )
#		{
#			warn ref($self) . "::authenticate(): $name was not defined, returning undef";
#			return undef;
#		}
#	}
#
#	my $db = $self->{'dbr'};
#	my $dbw = $self->{'dbw'};
#
#	my ($userId) = $db->query( sql=> "
#		select user_id from users where user_name = '" . $db->oracle_escape( dirty=> $userName ) . "'
#	");
#
#	if ( not defined $userId ) 
#	{
#		warn ref($self) . "::authenticate(): userName was not found in db, returning undef";
#		return undef;
#	}
#
#	my ($isActive) = $db->query( sql=> " select is_active from users where user_id = $userId ");
#
#	if ( !$isActive )
#	{
#		warn ref($self) . "::authenticate(): user $userName is not marked as active, returning undef";
#		$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#		return undef;
#	}
#	
#	if ( uc($authType) eq 'STANDARD' )
#	{
#		# make sure they can use this auth method
#		my ($test) = $db->query( sql=> "
#			select 
#				user_id
#			from 
#				user_auth_types uat,
#				auth_types at
#			where 
#				at.auth_type_id = uat.auth_type_id
#				and user_id = $userId
#				and upper(auth_type_name) = 'STANDARD'
#		");
#
#		if ( not defined $test )
#		{
#			warn ref($self) . "::authenticate(): user is not allowed to use STANDARD auth type, returning undef";
#			$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#			return undef;
#		}
#
#		my $md5 = Digest::MD5->new();
#		$md5->add( $password );
#		my $passwordHash = uc($md5->hexdigest());
#
#		my @si = $db->query( sql=> "
#			select user_id from users
#			where 
#				user_id = $userId
#				and upper(password) = '$passwordHash'
#		");
#		
#		if ( @si )
#		{
#			return $userId;
#		}
#		else
#		{
#			$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#			return undef;
#		}
#	}
#	elsif ( uc($authType) eq 'SECURID' )
#	{
#		# radius
#		# make sure they can use this auth method
#		my ($test) = $db->query( sql=> "
#			select 
#				user_id
#			from 
#				user_auth_types uat,
#				auth_types at
#			where 
#				at.auth_type_id = uat.auth_type_id
#				and user_id = $userId
#				and upper(auth_type_name) = 'SECURID'
#		");
#
#		if ( not defined $test )
#		{
#			warn ref($self) . "::authenticate(): user is not allowed to use SECURID auth type, returning undef";
#			$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#			return undef;
#		}
#
#		my $cleanPassword = $password;
#		$cleanPassword =~ y/\n\r//d; # good by new lines
#		$cleanPassword =~ s/(\W)/\\$1/g; # good by shell chars
#
#		# find the goods we need to run the radauth
#
#		my @radaTatTatYo = $db->query( sql=> "
#			select 
#				securid_username,
#				rawip32_to_dotted_quad(securid_server_ip_address),
#				securid_server_shared_secret,
#				securid_server_port
#			from 
#				securid_servers s,
#				user_securid_settings us
#			where
#				s.securid_server_id = us.securid_server_id
#				and user_id = $userId
#		");
#
#		if ( not @radaTatTatYo ) 
#		{
#			warn ref($self) . "::authenticate(): SECURID auth works best with a radius server (I couldn't find one!), returning undef";
#			$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#			return undef;
#		}
#
#		my ($sname,$server,$secret,$port) = @{ $radaTatTatYo[0] };
#
#		my $cleanName = $sname;
#		$cleanName =~ y/\n\r//d; # good by new lines
#		$cleanName =~ s/(\W)/\\$1/g; # good by shell chars
#
#		my $cleanServer = $server;
#		$cleanServer =~ y/\n\r//d; # good by new lines
#		$cleanServer =~ s/(\W)/\\$1/g; # good by shell chars
#
#		my $cleanSecret = $secret;
#		$cleanSecret =~ y/\n\r//d; # good by new lines
#		$cleanSecret =~ s/(\W)/\\$1/g; # good by shell chars
#
#		my $cleanPort = $port;
#		$cleanPort =~ y/\n\r//d; # good by new lines
#		$cleanPort =~ s/(\W)/\\$1/g; # good by shell chars
#
#		my $cmd = "radauth -t 30 -u $cleanName -p $cleanPassword -s $cleanSecret -r $cleanServer -c $cleanPort";
#
#		# I KNOW that the $cmd is safe.. but perl -T is really paranoid.. so we just satisfy it with a regex
#		$cmd =~ /^(.*)$/;
#		$cmd = $1;
#		warn $cmd;
#		if ( not ( length($cleanName) and length($cleanPassword) and length($cleanSecret) and length($cleanServer) and length($cleanPort) ) )
#		{
#			warn ref($self) . "::authenticate(): a parameter is empty... here's what I would have ran: \"$cmd\", returning undef";
#			$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#			return undef;
#		}
#
#		my $output = "";
#		my $granted = 0;
#		my $denied = 0;
#
#		$ENV{'PATH'} = "/usr/bin:/usr/local/bin";
#		
#		open(RADAUTH," $cmd 2>&1 |");
#		
#
#		foreach my $line ( <RADAUTH> )
#		{
#			$output .= $line;
#			$output =~ /GRANTED/ and $granted = 1;
#			$output =~ /DENIED/ and $denied = 1;
#		}
#
#		if ( $granted ) 
#		{
#			return $userId;
#		}
#		
#		if ( not $denied )
#		{
#			# this is for debugging... we didn't get a granted... OR a denied.. lets log
#			# the output so we can figure what in the jolly green giant is going on here.
#
#			warn ref($self) . "::authenticate(): radauth output was odd, returning undef: \n$output\n";
#			$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#			return undef;
#		}
#
#		return undef;
#
#	}
#	elsif ( uc($authType) eq 'NTLM') 
#	{
#		my $cleanName = $userName;
#		$cleanName =~ y/\n\r//d; # good by new lines
#		$cleanName =~ s/(\W)/\\$1/g; # good by shell chars
#
#		my $cleanPassword = $password;
#		$cleanPassword =~ y/\n\r//d; # good by new lines
#		$cleanPassword =~ s/(\W)/\\$1/g; # good by shell chars
#
#		$ENV{'LD_LIBRARY_PATH'} = '/usr/local/positive/Library';
#		$ENV{'PATH'} = '/usr/local/positive/Binary';
#
#		my $cmd     = $authenticator . " -u $cleanName -p $cleanPassword";
#		my $success = 0;
#
#		$cmd =~ /^(.*)$/;
#		$cmd = $1;
#
#		open(AUTH," $cmd 2>&1 |");
#
#		foreach my $line (<AUTH>) 
#		{
#			chomp($line);
#
#			if ($line eq 'GRANTED')
#			{
#				$success = 1;
#			}
#			
#			last;
#		}
#
#		if ($success)
#		{
#			return $userId;
#		}
#
#		return undef;
#	}
#	elsif ( uc($authType) eq 'DISABLED' )
#	{
#		warn ref($self) . "::authenticate(): authType DISABLED makes auto deny... returning undef";
#		$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#		return undef;
#	}
#	else
#	{
#		warn ref($self) . "::authenticate(): authType not found, returning undef";
#		$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#		return undef;
#	}
#	
#	warn ref($self) . "::authenticate(): we got to end of authenticate function... this is BAD BAD BAD";
#	$dbw->do( sql=> "insert into user_failed_auth_attempts (user_id,attempt_date) values ($userId,sysdate)" );
#	return undef; # we should never get here;
#}

=back

=cut

1;