popufare/server/daemons/billing_server/billing_server.pl

#!/usr/bin/perl -Tw 
#
# Copyright (c) 2019 Clementine Computing LLC.
# 
# This file is part of PopuFare.
# 
# PopuFare is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# 
# PopuFare is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with PopuFare.  If not, see <https://www.gnu.org/licenses/>.
#

require 5.002; 
use strict; 
use Socket; 
use Switch;
use Carp;
use DBI;
use Date::Calc qw(:all);
use FileHandle;
use Fcntl;
use Digest::MD5 qw(md5 md5_hex md5_base64);

use POSIX;

use Data::Dumper;

use OrgDB;

my $ORG = "ORG";

my $database_path = 'DBI:mysql:busdb';
my $database_user = '';
my $database_pass = '';

my $bind_ip  	  = '127.0.0.1';
my $bind_port	  = 2455;

my $logfile       = '/home/bus/log/billing_log.log';

sub unix_to_readable_time {
  my $unix_time = shift;
  my @a = localtime($unix_time);
  return sprintf('%d-%02d-%02d %02d:%02d:%02d', (1900+$a[5]), (1+$a[4]), $a[3], $a[2], $a[1], $a[0]);
}

#----------------------------------------------Ugly exception handling logic using closures and anonymous functions----
#-------------------------------------------This is in there to deal with the fact that CreditCall uses the die("error")
#-------------------------------------------function instead of returning an error message in many cases...

#       This utility function returns the passed string sans any leading or trailing whitespace.
#
sub strip_whitespace
{
	my $str = shift;        #grab our first parameter
        
        $str =~ s/^\s+//;       #strip leading whitespace
        $str =~ s/\s+$//;       #strip trailing whitespace
                        
        return $str;            #return the improved string
}
                                

#    This function takes two coderef parameters, the second of which is usually an explicit call to the 
# 'catch' function which itself takes a coderef parameter.  This allows the code employing this suite of 
# functions to look somewhat like a conventional exception handling mechanism:
#
# try
# {
#    do_something_that_might_die();
# }
# catch
# {
#   my $errmsg = $_;
#   log_the_error_message($errmsg);
#   perform_some_cleanup();
# };
#
# DO NOT FORGET THAT LAST SEMICOLON, EVERYTHING GOES TO HELL IF YOU DO!
#   
sub try(&$)
{
	my ($attempt, $handler) = @_;
	
	eval
	{
		&$attempt;
	};
	
	if($@)
	{
		do_catch($handler);
	}
}

#    This function strips off the whitespace from the exception message reported by die()
# and places the result into the default variable such that the code in the catch block can
# just examine $_ to figure out what the cause of the error is, or to display or log
# the error message.
#
sub do_catch(&$)
{
	my ($handler) = @_;
	
	local $_ = strip_whitespace($@);
	
	&$handler;
}

#    This just takes an explicit coderef and returns it unharmed.  The only
# purpose of this is so the try/catch structure looks pretty and familiar.                                          
#
sub catch(&) {$_[0]}

#--------------------------------------------------------------------------------------------------------------------


#my $DebugMode = 1;
my $DebugMode = 0;

# This function only executes the passed code reference if the global variable $DebugMode is non-zero.
# The reason for this is that any calculation (like a FooBar::ComplexObject->toString call) will not be
# performed if we are not in debug mode, sort of like a very limited form of lazy evaluation.
#
sub ifdebug(&@)
{
	my ($cmd) = @_;
	&$cmd() if($DebugMode);
}

sub ExpirePass {
  my $dbh = shift;
  my $cardid = shift;
  my $dummy_passid = shift;
  my $ride_time = shift;
  my @oldrow = @_;

  local $dbh->{RaiseError};
  local $dbh->{PrintError};

  $dbh->{RaiseError} = 1;
  $dbh->{PrintError} = 1;

  $dbh->begin_work;

  # get passes to expire for a cardid
  my $query = $dbh->prepare("select p.user_pass_id, p.queue_order, p.rule, p.nrides_remain, p.nday_expiration, rc.ruleclass
                               from user_pass p, rule_class rc
                              where p.logical_card_id = ? and p.active = 1 and p.expired = 0 and
                                    ( ( rc.ruleclass = 'NDAY' and p.nday_expiration < now() ) or
                                    ( rc.ruleclass = 'NRIDE' and p.nrides_remain <= 0 ) or
                                    ( rc.rulename = 'PREACTIVE' ) ) ");
  $query->execute($cardid);
  if ($query->rows == 0) { $dbh->commit; return; }

  my $href = $query->fetchrow_hashref;
  my $passid = $href->{'user_pass_id'};
  my $current_q_num = $href->{'queue_order'};

  # expire old pass
  my $audit_pass_id = audit_user_pass_start($dbh, $passid, "billing_server: ExpirePass: deactivating and expiring pass");
  $query = $dbh->prepare("update user_pass set active = 0, expired = 1, deactivated = now() where user_pass_id = ?");
  $query->execute($passid);
  audit_user_pass_end($dbh, $passid, $audit_pass_id);

  # activate new pass
  $query = $dbh->prepare("select p.user_pass_id, p.rule, p.nday_orig, p.nday_expiration, p.nrides_orig, p.queue_order, rc.ruleclass
                            from user_pass p, rule_class rc
                           where p.logical_card_id = ? 
                             and p.expired = 0 and p.rule = rc.rulename
                             and p.queue_order = ( select min(t.queue_order) 
                                                   from user_pass t 
                                                  where t.logical_card_id = ? 
                                                    and t.queue_order > ? 
                                                    and t.expired = 0) ");
  $query->execute($cardid, $cardid, $current_q_num);

  # no passes left, put in reject rule, finish transaction
  if ($query->rows == 0) {
    $query = $dbh->prepare("lock tables active_rider_table write");
    $query->execute();
    $query = $dbh->prepare("insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, notes)
                                                    values (?,?,?,?,?,?,?)");
    $query->execute($cardid, @oldrow[1,2], $ORG . '-REJECT', 'reject', 0, $oldrow[7]);
    $dbh->commit;
    $query = $dbh->prepare("unlock tables");
    $query->execute();
    return;
  }

  # else make new pass active and update art with new pass
  $href = $query->fetchrow_hashref;

  my $pass_param = '';
  if      ($href->{'ruleclass'} eq 'NRIDE') { 
    $pass_param = $href->{'nrides_orig'}; 
  } elsif ($href->{'ruleclass'} eq 'NDAY')  { 
    $pass_param = $href->{'nday_orig'}; 
    $pass_param .= " " . $href->{'nday_expiration'} if $href->{'nday_expiration'}; 
  }

  $audit_pass_id = audit_user_pass_start($dbh, $href->{'user_pass_id'}, "billing_server: ExpirePass: activating pass");
  $query = $dbh->prepare("update user_pass set active = 1, activated = ? where user_pass_id = ?");
  $query->execute($ride_time, $href->{'user_pass_id'} );
  audit_user_pass_end($dbh, $href->{'user_pass_id'}, $audit_pass_id);

  $query = $dbh->prepare("lock tables active_rider_table write");
  $query->execute();
  $query = $dbh->prepare("insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, notes)
                                                  values (?,?,?,?,?,?,?)");
  $query->execute($cardid, @oldrow[1,2], $href->{'rule'}, $pass_param, 0, $oldrow[7]);
  $dbh->commit;
  $query = $dbh->prepare("unlock tables");
  $query->execute();

}

sub AdvanceRiderPass {
  my $dbh = shift;
  my $logical_card_id = shift;
  my $billing_cksum = shift;
  my $billing_ride_time = shift;
  my $billing_action = shift;
  my $billing_rule = shift;

  local $dbh->{RaiseError};
  local $dbh->{PrintError};

  $dbh->{RaiseError} = 1;
  $dbh->{PrintError} = 1;

  $dbh->begin_work;

  my $sth_find = $dbh->prepare('SELECT active_rider_table.logical_card_id, 	active_rider_table.rfid_token, 
				       active_rider_table.mag_token, 	        active_rider_table.rule_name, 
				       active_rider_table.rule_param, 	        active_rider_table.deleted, 
				       active_rider_table.parent_entity, 	active_rider_table.notes,
                                       active_rider_table.seq_num
				  FROM active_rider_table
				 WHERE logical_card_id = ? 
				   AND NOT(deleted) 
				   AND seq_num = (SELECT max(seq_num) FROM active_rider_table WHERE logical_card_id = ?) ');
  $sth_find->execute($logical_card_id, $logical_card_id);
  if ($sth_find->rows != 1) { $dbh->commit; return; }

  #@oldrow:
  #0. logical_card_id
  #1. rfid_token
  #2. mag_token
  #3. rule_name
  #4. rule_param
  #5. deleted
  #6. parent_entity
  #7. notes
  #8. seq_num
  my @oldrow = $sth_find->fetchrow_array();

  my $sth_pass = $dbh->prepare("select p.user_pass_id, p.nrides_remain, p.nday_orig, p.nday_expiration, p.rule
                                  from user_pass p, user_card c
                                 where p.logical_card_id = ? 
                                   and c.logical_card_id = p.logical_card_id
                                   and c.active = 1
                                   and p.active = 1 
                                   and p.expired = 0 
                                   and p.activated <= ?");
  $sth_pass->execute($logical_card_id, $billing_ride_time);
  if ($sth_pass->rows != 1) { 
    if (uc($billing_action) ne "REJECT") {
      my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message) 
        values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', dropping billing entry: no matching pass entry') ) ");
      $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
    }
    $dbh->commit; 
    return; 
  }

  my $pass = $sth_pass->fetchrow_hashref;

  my $t = $dbh->prepare("select ruleclass from rule_class where rulename = ?");
  $t->execute($pass->{'rule'});
  my $rule_class = 'OTHER';
  if ($t->rows == 1) { 
    $rule_class = $t->fetchrow_hashref->{'ruleclass'}; 
  } elsif ($t->rows < 1) {
    my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message) 
      values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', no rule class found, dropping billing entry') ) ");
    $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
    $dbh->commit; 
    return; 
  } else {
    my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message) 
      values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', multiple rule classes found, dropping billing entry') ) ");
    $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
    $dbh->commit; 
    return; 
  }

  if (uc($billing_action) eq "REJECT") {
    # bus not sync'd? 
    $dbh->commit;
  } elsif ($oldrow[3] ne $pass->{'rule'}) {
    # raise warning?
    my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message) 
      values ('warning', concat('billing_server: logical_card_id ',?,', billing_cksum ',?,', art seq_num ',?,', rule mismatch(1): art rule \"',?,'\" != user_pass_id ',?,' rule \"',?,'\"') )");
    $sth->execute($logical_card_id, $billing_cksum, $oldrow[8], $oldrow[3], $pass->{'user_pass_id'}, $pass->{'rule'});
    $dbh->commit;
  } elsif ($billing_rule ne $pass->{'rule'}) {
    # bus got out of sync with art?  give user this pass at the risk to prevent against
    # decrementing an nride when an nday (or something else) was reported
    my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message) 
      values ('warning', concat('billing_server: logical_card_id ',?,', billing_cksum ',?,', art seq_num ',?,', rule mismatch(2): billing rule \"',?,'\" != user_pass_id ',?,' rule \"',?,'\"' ) )");
    $sth->execute($logical_card_id, $billing_cksum, $oldrow[8], $billing_rule, $pass->{'user_pass_id'}, $pass->{'rule'});
    $dbh->commit;
  } elsif ( $rule_class eq 'NRIDE') {

    my $cur_rides = (($pass->{'nrides_remain'} > 0) ? ($pass->{'nrides_remain'}-1) : 0 );
    $oldrow[4] = $cur_rides;

    my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nride");
    my $q = $dbh->prepare('update user_pass set nrides_remain = ?, lastused = ? where user_pass_id = ?');
    $q->execute($cur_rides, $billing_ride_time, $pass->{'user_pass_id'});
    audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);

    # expire passes will take care of it if #rides == 0
    if ($cur_rides>0) {
      $q = $dbh->prepare("lock tables active_rider_table write");
      $q->execute();
      $q = $dbh->prepare('insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, parent_entity, notes) 
        values (?, ?, ?,?, ?, ?, ?, ?)');
      $q->execute(@oldrow[0..7]);
    }
    $dbh->commit;
    if ($cur_rides>0) { $q = $dbh->prepare("unlock tables"); $q->execute(); }

  } elsif ($rule_class eq 'NDAY') {

    # update user_pass with expiration and update active_rider_table with new param
    if (!$pass->{'nday_expiration'}) {
      my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nday");
      my $q = $dbh->prepare("update user_pass 
                                set nday_expiration = addtime( adddate(convert(date(?), datetime), nday_orig), '2:30'), firstused = ?, lastused = ? 
                              where user_pass_id = ?");
      $q->execute($billing_ride_time, $billing_ride_time, $billing_ride_time, $pass->{'user_pass_id'});
      audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);

      $oldrow[4] = $pass->{'nday_orig'} . " " . join('-', Add_Delta_Days(Today, $pass->{'nday_orig'} )) . " 2:30:00";

      $q = $dbh->prepare("lock tables active_rider_table write"); $q->execute();
      my $sth_new_expires = $dbh->prepare('INSERT INTO active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, parent_entity, notes) 
        VALUES (?, ?, ?, ?, ?, ?, ?, ?)');
      $sth_new_expires->execute(@oldrow[0..7]);

      $dbh->commit;
      $q = $dbh->prepare("unlock tables");
      $q->execute();

    } else {  # else just update last used

      my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nday (lastused only)");
      my $q = $dbh->prepare("update user_pass set lastused = ? where user_pass_id = ? and (lastused is null or lastused < ?)");
      $q->execute($billing_ride_time, $pass->{'user_pass_id'}, $billing_ride_time);
      audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
      $dbh->commit;
    }

  } else {
    # domain card, do nothing
    my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating domain (lastused only)");
    my $q = $dbh->prepare("update user_pass set lastused = ? where user_pass_id = ? and (lastused is null or lastused < ?)");
    $q->execute($billing_ride_time, $pass->{'user_pass_id'}, $billing_ride_time);
    audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
    $dbh->commit;
  }

  ExpirePass( $dbh, $logical_card_id, $pass->{'user_pass_id'}, $billing_ride_time, @oldrow );

}

sub ServerReply
{
	my $client_query = $_[0];
	
	$/="\n";
	chomp($client_query);
	my $response = "";
	
	my $client_query_md5 = md5_hex($client_query);
	
	my $dbh = DBI->connect($database_path, $database_user, $database_pass)
		or die "Couldn't connect to database: " . DBI->errstr;
	my $sth ;
	my $loglvl ;
	my $message ;
	my $logmsg ;

	if ($client_query =~ m/^[\s\x00]*$/)
	{
		$logmsg .= "Ignoring spurious blank line.\n";
		$response .= "IGN\t" . $client_query_md5 . "\n";
	}
	elsif ($client_query =~ m/^\!/) #error
	{
		$loglvl = "error";
		$message = $client_query;
		$message =~  s/^.//;

		try {
			$sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log  (loglvl, message) VALUES (?, ?)')
				or die "Couldn't prepare statement: " . $dbh->errstr;
	
			$sth->execute($loglvl, $message)             # Execute the query
				or die "Couldn't execute statement: " . $sth->errstr;
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";
		};
		
		if ($sth->rows < 1) {
			$response .= "DUP\t" . $client_query_md5 . "\n";
		} else {
			$response .= "ACK\t" . $client_query_md5 . "\n";	
		}
	}
	elsif ($client_query =~ m/^\*/) #warning
	{
		$loglvl = "warning";
		$message = $client_query;
		$message =~  s/^.//;

		try {
			$sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log  (loglvl, message) VALUES (?, ?)')
				or die "Couldn't prepare statement: " . $dbh->errstr;
	
			$sth->execute($loglvl, $message)             # Execute the query
				or die "Couldn't execute statement: " . $sth->errstr;
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";
		};
			
		if ($sth->rows < 1) {
			$response .= "DUP\t" . $client_query_md5 . "\n";
		} else {
			$response .= "ACK\t" . $client_query_md5 . "\n";	
		}
	}
	elsif ($client_query =~ m/^\#/) #debug
	{
		$loglvl = "debug";
		$message = $client_query;
		$message =~  s/^.//;

		try {
			$sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log  (loglvl, message) VALUES (?, ?)')
				or die "Couldn't prepare statement: " . $dbh->errstr;
	
			$sth->execute($loglvl, $message)             # Execute the query
				or die "Couldn't execute statement: " . $sth->errstr;
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";
		};
		
		if ($sth->rows < 1) {
			$response .= "DUP\t" . $client_query_md5 . "\n";
		} else {
			$response .= "ACK\t" . $client_query_md5 . "\n";	
		}
	}
	elsif ($client_query =~ m/^(?:[^\t]*\t)+[^\t]*/)	#look for a list of optionally blank tab-delimited fields
	{
		my @client_values = split(/[\t]/, $client_query, -1);	#the -1 keeps split from trimming trailing blank fields
			#0. 	equip_num
			#1. 	driver
			#2. 	paddle
			#3. 	route
			#4. 	trip
			#5. 	stop
			#6. 	ride_time
			#7. 	latitude
			#8. 	longitude
			#9. 	action
			#10.	rule
			#11.	ruleparam
			#12.	reason
			#13.	credential
			#14.	logical_card_id
			#15.	cash_value
			#16.	stop_name
			#17.	(unused by DB) usec	
		
                my $duplicate_billing_entry=0;
		try {
                        $sth = $dbh->prepare('select count(*) num from billing_log where ride_time = FROM_UNIXTIME(?) and conf_checksum = ?') or die "Couldn't prepare statement: " . $dbh->errstr;
                        $sth->execute($client_values[6], $client_query_md5) or die "Couldn't execute statement: " . $sth->errstr;

                        $duplicate_billing_entry=1 if ($sth->fetchrow_arrayref->[0] > 0);

                        if (!$duplicate_billing_entry) {
			        $sth = $dbh->prepare('REPLACE INTO billing_log (conf_checksum, equip_num, driver, paddle, route, trip, stop, ride_time, latitude, longitude, action, rule, ruleparam, reason, credential, logical_card_id, cash_value, stop_name) VALUES (?, ?, ?, ?, ?, ?, ?, FROM_UNIXTIME(?), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
				        or die "Couldn't prepare statement: " . $dbh->errstr;
		
			        $sth->execute($client_query_md5, @client_values[0..16])             # Execute the query
				        or die "Couldn't execute statement: " . $sth->errstr;
                        }
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";
		};
		
                if ($duplicate_billing_entry) 
                {
			$response .= "DUP\t" . $client_query_md5 . "\n";
                } elsif ($sth->rows == 1)  #if the billing log update was sucessful and wasn't a duplicate
		{
			AdvanceRiderPass($dbh, $client_values[14], $client_query_md5, unix_to_readable_time($client_values[6]), $client_values[9], $client_values[10]);
			$response .= "ACK\t" . $client_query_md5 . "\n";
		} 
                #elsif ($sth->rows > 1) 
                #{
		#	$response .= "DUP\t" . $client_query_md5 . "\n";
		#} 
                else 
                {
			$logmsg .= "Error inserting $client_query_md5 $client_query into billing_log\n" ;
		}
	}
	else
	{
		$logmsg .= "Malformed log entry \"$client_query\".\n";
		$response .= "IGN\t" . $client_query_md5 . "\n";
	}
	print $logmsg if $logmsg;
	
	return $response;
}


sub handle_client() 
{
	close SERVER;
	CLIENT->autoflush(1);
	
	my $linebuffer;
	
	while($linebuffer = <CLIENT>) 
	{
                open LOGFH, ">>$logfile";
                print LOGFH $linebuffer;
                close LOGFH;

		print CLIENT ServerReply($linebuffer);
	}	#while data from client
	
	close CLIENT;
}


my $waitedpid = 0; 
my $sigreceived = 0;


sub REAPER 
{ 
	while (($waitedpid = waitpid(-1, WNOHANG))>0) { }
	$SIG{CHLD} = \&REAPER; # loathe sysV 
	$sigreceived = 1;
} 


sub spawn
{ 
	my $coderef = shift; 						#grab the first parameter
	unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') 	#verify that it consists of a non-null block of executable perl code
	{ 
		confess "usage: spawn CODEREF"; 			#complain if this is not the case
	} 
	my $pid; 
	if (!defined($pid = fork)) 					#attempt a fork, remembering the returned PID value
	{
		close CLIENT;
		return; 						#failed to fork, we'd better close the client
	} 
	elsif ($pid) 							#If the returned process ID is non-zero, that indicates that we are the parent process
	{ 
		return; # i'm the parent 
	}  
	else								#otherwise, if the returned process ID is 0, that means we're the child process
	{
		exit &$coderef();					#in which case, we want to execute the child handler that was passed in, and then
									#exit this (child) process when we've finished our conversation(s) with the
									#other (client) end of the socket.
	}
} 

#----------------------------------------------------------------------
#   Local network settings for Inter-Process communication.
#----------------------------------------------------------------------
my $proto = getprotobyname('tcp'); 
my $addr = sockaddr_in( $bind_port ,inet_aton($bind_ip));;
#----------------------------------------------------------------------

my $max_retries = 10;		#Maximum number of address-binding retries before we give up.
my $retry_count = $max_retries;	#number of retries left...
my $retry_delay = 3;		#number of seconds to wait between retries at binding to our designated IPC address
my $got_network = 0;		#flag to let us know that we can quit retrying once we have gotten a valid listening socket

while( ($retry_count > 0) && (!$got_network) )
{
	try	#Try and allocate a socket, bind it to our IPC address, and set it to listen for connections
	{
		socket(SERVER,PF_INET,SOCK_STREAM,$proto) || die "socket: $!"; 
		setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR,  1);
		bind (SERVER, $addr) || die "bind: $!"; 
		listen(SERVER,5) || die "listen: $!";
		$got_network = 1;
	}
	catch	#If that didn't work for some reason, log the error, clean up, and prepair to retry
	{
		my $errmsg = $_;	#Remember the error message
		
		close(SERVER);		#Clean up the server socket if it needs it
		
		#Decrement our remaining retry counter
		$retry_count = $retry_count - 1;
		
		#Log the message to our debug log
		print "Failed to allocate socket, will retry $retry_count times: $errmsg\n";
		
		#Wait a reasonable period before trying again
		sleep $retry_delay;
	};
}

if($got_network)	#If we met with success binding to the network, report it
{
	my $logmsg = "Socket setup successful.  Listening for clients at $bind_ip:$bind_port\n";
	
	print $logmsg;	
	
}
else			#If we ran out of patience and gave up, report that as well and exit
{
	my $errmsg = "Could not allocate and bind listening socket at $bind_ip:$bind_port after $max_retries attempts.\n";
	
	die $errmsg;
}

#    Set up our signal handler which will clean up defunct child processes and let the main
# accept() loop know that the reason accept returned was due to a signal, not a legit connection.
$SIG{CHLD} = \&REAPER; 

#This for loop is efficient, but confusting, so I'll break it down by clause
#
#    The first clause ($sigreceived = 0) clears the signal received flag that will be set if the 
# accept() call was interrupted by a signal.  This clause runs once before the first run of the loop
#
#    The second clause is the test clause, it will process the contents of the loop if EITHER
# accept() has returned (presumably generating a valid file handle for the CLIENT end of the
# socket, OR the signal received flag is set (thus accept would have returned early without
# having actually accepted a connection.
#
#    The third clause (the 'incrementer') is run after each time the body is executed, before the 
# test clause is executed again (deciding whether to run the body or drop out...  This test
# clause will close the parent process' copy of the CLIENT file handle since (see body below)
# after the body executes, all communication with the socket referred to by that file handle
# will be carried out by the spawned child process.  This frees the parent's copy of the CLIENT
# file handle to be used again in the parent process for the next accepted incoming connection.

for ( $sigreceived = 0; accept(CLIENT,SERVER) || $sigreceived; $sigreceived = 0, close CLIENT) 
{ 
	next if $sigreceived; 			#If we were interrupted by a signal, there is no real client, just go back and try to accept a new one
	print "connection received.\n";		#Print a diagnostic message confirming that we have made a connection
	spawn sub {handle_client();};		#fork() off a child process that will handle communication with the socket pointed to by the CLIENT file handle 
}