use strict;
use warnings;
use Socket;

use POSIX qw(setsid);
use Proc::PID::File;
use Log::Dispatch;
use Log::Dispatch::File;
use Date::Format;
use File::Spec;
use FindBin qw($Bin);

sub dienice ($);

my $port = 9999;
my $log_connections = 1;
# Want to log if script is executed when it's already running?
my $log_is_running = 1;

my $content = '<?xml version="1.0"?><cross-domain-policy><allow-access-from domain="*" to-ports="' . $port . '" /></cross-domain-policy>';
my $NULLBYTE = pack( 'c', 0 );

###
### Detect our base directory where we create the log and pid files
###
our $BASE_DIR = $Bin;
# Get script name, chop off any preceding path it was called with and chop off its extension (ex: 'some/dir/script.pl' becomes 'script')
our $ME = $0; $ME =~ s|.*/||; $ME =~ s|\..*||;
our $LOG_FILE = "$ME.log";

###
### Setup a logging agent
###
my $log = new Log::Dispatch(
	callbacks => sub { my %h=@_; return Date::Format::time2str('%B %e %T', time)." $ME\[$$]: ".$h{message}."\n"; }
);
$log->add( Log::Dispatch::File->new( name		=> 'file1',
									 min_level	=> 'warning',
									 mode		=> 'append',
									 filename	=> File::Spec->catfile($BASE_DIR, $LOG_FILE),
									)
);
$log->warning("Logging Started");

###
### Fork and background daemon process
###
startDaemon();

###
### Setup signal handlers to give us time to cleanup (and log) before shutting down
###
my $running = 1;
$SIG{HUP}  = sub { $log->warning("Caught SIGHUP:  exiting gracefully"); $running = 0; };
$SIG{INT}  = sub { $log->warning("Caught SIGINT:  exiting gracefully"); $running = 0; };
$SIG{QUIT} = sub { $log->warning("Caught SIGQUIT:  exiting gracefully"); $running = 0; };
$SIG{TERM} = sub { $log->warning("Caught SIGTERM:  exiting gracefully"); $running = 0; };


###
### As long as the daemon is running, listen for and handle received connections
###
while ($running) {
	###
	### BEGIN LISTENING
	###
	socket( LISTENSOCK, PF_INET, SOCK_STREAM, getprotobyname( 'tcp' ) ) or dienice("socket() error: $!");
	setsockopt( LISTENSOCK, SOL_SOCKET, SO_REUSEADDR, pack( 'l', 1 ) ) or dienice("setsockopt() error: $!");
	bind( LISTENSOCK, sockaddr_in( $port, INADDR_ANY ) ) or dienice("bind() error: $!");
	listen( LISTENSOCK, SOMAXCONN ) or dienice("listen() error: $!");
	$log->warning("Listening on port $port");

	###
	### HANDLE CONNECTIONS
	###
	while ( my $clientAddr = accept( CONNSOCK, LISTENSOCK ) )
	{
	    my ( $clientPort, $clientIp ) = sockaddr_in( $clientAddr );
	    my $clientIpStr = inet_ntoa( $clientIp );
	    
	    local $/ = $NULLBYTE;

	    my $request = <CONNSOCK>;
	    chomp $request;

	    if ( $request eq '<policy-file-request/>' )
	    {
			$log->warning("XML Policy file request from: $clientIpStr") if ($log_connections);
			print CONNSOCK $content.$NULLBYTE;
			close CONNSOCK;
	    }
	    else
	    {
			$log->warning("Connection from: $clientIpStr") if ($log_connections);
	        print CONNSOCK "<data><ip>$clientIpStr</ip></data>".$NULLBYTE;
	        close CONNSOCK;
	        next;
	    }
	}
}

###
### Mark a clean exit in the log
###
$log->warning("Logging Stopped");

###
### startDaemon
###
sub startDaemon {
	defined(my $pid = fork) or dienice("Can't fork: $!");
	exit if $pid;
	POSIX::setsid() or dienice("Can't start a new session: $!");

	# Get a PID file - or exit without error in case we're running periodically from cron
	if ( Proc::PID::File->running(dir => "$BASE_DIR", name => "$ME", verify => "1") )
	{
		$log->warning("Daemon Already Running!") if ($log_is_running);
		exit(0);
	}
}

###
### dienice
###
sub dienice ($) {
  my ($package, $filename, $line) = caller;
  # write die messages to the log before die'ing
  $log->critical("$_[0] at line $line in $filename");
  die $_[0];
}