#!/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 .
#
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;
#push @INC, "/home/bus/popufare/server/scripts";
use lib qw( . );
use RideLogic;
#my $ORG = "ORG";
my $ORG = "TEST-ORG";
my $isMySQL = 0;
my $DATADIR=$ENV{'HOME'} . "/data";
#my $database_path = 'DBI:mysql:busdb';
#my $database_path = 'DBI:SQLite:dbname=../bus.sqlite';
my $database_path = 'DBI:SQLite:dbname=' . $DATADIR . '/bus.sqlite';
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';
my $logfile = './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 < " . ($isMySQL ? "now()" : "datetime('now', 'localtime')") . ") or
( rc.ruleclass = 'NRIDE' and p.nrides_remain <= 0 ) or
( rc.rulename = 'PREACTIVE' ) ) ");
$query->execute($cardid);
my $href = $query->fetchrow_hashref;
if ($query->rows == 0) { $dbh->commit; return; }
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 = " . ($isMySQL ? "now()" : "datetime('now', 'localtime')") . " 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);
$href = $query->fetchrow_hashref;
# no passes left, put in reject rule, finish transaction
if ($query->rows == 0) {
if ($isMySQL) {
$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;
if ($isMySQL) {
$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);
if ($isMySQL) {
$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;
if ($isMySQL) {
$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 = ?) ');
# my $xx = $sth_find->execute($logical_card_id, $logical_card_id);
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)
order by seq_num desc limit 1;');
$sth_find->execute($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();
if (not @oldrow) { $dbh->commit; return; }
print ">> $logical_card_id, $billing_ride_time\n";
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);
my $pass = $sth_pass->fetchrow_hashref;
if ($pass) {
print ">>>>" . $pass . "\n";
print " ok?\n";
}
if ($sth_pass->rows != 1) {
if (uc($billing_action) ne "REJECT") {
my $sth;
if ($isMySQL) {
$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') ) ");
} else {
$sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
values ('warning', '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 $tref = $t->fetchrow_hashref;
print ">>> \$t->rows " . $t->rows . "\n";
my $rule_class = 'OTHER';
if ($t->rows == 1) {
#$rule_class = $t->fetchrow_hashref->{'ruleclass'};
$rule_class = $tref->{'ruleclass'};
} elsif ($t->rows < 1) {
my $sth;
if ($isMySQL) {
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') ) ");
} else {
my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
values ('warning', '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;
if ($isMySQL) {
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') ) ");
} else {
my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
values ('warning', '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;
if ($isMySQL) {
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 \"',?,'\"') )");
} else {
my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
values ('warning', '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) {
if ($isMySQL) {
$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) {
if ($isMySQL) {
$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;
if ($isMySQL) {
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'});
} else {
my $q = $dbh->prepare("update user_pass
set nday_expiration = strftime('%Y-%m-%d %H:%M:%S', date(?, '+? days'), '+150 minutes'), 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";
if ($isMySQL) {
$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;
if ($isMySQL) {
$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 ' . ($isMySQL ? '' : ' OR ') . '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;
if (not $isMySQL) { $sth->fetch; }
}
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 = $dbh->prepare('select count(*) num from billing_log where ride_time = datetime(?, "unixepoch") 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(?), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
$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 (?, ?, ?, ?, ?, ?, ?, datetime(?, "unixepoch"), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
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 = )
{
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
}