package Apache::CachedLogin;
# file: Apache/CachedLogin.pm 
use strict;
use Apache2::RequestRec();
use Apache2::Const qw(:common);
use Apache2::Log();
use Apache2::Connection;
use IPC::Shareable();
use Digest::SHA1  qw(sha1_base64);
use vars qw(%legalIPs);

# handler for access
sub handler {
	my $r = shift;
	my $ret = FORBIDDEN;
	
	my $ip = $r->connection->remote_ip;

	# get a list of always allowed IPs from the apache conf
	my @allowedIPs = split(/,/,$r->dir_config("allowedIPs"));
	foreach (@allowedIPs) {
		if ($ip =~ /$_/) {
			# $r->log_error($r->uri, ": $ip is white-listed");
			return OK;
		}
	}

	
	# $r->log_error($r->uri, ": remote ip: $ip");

	tie %legalIPs, 'IPC::Shareable', 'SPLM', {create => 1, mode => 0644} unless defined %legalIPs;
	
	tied(%legalIPs)->shlock;
	# $r->log_error($r->uri, ": time:".$legalIPs{$ip});
	if (defined $legalIPs{$ip} && (time() - $legalIPs{$ip} < 7200)) {
		# 7200 are 2 hours
		# the user has logged in or used the system from this ip in the last two hours
		$ret = OK;
		$legalIPs{$ip} = time();
		# $r->log_error($r->uri, ": legal connection");
	} else {
		delete $legalIPs{$ip} if (defined $legalIPs{$ip});	
		# now we need the user to authenticate
		$r->push_handlers(PerlAuthenHandler => \&authenticate);
	}

	tied(%legalIPs)->shunlock;
	return $ret;
}

# handler for authentication
sub authenticate {
	my $r = shift;
	
	# $r->log_error($r->uri, ": authenticate called");

	my($res, $sent_pw) = $r->get_basic_auth_pw;
	return $res if $res != OK; 

	my $user = $r->user;
	# get the configfile to use from apache conf
	my $htpwdfile = $r->dir_config("AuthUserFile");
	
	# $r->log_error($r->uri, ": auth with $user : $sent_pw");
	unless(checkUser($user, $sent_pw, $htpwdfile)) {
		$r->note_basic_auth_failure;
		return AUTH_REQUIRED;
	}
	
	tie %legalIPs, 'IPC::Shareable', 'SPLM', {create => 1, mode => 0644} unless defined %legalIPs;
	
	tied(%legalIPs)->shlock;
	my $ip = $r->connection->remote_ip;
	
	# the user made it so unlock his IP
	$legalIPs{$ip} = time();

	tied(%legalIPs)->shunlock;

	return OK;   
}

sub checkUser {
	my $user = $_[0];
	my $digest = sha1_base64($_[1])."=";
	my $htpwdfile = $_[2];
	open(R,"<$htpwdfile");
	while(my $line = <R>) {
		chomp($line);
		my ($puser, $phash) = split(/\:\{SHA\}/, $line);
		return 1 if ($puser eq $user && $phash eq $digest);
	}
	return 0;
}

1;
__END__