popufare/server/daemons/billing_server/ridelogic_billingd_using_api

#!/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 FileHandle;
use Fcntl;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Getopt::Long qw(:config no_ignore_case);
use POSIX;
use Time::Local;
use Data::Dumper;

use RideLogic;
use RideLogicAPIQueryWrapper;

my $PROGNAME = "ridelogic_billingd_using_api";

my $HOST;
my $DB;
my $DBUSER;
my $DBPASS;
my $DSN;

my $ORG = "ORG";

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

my $billing_logfile;
my $debug_logfile;

my $REJECT_RULE = $ORG . "-REJECT";

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]);
}

sub readable_time_cmp {
        my $ldate = shift;
        my $rdate = shift;

        $ldate =~ m/^(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)$/;
        my $lunx = timelocal($6, $5, $4, $3, $2 - 1, $1);

        $rdate =~ m/^(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)$/;
        my $runx = timelocal($6, $5, $4, $3, $2 - 1, $1);

        return $lunx - $runx;
}

sub get_readable_expiration_date {
        my $readable_date = shift;
        my $ndays = shift;

        $readable_date =~ m/^(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)$/;
        my $t_unix = timelocal($6, $5, $4, $3, $2 - 1, $1);

        my $s = $ndays*60*60*24;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($t_unix + $s);
        return strftime('%Y-%m-%d %H:%M:%S', 0, 30, 2, $mday, $mon, $year);
}

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 $rldbh = shift;
        my $cardid = shift;

        # get active pass
        my %rhash;
#        $rldbh->get_user_pass(\%rhash, 
        $rldbh->GetUserPass(\%rhash, 
          {
            CardId => $cardid, 
            Active => 1 
          }
        );

        my $pass_id = $rhash{'PassId'};
        my $uc_type = uc($rhash{'Type'});

        if ($pass_id) 
        {
              # if the pass exists and has an expired nday, no nrides left 
              # or is a preactivated card, expire it
                my $now_str = strftime("%Y-%m-%d %H:%M:%S", localtime());
                if (   ( ($uc_type eq 'NDAY')  and ( readable_time_cmp($rhash{'NDayExpiration'}, $now_str) <= 0 ) ) 
                    or ( ($uc_type eq 'NRIDE') and ( $rhash{'NRideRemain'} <= 0) )
                    or   ($uc_type eq 'PREACTIVE')  )
                {

                       $rldbh->deactivate_user_pass($pass_id);
                       $rldbh->activate_user_card_pass($cardid);
                       $rldbh->insert_active_rider_table( { logical_card_id => $cardid } );
                }
        }

}

sub use_nride {
        my $rldbh = shift;
        my $pass_entry = shift;
        my $art_entry = shift;
        my $billing_ride_time = shift;

        my $cur_rides = (($pass_entry->{'NRideRemain'} > 0) ? ($pass_entry->{'NRideRemain'}-1) : 0 );

        my %update_pass_param = 
          (
            nrides_remain => $cur_rides,
            lastused => $billing_ride_time
          );

        if ( !$pass_entry->{'FirstUsed'} or
             (readable_time_cmp($billing_ride_time, $pass_entry->{'FirstUsed'}) < 0) )
        {
                $update_pass_param{'firstused'} = $billing_ride_time ;
        }

        $rldbh->update_user_pass($pass_entry->{'PassId'}, \%update_pass_param);

        if ($cur_rides > 0)
        {
                $rldbh->insert_active_rider_table( { logical_card_id => $pass_entry->{'CardId'} }  );
        }
}


sub use_nday {
        my $rldbh = shift;
        my $pass_entry = shift;
        my $art_entry = shift;
        my $billing_ride_time = shift;

        my %update_pass_param = 
          (
            lastused => $billing_ride_time
          );

        if ( !$pass_entry->{'FirstUsed'} or 
             (readable_time_cmp($billing_ride_time, $pass_entry->{'FirstUsed'}) < 0) )
        {
                $update_pass_param{'firstused'} = $billing_ride_time;
        }

        if (!$pass_entry->{'NDayExpiration'})
        {
                my $nday_exp = get_readable_expiration_date($billing_ride_time, $pass_entry->{'NDayOrig'}); 
                $update_pass_param{'nday_expiration'} = $nday_exp;
                $rldbh->update_user_pass($pass_entry->{'PassId'}, \%update_pass_param);
                $rldbh->insert_active_rider_table( { logical_card_id => $pass_entry->{'CardId'} } );
        }
        else
        {
                $rldbh->update_user_pass($pass_entry->{'PassId'}, \%update_pass_param);
        }

}

sub update_domain_card {
        my $rldbh = shift;
        my $pass_entry = shift;
        my $billing_ride_time = shift;

        my %update_pass_param;
        if ( !$pass_entry->{'LastUsed'} or 
             (readable_time_cmp($billing_ride_time, $pass_entry->{'LastUsed'}) > 0) )
        {
                $update_pass_param{'lastused'} = $billing_ride_time;
        }

        if ( !$pass_entry->{'FirstUsed'} or
             (readable_time_cmp($billing_ride_time, $pass_entry->{'FirstUsed'}) < 0) )
        {
                $update_pass_param{'firstused'} = $billing_ride_time;
        }

        if (scalar(keys(%update_pass_param)) > 0)
        {
                $rldbh->update_user_pass($pass_entry->{'PassId'}, \%update_pass_param );
        }

}


sub art_pass_mismatch {
        my $rldbh = shift;
        my $logical_card_id = shift;
        my $billing_cksum = shift;
        my $billing_ride_time = shift;
        my $billing_action = shift;
        my $billing_rule = shift;

        my $pass_entry = shift;
        my $art_entry = shift;

        my $mismatch = 0;
        my $reason;

        # order matters
        if ( !$pass_entry->{'PassId'} ) 
        {

                if ( uc($billing_rule) ne $REJECT_RULE )
                {
                        $reason = "Billing entry has rule \"$billing_rule\" but no passes on card";
                        $mismatch = 1;
                }
                elsif ( uc($art_entry->{'rule_name'}) ne $REJECT_RULE )
                {
                        $reason = "art rule \"" . $art_entry->{'rule_name'} . "\" with no passes on card";
                        $mismatch = 1;
                }

        }
        elsif (uc($art_entry->{'rule_name'}) ne uc($pass_entry->{'Rule'})) 
        {
                $mismatch = 1;
                $reason = "art rule \"" . $art_entry->{'rule_name'} . "\"";
                $reason .= " != pass rule \"" . $pass_entry->{'Rule'} . "\"";
        } 
        elsif ( uc($billing_rule) ne uc($pass_entry->{'Rule'}) ) 
        {

                # unless its a passback reject, we have a mismatch
                if ( (uc($billing_action) ne 'REJECT') or (uc($billing_rule) ne 'PASSBACK') )
                {
                        # bus got out of sync with art?  give user this pass to protect against
                        # decrementing an nride when an nday (or something else) was reported
                        $mismatch = 1;
                        $reason = "billing rule \"$billing_rule\" != pass rule \"". $pass_entry->{'Rule'} ."\"";
                }

        } 

        if ($mismatch)
        {
                $rldbh->diagnostic_log("warning",
                  "$PROGNAME: cardid $logical_card_id, " .
                  "cksum $billing_cksum, " .
                  "passid " . ($pass_entry->{'PassId'} || "n/a" ) . " " .
                  "seq_num " . ($art_entry->{'seq_num'} || "n/a") . ", " .
                  "mismatch ($reason): " .
                  "bill. rule \"$billing_rule\", " .
                  "pass rule \"" . ($pass_entry->{'Rule'} || "n/a") . "\", " .
                  "art rule \"" . ($art_entry->{'rule_name'} || "n/a") . "\""
                );

        }

        return $mismatch;
}

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

        return 1 if !$logical_card_id;

        my %art_entry;
        $rldbh->get_active_rider_table(\%art_entry, 
          { 
            logical_card_id => $logical_card_id 
          }
        );

        if ( !$art_entry{'seq_num'} )
        {
                $rldbh->diagnostic_log('warning', "No seq_num found in billing_log for $logical_card_id");
                return 0;
        }

        my %pass_entry;
#        $rldbh->get_user_pass(\%pass_entry, 
        $rldbh->GetUserPass(\%pass_entry, 
          {
            CardId => $logical_card_id,
            Active => 1
          }
        );

        return 0 if (art_pass_mismatch($rldbh, 
                                       $logical_card_id, 
                                       $billing_cksum, 
                                       $billing_ride_time, 
                                       $billing_action, 
                                       $billing_rule, 
                                       \%pass_entry, 
                                       \%art_entry));

        # we only allow a pass to be used when it's an accept and the database is consistent for this pass
        if (uc($billing_action) eq 'ACCEPT')
        {
                my $uc_type = uc($pass_entry{'Type'});

                if ( $uc_type eq 'NRIDE') 
                { 
                        use_nride($rldbh, \%pass_entry, \%art_entry, $billing_ride_time); 
                } 
                elsif ( $uc_type eq 'NDAY')  
                { 
                        use_nday($rldbh, \%pass_entry, \%art_entry, $billing_ride_time);  
                } 
                else # domain card
                { 
                        update_domain_card($rldbh, \%pass_entry, $billing_ride_time); 
                }

        }
        else
        {
                # update first used/last used?
        }

        ExpirePass( $rldbh, $logical_card_id );

        return 1;
}

sub ServerReply
{
	my $client_query = $_[0];
	
	$/="\n";
	chomp($client_query);
	my $response = "";
	
	my $client_query_md5 = md5_hex($client_query);
	
        my $rldbh = RideLogicAPIQueryWrapper->connect($DSN, $DBUSER, $DBPASS) || die "ERROR: could not connect to DB";
        $rldbh->raise_error( 1 );

	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 {
                        $rldbh->diagnostic_log($loglvl, $message) 
                                or die "Couldn't write to diagnostic log: " . $rldbh->errstr;
			$response .= "ACK\t" . $client_query_md5 . "\n";	
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";
		};
		
	}
	elsif ($client_query =~ m/^\*/) #warning
	{
		$loglvl = "warning";
		$message = $client_query;
		$message =~  s/^.//;

		try {
                        $rldbh->diagnostic_log($loglvl, $message)
                                or die "Couldn't write to diagnostic log: " . $rldbh->errstr;
			$response .= "ACK\t" . $client_query_md5 . "\n";	
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";
		};
	}
	elsif ($client_query =~ m/^\#/) #debug
	{
		$loglvl = "debug";
		$message = $client_query;
		$message =~  s/^.//;

		try {
                        $rldbh->diagnostic_log($loglvl, $message)
                                or die "Couldn't write to diagnostic log: " . $rldbh->errstr;
			$response .= "ACK\t" . $client_query_md5 . "\n";	
		}
		catch {
			$logmsg .= $_ . "\n";
			$response .= "IGN\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	
		
		try {
                        my $duplicate_billing_entry = 
                          $rldbh->check_dup_billing_log($client_values[6], $client_query_md5);

                        if (!$duplicate_billing_entry) {
                                $rldbh->insert_billing_log($client_query_md5, @client_values[0..16]);

#                                $rldbh->lock_common();
#                                $rldbh->begin_work();
                                $rldbh->begin_locked_transaction_common();

                                my $r = 
                                  AdvanceRiderPass($rldbh,                                    # db handle
                                                   $client_values[14],                        # logical_card_id 
                                                   $client_query_md5,                         # billing log md5
                                                   unix_to_readable_time($client_values[6]),  # ride_time (readable)
                                                   $client_values[9],                         # action (e.g. ACCEPT/REJECT)
                                                   $client_values[10]);                       # rule
                                $response .=  "ACK\t" . $client_query_md5 . "\n";

#                                $rldbh->commit();
#                                $rldbh->unlock();
                                $rldbh->unlock_commit();

                        }
                        else
                        {
                                $response .= "DUP\t" . $client_query_md5 . "\n";
                        } 

		}
		catch {
#                        $rldbh->rollback();
#                        $rldbh->unlock();
                        $rldbh->unlock_rollback();

			$logmsg .= $_ . "\n";
			$response .= "IGN\t" . $client_query_md5 . "\n";

		};

	}
	else
	{
		$logmsg .= "Malformed log entry \"$client_query\".\n";
		$response .= "IGN\t" . $client_query_md5 . "\n";
	}
	print $logmsg if $logmsg;
	
	return $response;
}

sub debug_print
{
        my $line = shift;
        if ($debug_logfile =~ /^([^\0]+)$/) {
                my $untainted_debug_logfile = $1;
                sysopen ( my $fh , $untainted_debug_logfile, O_WRONLY|O_APPEND|O_CREAT, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH );
                print $fh $line . "\n";
                close $fh;
	}
}


sub handle_client() 
{
	close SERVER;
	CLIENT->autoflush(1);
	
	my $linebuffer;
	
	while($linebuffer = <CLIENT>) 
	{
                if ($billing_logfile =~ /^([^\0]+)$/) {
                        my $untainted_billing_logfile = $1;
                        sysopen ( my $fh , $untainted_billing_logfile, O_WRONLY|O_APPEND|O_CREAT, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH );
                        print $fh $linebuffer;
                        close $fh;
                }

		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;
my $api_cfg_file  = $RideLogic::RIDELOGIC_API_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);
read_config($api_cfg_file, \%CFG_VAR) if ($api_cfg_file);

my $logfile             = ($CFG_VAR{"RIDELOGIC_DAEMON_LOG_DIR"} || $RideLogic::RIDELOGIC_DAEMON_LOG_DIR) . "/ridelogic_billingd.log";
   $billing_logfile     = ($CFG_VAR{"RIDELOGIC_DAEMON_LOG_DIR"} || $RideLogic::RIDELOGIC_DAEMON_LOG_DIR) . "/billing_log";
my $pidfile             = ($CFG_VAR{"RIDELOGIC_DAEMON_PID_DIR"} || $RideLogic::RIDELOGIC_DAEMON_PID_DIR) . "/ridelogic_billingd.pid";
   $debug_logfile       = ($CFG_VAR{"RIDELOGIC_DAEMON_LOG_DIR"} || $RideLogic::RIDELOGIC_DAEMON_LOG_DIR) . "/billing_debug_log";

$HOST    = $CFG_VAR{'RIDELOGIC_DB_SERVER'};
$DB      = $CFG_VAR{'RIDELOGIC_DB'};
$DBUSER  = $CFG_VAR{'RIDELOGIC_DB_USERNAME'};
$DBPASS  = $CFG_VAR{'RIDELOGIC_DB_PASSWORD'};
$DSN     = "dbi:mysql:host=" . $HOST . ";database=" . $DB;


#my $RLDBH = RideLogicAPIQueryWrapper->connect($DSN, $DBUSER, $DBPASS) || die "ERROR: could not connect to DB";
#my ($query, $result, $row);
#$RLDBH->raise_error( 1 );


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 
}