| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790 |
- #!/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;
- #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 = <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
- }
|