popufare/server/daemons/version_server/ridelogic_versiond

#!/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 Carp;
use DBI;
use FileHandle;
use Fcntl;
use Getopt::Long qw(:config no_ignore_case);
use POSIX;
use RideLogic;

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

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

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 CheckinServerReply
{
	my $client_query = $_[0];

	my $dbh = DBI->connect($database_path, $database_user, $database_pass)
		or die "Couldn't connect to database: " . DBI->errstr;

	my $sth ;
	my $logmsg ;
	my $response = '';
	
	my @client_values = split(/[\t]/, $client_query, -1);   #the -1 keeps split from trimming trailing blank fields
		#0.	busunit_num	(0 for Phase II)
		#1.	equip_num	(usually bogus for Phase I)
		#2.	eth0_mac	(Effectively a serial number of the SBC
		#3.	cell_imei	(Effectively a serial number of the Cell Modem)
		#4.	cell_imsi	(Effectively a serial number of the SIM card inserted in the modem)	
		#5.	version_strings (a concatenation of package versions)

	$client_values[0] =~ s/^[^0-9]*//;	#Strip the leading '#' (and anything else non-numeric) from our string

	$sth = $dbh->prepare('INSERT INTO bus_checkin_log (busunit_num, equip_num, eth0_mac, cell_imei, cell_imsi, version_data) VALUES (?, ?, ?, ?, ?, ?)');

	#    We explicitly chop this down to the 6 fields we want to insert, rather than passing @client_values as a parameter so
	#that if some foolish version string goes and contains a tab (this should never happen!) it will be trunctated instead
	#of the whole update being shitcanned because the array has too many data fields for the quiery...
	
	try
	{
		$sth->execute(@client_values[0..5]);
		$response .= "Thanks.\n";
	}
	catch
	{
		$logmsg .= $_ . "\n";
		$response .= "Server Side Error.\n";
	};

	print $logmsg if $logmsg;
	
	return $response;
}


sub ServerReply
{
	my $client_query = $_[0];
	
	$/="\n";
	chomp($client_query);
	
	if ($client_query =~ m/^\#/) #A leading '#' signals a bus_checkin_log entry, rather than an package update checkin
	{
		return CheckinServerReply($client_query);
	}

	my $response = "";
	
	my $dbh = DBI->connect($database_path, $database_user, $database_pass)
		or die "Couldn't connect to database: " . DBI->errstr;
	my $sth ;
	my $logmsg ;

	$sth = $dbh->prepare('SELECT client_file, checksum, file_size, file_path, fileversion FROM update_level t1 WHERE (serial = (SELECT serial FROM update_level WHERE client_file = t1.client_file AND (equip_num = 0 OR equip_num = ?) ORDER BY equip_num DESC, serial DESC LIMIT 1)) ORDER BY client_file ASC');

	my @client_values = split(/[\t]/, $client_query, -1);   #the -1 keeps split from trimming trailing blank fields
		#0.	equip_num
		#1.	filename=md5sum
		#2 ...

	my $i;
	my %filetable = ();
	
	for($i = 1; $i < @client_values; $i = $i + 1)
	{
		my ($client_file, $client_checksum) = split(/=/, $client_values[$i]);
		
		if($client_file && $client_checksum)
		{
			$filetable{$client_file} = $client_checksum;
		}
	}
	
	try
	{
		$sth->execute($client_values[0]) or die "Couldn't execute statement: " . $sth->errstr;
	}
	catch
	{
		$logmsg .= $_ . "\n";	
	};
	
	
	
	while(my @data = $sth->fetchrow_array())
	{
		#0	client_file
		#1	checksum
		#2	file_size
		#3	file_path
		#4	fileversion
	
		if(defined $filetable{$data[0]} && $filetable{$data[0]} eq $data[1])
		{
			#do nothing, the client is up to date	
		}
		else
		{
			$response .= "$data[0]\t$data[1]\t$data[2]\t$data[3]\t$data[4]\n";
		}
	}

	print $logmsg if $logmsg;
	
	return $response;
}


sub handle_client() 
{
	close SERVER;
	CLIENT->autoflush(1);

	my $linebuffer;
	
	while($linebuffer = <CLIENT>) 
	{
		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.
	}
} 

sub show_help_and_exit {
  print "usage:\n";
  print "  [-i]       interactive, do not daemonize\n";
  print "  [-c cfg]   use cfg as config file (default to " . $RideLogic::RIDELOGIC_DAEMON_CONF . ") \n";
  print "  [-h]       show help (this screen)\n";
  exit;
}

#----------------------------------------------------------------------
#
#----------------------------------------------------------------------
my $daemonize   = 1;
my $interactive = 0;
my $show_help   = 0;
my $cfg_file    = $RideLogic::RIDELOGIC_DAEMON_CONF;
GetOptions(
  'i|interactive'   => \$interactive,
  'c|config=s'      => \$cfg_file,
  'h|help'          => \$show_help );
show_help_and_exit() if ($show_help);

$daemonize=0 if ($interactive);


#----------------------------------------------------------------------
#   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

my %CFG_VAR;

read_config($cfg_file, \%CFG_VAR) if ($cfg_file);

my $logfile     = ($CFG_VAR{"RIDELOGIC_DAEMON_LOG_DIR"} || $RideLogic::RIDELOGIC_DAEMON_LOG_DIR) . "/ridelogic_versiond.log";
my $pidfile     = ($CFG_VAR{"RIDELOGIC_DAEMON_PID_DIR"} || $RideLogic::RIDELOGIC_DAEMON_PID_DIR) . "/ridelogic_versiond.pid";

daemonize($logfile, $pidfile) if ($daemonize);

# set our pipes to be piping hot
$|=1;


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 
}