#!/usr/bin/perl 
#This is IP_AUTH_HACK authenticate_program mini demo
#$Revision: 1.7 $ <steffen@dett.de>

use strict;
use Fcntl;

# Debugging
my $DEBUG=2;
# Common configuration
# AUTH_SCHEMA only "ldap" is supported for now
my $AUTH_SCHEMA="ldap";

# Usually there's no need to edit beyond this point
$ENV{'PATH'}='/bin:/usr/bin';
my $IP_AUTH_LIB='/usr/lib/squid/squid_ip_auth/';
my $fifo_file = "/var/run/squid/ip_auth.fifo";
my $logfile = "/var/log/squid/ip_auth.log";
my $idle_time = 900;

my $auth_schema_file=$IP_AUTH_LIB."ip_auth-".$AUTH_SCHEMA.".inc.pl";

if (-r $auth_schema_file) {
	require $auth_schema_file;
} else {
	print "Check you AUTH_SCHEMA configuration!\n";
	die "Bad Auth Method - see AUTH_SCHEMA" ;
}

my %ips = ();
$0 =~ m|/([^/]+)$|;
my $basename = $1;   #Name

sub open_log()
{
	open (LOG, ">>$logfile") or die ("Error opening Logfile: [$!]\n");
	print LOG "Logfile opened.\n" if ($DEBUG);
	close (STDERR) or die ("Error closing STDERR [$!]\n");
	open (STDERR, $logfile) or die ("Error opening STDERR [$!]\n");
	print STDERR "Stderr redirected.\n" if ($DEBUG);
	#disable buffering:
	select (LOG);    $| = 1;
	select (STDERR); $| = 1;
	select (STDOUT); $| = 1;
}

sysopen(PIPE, $fifo_file, O_RDONLY | O_NONBLOCK) or die ("Error opening FIFO $fifo_file [$!]\n");

my $string;
my $empty_lines=0;

sub print_log(@)
{
	print LOG scalar(localtime(time()));
	print LOG " ", $basename, "[", $$, "]: ", @_, "\n";
}

sub get_auth_info() 
{
	print_log("get_authinfo") if ($DEBUG>1);
	my $char;
	my $string;
	my $bytes;
	while($bytes = sysread(PIPE, $char, 1)) {
		last if ($char eq "\n");
		$string = $string . $char;
	}
	print_log("get_authinfo: read: [$string]") if ($DEBUG);
	if ($bytes == 0) {
		print_log("PIPE closed.") if ($DEBUG>1);
		close(PIPE);
		sysopen(PIPE, $fifo_file, O_RDONLY | O_NONBLOCK);
		print_log("PIPE reincarnated.") if ($DEBUG>1);
	}
	return $string;
}

sub get_auth_request()
{
	my $char;
	my $string;
	while(my $bytes = sysread(STDIN, $char, 1)) {
		last if ($char eq "\n");
		$string = $string . $char;
	}
	return $string;
}

sub dispatch()
{
	my ($read, $exception, $stdin_v, $pipe_v) = ('',undef,'','');
	vec($stdin_v,fileno(STDIN),1) = 1;
	vec($pipe_v,fileno(PIPE),1) = 1;
	my $vector = $stdin_v | $pipe_v;
	print_log("Vec: req:", fileno(STDIN), " info: ", fileno(PIPE), " = ", ord($vector)) if ($DEBUG>2);
	$exception = $read = $vector;
	my $nfound;
#	while (($nfound = select($read, undef, $exception, 60)) == 0) {
	while (($nfound = select($read, undef, $exception, 300)) == 0) {
		$exception = $read = $vector; #same again....
		print_log("no data... waiting...") if ($DEBUG);
	}
	print_log("select: read=", ord($read), " exception=", ord($exception))
	if ($DEBUG>2);
	if ((ord($read) & ord($pipe_v)) == ord($pipe_v)) {
		print_log("Authinfo pending.") if ($DEBUG>2);
		return "info";
	}
	if ((ord($read) & ord($stdin_v)) == ord($stdin_v)) {
		print_log("Request pending.") if ($DEBUG>2);
		return "request";
	}
	print_log("Dispatcher: unknow event $nfound for ", ord($read), " ", ord($exception), " on select(2).") if ($DEBUG);
	sleep 1;
	return "unknown";
}

sub process_info()
{
	my $ip = get_auth_info();
	# format: (+|-)<IP-address> "+" means allow, "-" remove IP
	# i.e. logout:  "-192.168.1.1"
	if (defined $ip) {
		my $flag = substr($ip,0,1); #first char
		$ip = substr($ip,1);     #Rest
		if ( $flag eq "-" ) { #logout
			undef $ips {$ip};
			print_log("new auth info: removed: $ip") if ($DEBUG);
			return;
		} elsif ( $flag eq "+" ) { #login
			$ips {$ip} = time();
			print_log("new auth info: added: $ip") if ($DEBUG);
			return;
		} else { #yepp - - - what?!
			print_log("new auth info: ignored: $ip") if ($DEBUG);
			return;
		}
	} else {
		print_log("new auth info: empty") if ($DEBUG);
		return;
	}
}

sub verify_ip($)
{
	my $user = shift;
	if (defined ($ips{$user})) {
		my $age=time() - $ips{$user};
		my $age_str = sprintf("%.1f", $age/60);
		if ($age > $idle_time ) {
			print_log("IP_AUTH: login failed for $user (too old: ", $age_str, " min)");
			undef $ips{$user};
			print "ERR\n";
		} else {
			print_log("IP_AUTH: Succeeded for $user  (age: ", $age_str, " min)");
			$ips{$user} = time(); #current timestamp
			print "OK\n";
		}
	} else {
		print_log ("IP_AUTH: login FAILED for $user (unknown IP)");
		print "ERR\n";
	}
	return;
}


sub process_request()
{
	my $raw_line = get_auth_request();
	if ($raw_line =~ m/^\s*$/) {
		#skip empty lines
		$empty_lines++;
		if ($empty_lines > 100) {
			print_log("100 empty lines skipped!") if ($DEBUG);
			$empty_lines = 0;
		}
		print_log("skipping empty line") if ($DEBUG>2);
		select (undef, undef, undef, 0.25); #250 ms delay
		return;
	}
	print_log("Rawread: $raw_line") if ($DEBUG>1);
	my $line = $raw_line;
	my ($user, $pass) = ("", "");
	if (! ($line =~ m/^([^\s]+)\s+(.*)$/)) {
		print_log ("Parse error reading STDIO user/password pair!") if ($DEBUG);
		print "ERR\n";
		sleep 1;
		return;
	} else {
		$user = $1;
		$pass = $2;
	}
	print_log "User: $user, Pass: $pass " if ($DEBUG==2);
	if ($pass eq "IP_AUTH") {
		verify_ip($user);
		return;
	} else {
		if (verify_user($user, $pass)) {
			print_log "Access granted to $user";
			print "OK\n";
		} else {
			print_log "Access denied to $user";
			print "ERR\n";
		}
		return;
	}
}

###########
# Main
###################

sleep 2; #wait before doing anything else ...

open_log();
print_log("New instance starting endless loop.");

while ("true") { 
	my $event = dispatch();
	if ($event eq "info") {
		process_info();
		next;
	}
	if ($event eq "request") {
		process_request();
		next;
	}
	print_log("Error: unknown event by dispatcher");
}
