#!/usr/bin/perl
#
# arpdetect
#
# detects networks based on arp replies
#

use strict;
use POSIX qw(strftime);
use Getopt::Long qw(:config no_ignore_case bundling);
use XML::Simple;
use Proc::Daemon;
use Net::Netmask;


##### FORWARD DECLAIRATIONS #####
sub Usage();
sub NowDate();
sub Stop();
sub UpdateName($);
sub UpdatePid(%);
sub UpdateLastNetwork(%);
sub ReadConfig(%);
sub LogIt($);
sub Debug($$);
sub NetworkCheck();
sub PerformActions($);
sub ArpPing($);
sub GetInetInterface(%);



##### VARIABLES #####
my $progname = "arpdetect";
my $version = "0.8cvs";
my $debug = 0;
my $fork = 1;
my $configfile = "arpdetect.xml";
my $config;
my $currentnetwork;
my $currentnetworktime;
my $getopt_result;
my $needhelp = 0;



##### MAIN #####

## handle variables
$getopt_result = GetOptions(
	"h|?|help" => \$needhelp,
	"d|debug+" => \$debug,
	"c|config=s" => \$configfile,
	"nofork" => sub { $fork = 0; },
);

Usage() if (!$getopt_result || $needhelp);

# read in config (don't log that we're doing it)
ReadConfig(logit => 0);

LogIt("Main: Starting $progname");

# fork, if they want us to
Proc::Daemon::Init if ($fork);

# signals
$SIG{HUP} = sub { Debug(1, "Received SIGHUP: $!"); ReadConfig(logit => 1); };
$SIG{INT} = sub { Debug(1, "Recieved SIGINT: $!"); Stop(); };
$SIG{TERM} = sub { Debug(1, "Recieved SIGTERM: $!"); Stop(); };
$SIG{KILL} = sub { Debug(1, "Recieved SIGKILL: $!"); Stop(); };

# update our pid
UpdatePid(action => "create");

# update our name
UpdateName("idle");

# get our last network
UpdateLastNetwork(action => "read");

# main loop; wait and check for network change
# and perform actions if there are any
while(1) { NetworkCheck(); sleep($config->{checktime});}

# if we get here, something wierd happend
Debug(1, "Main: how did I get here?");
Stop();



##### SUBROUTINES #####

# Usage
#   output our purpose and exit
sub Usage()
{
	print <<END;
== $progname v$version ==

$progname [-h|-?|--help] [-c|--config CONFIGFILE] [--nofork]
  detects changes in networks and performs
  actions needed when that happens

END

	exit(1);
} # end Usage();


# NowDate()
#   whatever the current datetime is
sub NowDate()
{
	return strftime("%Y.%m.%d %H:%M:%S", localtime);
} # end NowDate();


# Stop();
#   do anything necessary to end nicely
sub Stop()
{
	LogIt("Stop: stopping");
	
	# cache our last known network
	UpdateLastNetwork(action => "write");
	# delete our pidfile since we're dying
	UpdatePid(action => "delete");
	
	exit(0);
	
} # end Stop();


# UpdateName($)
#   updates our command name with our new state
sub UpdateName($)
{
	my $state = shift(@_);
	my $commandname = $progname;
	
	$commandname .= " [$state]" if (defined($state));
	
	Debug(1, "UpdateName: to '$commandname'");
	
	$0 = $commandname;
} # end UpdateName();


# UpdatePid(%)
#   either create or delete a pidfile
sub UpdatePid(%)
{
	my %arg = @_;
	
	Debug(1, "UpdatePid: called");
	if (defined($arg{action}))
	{
		Debug(2, "UpdatePid: Action is '$arg{action}'");
		if ($arg{action} eq "create")
		{
			Debug(2, "UpdatePid: creating pidfile");
			open (PIDFILE, ">$config->{pidfile}");
			print PIDFILE $$;
			close (PIDFILE);
		} # end if we need to create a pidfile
		
		if ($arg{action} eq "delete")
		{
			Debug(2, "UpdatePid: deleting pidfile");
			unlink $config->{pidfile};
		} # end if we need to delete a pidfile
	} # end we can't do anything if we're not told anything
} # end UpdatePid();


# UpdateLastNetwork(%)
#   either gets or updates our last network
sub UpdateLastNetwork(%)
{
	my %arg = @_;
	
	Debug(1, "UpdateLastNetwork: called");
	
	if (defined($arg{action}))
	{
		Debug(2, "UpdateLastNetwork: action is '$arg{action}'");
		if ($arg{action} eq "read")
		{
			Debug(2, "UpdateLastNetwork: trying to read in last status from '$config->{lastnetfile}'");
			if ( -e $config->{lastnetfile} )
			{
				Debug(2, "UpdateLastNetwork: reading file");
				open (LASTNETFILE, $config->{lastnetfile});
				my $line = <LASTNETFILE>;
				close (LASTNETFILE);
				
				($currentnetwork, $currentnetworktime) = split(/ /, $line);
				Debug(2, "UpdateLastNetwork: last on '$currentnetwork' at '$currentnetworktime'");
			} # end if file exists
		} # end if action is to read the file
		
		if ($arg{action} eq "write")
		{
			if (open (LASTNETFILE, ">$config->{lastnetfile}"))
			{
				Debug(2, "UpdateLastNetwork: writing to file");
				print LASTNETFILE "$currentnetwork $currentnetworktime";
				close (LASTNETFILE);
			}
			else
			{
				LogIt("UpdateLastNetwork: couldn't write to file '$config->{lastnetfile}': $!");
			} # end if writing to last network
		} # end if action is to write the file
		
	} # end if action is defined
} # end UpdateLastNetwork();


# ReadConfig(%)
#   read config and parse it for new stuff
sub ReadConfig(%)
{
	my %arg = @_;
	my $localconfig;
	
	if (defined($arg{logit}) && $arg{logit})
	{
		LogIt("ReadConfig: reading in config file '$configfile'");
	} # end if we are supposed to log about this
	else
	{
		Debug(1, "ReadConfig: reading in config file '$configfile");
	} # end else log it anyway if debug
	
	unless (-e $configfile) {
		LogIt("ReadConfig: ERROR: couldn't find file '$configfile'");
		Stop();
	} # end if no config file
	$localconfig = XMLin($configfile, forcearray => [ "network", "action" ]);
	
	#TODO verify config
	$config = $localconfig;
} # end ReadConfig();


# LogIt($)
#   log whatever's passed
sub LogIt($)
{
	my $logline = shift(@_);
	
	if (defined($config->{logfile})) {
		open(LOG, ">>$config->{logfile}");
		print(LOG NowDate() ." $progname\[$$\] = $logline\n");
		close(LOG);
		
	} else {
		print(STDERR NowDate() ." $progname\[$$\] = $logline\n");
		
	} # print to a log or STDERR
} # end LogIt();


# Debug($$)
#   debug output if its valid
sub Debug($$)
{
	my $debuglevel = shift(@_);
	my $logline = shift(@_);
	
	if ($debuglevel <= $debug) {
		if (defined($config->{logfile})) {
			open(LOG, ">>$config->{logfile}");
			print(LOG NowDate() ." $progname\[$$\] = DEBUG$debuglevel = $logline\n");
			close(LOG);
			
		} else {
			print(STDERR NowDate() ." $progname\[$$\] = DEBUG$debuglevel = $logline\n");
			
		} # end print to log or STDERR
	} # end if we're supposed to log
} # end Debug();


# NetworkCheck()
#   checks to see what network we're on
sub NetworkCheck()
{
	my $networkfound = 0;
	
	Debug(1, "NetworkCheck: checking known networks");
	UpdateName("checking");
	
	foreach my $network (keys(%{$config->{network}}))
	{
		next if ($network eq "unknown");
		
		Debug(2, "NetworkCheck: checking network '$network'");
		my $arpreturn = ArpPing($config->{network}->{$network}->{ip});
		
		# end if we got a 0 return, we're not in the network
		if ($arpreturn eq 0)
		{
			Debug(2, "NetworkCheck: no host at '$config->{network}->{$network}->{ip}'");
		} # end if no host
		
		# if a host responded, but w/ wrong hwaddress
		elsif ($arpreturn !~ /$config->{network}->{$network}->{hwaddress}/i)
		{
			Debug(2, "NetworkCheck: wrong host at '$config->{network}->{$network}->{ip}' ($arpreturn)");
		} # end if wrong mac addr
		
		# if mac is correct
		elsif ($arpreturn =~ /$config->{network}->{$network}->{hwaddress}/i)
		{
			Debug(2, "NetworkCheck: we're on '$network'");
			
			# if we're on a new network
			if ($network ne $currentnetwork)
			{
				LogIt("NetworkCheck: '$network' differs from last network '$currentnetwork'");
				# assign our current network and time
				$currentnetwork = $network;
				$currentnetworktime = time();
				
				# do action
				PerformActions("unknown");
				PerformActions($network);
			} # end if new network
			
			# if we've been on the same network too long
			elsif ($network eq $currentnetwork && 
				time() - $currentnetworktime >= $config->{network}->{$network}->{reaction})
			{
				LogIt("NetworkCheck: we've been on '$network' for more than reaction '$config->{network}->{$network}->{reaction}' seconds");
				# assign our current network and time
				$currentnetworktime = time();
				
				# do action
				PerformActions($network);
			} # end if network changes
			
			$networkfound = 1;
			last;
		} # end if good mac
		
	} # end foreach array
	
	if (!$networkfound && $currentnetwork ne "unknown")
	{
		LogIt("NetworkChange: no network found");
		$currentnetwork = "unknown";
		$currentnetworktime = time();
		
		# do action
		PerformActions($currentnetwork);
	} # end if no network was found
	
	UpdateName("idle");
} # end NetworkCheck();


# PerformActions($)
#   do actions associated with a network
sub PerformActions($)
{
	my $network = shift(@_);
	
	# do actions
	foreach my $command (@{$config->{network}->{$network}->{action}})
	{
		Debug(2, "PerformActions: performing action '$command'");
		my $actionoutput = `$command`;
		my $actionresult = ($?/256);
		Debug(2, "PerformActions: action result: $actionresult;");
		Debug(3, "PerformActions: action output:\n$actionoutput");
	} # end if perform command
} # end PerformActions();


# ArpPing($)
#   This simulates the Net::Arping perl module
#   which is difficult to compile
sub ArpPing($)
{
	my $desthost = shift(@_);
	
	Debug(1, "ArpPing: pinging '$desthost'");
	
	my $iface = GetInetInterface(ip => $desthost);
	
	if (defined($iface))
	{
		Debug(1, "ArpPing: on iface '$iface'");
		
		my $output = `$config->{arping} -I $iface $desthost`;
		my $returnval = ($?/256);
		
		Debug(3, "ArpPing: output\n$output");
		
		if ($returnval != 0)
		{
			Debug(1, "ArpPing: couldn't find host");
			return 0;
		} # end if error
		
		if ($output =~ /\[(\w\w:\w\w:\w\w:\w\w:\w\w:\w\w)\]/)
		{
			Debug(1, "ArpPing: found host at '$1'");
			return $1;
		} # end if found host
	} # end if no iface
	
	Debug(1, "ArpPing: no interface found");
	return 0;
} # end ArpPing();


# GetInetInterface(%)
#   figures out which interface this IP is on
sub GetInetInterface(%)
{
	my %arg = @_;
	my $iface;
	my $block;
	my $retval;
	
	Debug(1, "GetInetInterface: called");
	if (defined($arg{ip}) && $arg{ip} =~ /\d+\.\d+\.\d+\.\d+/)
	{
		Debug(2, "GetInetInterface: IP is '$arg{ip}'");
		
		open(IFCONFIG, "/sbin/ifconfig -a |");
		while(my $ifline = <IFCONFIG>)
		{
			$iface = $1 if ($ifline =~ /^(\S+)\s+/);
			if ($ifline =~ /inet addr:(\d+\.\d+\.\d+\.\d+).*Mask:(\d+\.\d+\.\d+\.\d+)/)
			{
				$block = new Net::Netmask($1, $2);
				if ($block->match($arg{ip}))
				{
					$retval = $iface;
					Debug(2, "GetInetInterface: Interface is '$retval'");
					last;
				} # end if we found the interface
			} # if this line contains IP info
		} # end while ifconfig
		close(IFCONFIG);
	} # end we can't do anything if we're not told anything
	
	return $retval;
} # end GetInetInterface();