billing_server.pl 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786
  1. #!/usr/bin/perl -Tw
  2. #
  3. # Copyright (c) 2019 Clementine Computing LLC.
  4. #
  5. # This file is part of PopuFare.
  6. #
  7. # PopuFare is free software: you can redistribute it and/or modify
  8. # it under the terms of the GNU Affero General Public License as published by
  9. # the Free Software Foundation, either version 3 of the License, or
  10. # (at your option) any later version.
  11. #
  12. # PopuFare is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. # GNU Affero General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU Affero General Public License
  18. # along with PopuFare. If not, see <https://www.gnu.org/licenses/>.
  19. #
  20. require 5.002;
  21. use strict;
  22. use Socket;
  23. use Switch;
  24. use Carp;
  25. use DBI;
  26. use Date::Calc qw(:all);
  27. use FileHandle;
  28. use Fcntl;
  29. use Digest::MD5 qw(md5 md5_hex md5_base64);
  30. use POSIX;
  31. use Data::Dumper;
  32. #use OrgDB;
  33. #push @INC, "/home/bus/popufare/server/scripts";
  34. use lib qw( . );
  35. use RideLogic;
  36. #my $ORG = "ORG";
  37. my $ORG = "TEST-ORG";
  38. my $isMySQL = 0;
  39. #my $database_path = 'DBI:mysql:busdb';
  40. my $database_path = 'DBI:SQLite:dbname=../bus.sqlite';
  41. my $database_user = '';
  42. my $database_pass = '';
  43. my $bind_ip = '127.0.0.1';
  44. my $bind_port = 2455;
  45. #my $logfile = '/home/bus/log/billing_log.log';
  46. my $logfile = './billing_log.log';
  47. sub unix_to_readable_time {
  48. my $unix_time = shift;
  49. my @a = localtime($unix_time);
  50. return sprintf('%d-%02d-%02d %02d:%02d:%02d', (1900+$a[5]), (1+$a[4]), $a[3], $a[2], $a[1], $a[0]);
  51. }
  52. #----------------------------------------------Ugly exception handling logic using closures and anonymous functions----
  53. #-------------------------------------------This is in there to deal with the fact that CreditCall uses the die("error")
  54. #-------------------------------------------function instead of returning an error message in many cases...
  55. # This utility function returns the passed string sans any leading or trailing whitespace.
  56. #
  57. sub strip_whitespace
  58. {
  59. my $str = shift; #grab our first parameter
  60. $str =~ s/^\s+//; #strip leading whitespace
  61. $str =~ s/\s+$//; #strip trailing whitespace
  62. return $str; #return the improved string
  63. }
  64. # This function takes two coderef parameters, the second of which is usually an explicit call to the
  65. # 'catch' function which itself takes a coderef parameter. This allows the code employing this suite of
  66. # functions to look somewhat like a conventional exception handling mechanism:
  67. #
  68. # try
  69. # {
  70. # do_something_that_might_die();
  71. # }
  72. # catch
  73. # {
  74. # my $errmsg = $_;
  75. # log_the_error_message($errmsg);
  76. # perform_some_cleanup();
  77. # };
  78. #
  79. # DO NOT FORGET THAT LAST SEMICOLON, EVERYTHING GOES TO HELL IF YOU DO!
  80. #
  81. sub try(&$)
  82. {
  83. my ($attempt, $handler) = @_;
  84. eval
  85. {
  86. &$attempt;
  87. };
  88. if($@)
  89. {
  90. do_catch($handler);
  91. }
  92. }
  93. # This function strips off the whitespace from the exception message reported by die()
  94. # and places the result into the default variable such that the code in the catch block can
  95. # just examine $_ to figure out what the cause of the error is, or to display or log
  96. # the error message.
  97. #
  98. sub do_catch(&$)
  99. {
  100. my ($handler) = @_;
  101. local $_ = strip_whitespace($@);
  102. &$handler;
  103. }
  104. # This just takes an explicit coderef and returns it unharmed. The only
  105. # purpose of this is so the try/catch structure looks pretty and familiar.
  106. #
  107. sub catch(&) {$_[0]}
  108. #--------------------------------------------------------------------------------------------------------------------
  109. #my $DebugMode = 1;
  110. my $DebugMode = 0;
  111. # This function only executes the passed code reference if the global variable $DebugMode is non-zero.
  112. # The reason for this is that any calculation (like a FooBar::ComplexObject->toString call) will not be
  113. # performed if we are not in debug mode, sort of like a very limited form of lazy evaluation.
  114. #
  115. sub ifdebug(&@)
  116. {
  117. my ($cmd) = @_;
  118. &$cmd() if($DebugMode);
  119. }
  120. sub ExpirePass {
  121. my $dbh = shift;
  122. my $cardid = shift;
  123. my $dummy_passid = shift;
  124. my $ride_time = shift;
  125. my @oldrow = @_;
  126. local $dbh->{RaiseError};
  127. local $dbh->{PrintError};
  128. $dbh->{RaiseError} = 1;
  129. $dbh->{PrintError} = 1;
  130. $dbh->begin_work;
  131. # get passes to expire for a cardid
  132. my $query = $dbh->prepare("select p.user_pass_id, p.queue_order, p.rule, p.nrides_remain, p.nday_expiration, rc.ruleclass
  133. from user_pass p, rule_class rc
  134. where p.logical_card_id = ? and p.active = 1 and p.expired = 0 and
  135. ( ( rc.ruleclass = 'NDAY' and p.nday_expiration < " . ($isMySQL ? "now()" : "datetime('now', 'localtime')") . ") or
  136. ( rc.ruleclass = 'NRIDE' and p.nrides_remain <= 0 ) or
  137. ( rc.rulename = 'PREACTIVE' ) ) ");
  138. $query->execute($cardid);
  139. my $href = $query->fetchrow_hashref;
  140. if ($query->rows == 0) { $dbh->commit; return; }
  141. my $passid = $href->{'user_pass_id'};
  142. my $current_q_num = $href->{'queue_order'};
  143. # expire old pass
  144. my $audit_pass_id = audit_user_pass_start($dbh, $passid, "billing_server: ExpirePass: deactivating and expiring pass");
  145. $query = $dbh->prepare("update user_pass set active = 0, expired = 1, deactivated = " . ($isMySQL ? "now()" : "datetime('now', 'localtime')") . " where user_pass_id = ?");
  146. $query->execute($passid);
  147. audit_user_pass_end($dbh, $passid, $audit_pass_id);
  148. # activate new pass
  149. $query = $dbh->prepare("select p.user_pass_id, p.rule, p.nday_orig, p.nday_expiration, p.nrides_orig, p.queue_order, rc.ruleclass
  150. from user_pass p, rule_class rc
  151. where p.logical_card_id = ?
  152. and p.expired = 0 and p.rule = rc.rulename
  153. and p.queue_order = ( select min(t.queue_order)
  154. from user_pass t
  155. where t.logical_card_id = ?
  156. and t.queue_order > ?
  157. and t.expired = 0) ");
  158. $query->execute($cardid, $cardid, $current_q_num);
  159. $href = $query->fetchrow_hashref;
  160. # no passes left, put in reject rule, finish transaction
  161. if ($query->rows == 0) {
  162. if ($isMySQL) {
  163. $query = $dbh->prepare("lock tables active_rider_table write");
  164. $query->execute();
  165. }
  166. $query = $dbh->prepare("insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, notes)
  167. values (?,?,?,?,?,?,?)");
  168. $query->execute($cardid, @oldrow[1,2], $ORG . '-REJECT', 'reject', 0, $oldrow[7]);
  169. $dbh->commit;
  170. if ($isMySQL) {
  171. $query = $dbh->prepare("unlock tables");
  172. $query->execute();
  173. }
  174. return;
  175. }
  176. # else make new pass active and update art with new pass
  177. #$href = $query->fetchrow_hashref;
  178. my $pass_param = '';
  179. if ($href->{'ruleclass'} eq 'NRIDE') {
  180. $pass_param = $href->{'nrides_orig'};
  181. } elsif ($href->{'ruleclass'} eq 'NDAY') {
  182. $pass_param = $href->{'nday_orig'};
  183. $pass_param .= " " . $href->{'nday_expiration'} if $href->{'nday_expiration'};
  184. }
  185. $audit_pass_id = audit_user_pass_start($dbh, $href->{'user_pass_id'}, "billing_server: ExpirePass: activating pass");
  186. $query = $dbh->prepare("update user_pass set active = 1, activated = ? where user_pass_id = ?");
  187. $query->execute($ride_time, $href->{'user_pass_id'} );
  188. audit_user_pass_end($dbh, $href->{'user_pass_id'}, $audit_pass_id);
  189. if ($isMySQL) {
  190. $query = $dbh->prepare("lock tables active_rider_table write");
  191. $query->execute();
  192. }
  193. $query = $dbh->prepare("insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, notes)
  194. values (?,?,?,?,?,?,?)");
  195. $query->execute($cardid, @oldrow[1,2], $href->{'rule'}, $pass_param, 0, $oldrow[7]);
  196. $dbh->commit;
  197. if ($isMySQL) {
  198. $query = $dbh->prepare("unlock tables");
  199. $query->execute();
  200. }
  201. }
  202. sub AdvanceRiderPass {
  203. my $dbh = shift;
  204. my $logical_card_id = shift;
  205. my $billing_cksum = shift;
  206. my $billing_ride_time = shift;
  207. my $billing_action = shift;
  208. my $billing_rule = shift;
  209. local $dbh->{RaiseError};
  210. local $dbh->{PrintError};
  211. $dbh->{RaiseError} = 1;
  212. $dbh->{PrintError} = 1;
  213. $dbh->begin_work;
  214. # my $sth_find = $dbh->prepare('SELECT active_rider_table.logical_card_id, active_rider_table.rfid_token,
  215. # active_rider_table.mag_token, active_rider_table.rule_name,
  216. # active_rider_table.rule_param, active_rider_table.deleted,
  217. # active_rider_table.parent_entity, active_rider_table.notes,
  218. # active_rider_table.seq_num
  219. # FROM active_rider_table
  220. # WHERE logical_card_id = ?
  221. # AND NOT(deleted)
  222. # AND seq_num = (SELECT max(seq_num) FROM active_rider_table WHERE logical_card_id = ?) ');
  223. # my $xx = $sth_find->execute($logical_card_id, $logical_card_id);
  224. my $sth_find = $dbh->prepare('SELECT active_rider_table.logical_card_id, active_rider_table.rfid_token,
  225. active_rider_table.mag_token, active_rider_table.rule_name,
  226. active_rider_table.rule_param, active_rider_table.deleted,
  227. active_rider_table.parent_entity, active_rider_table.notes,
  228. active_rider_table.seq_num
  229. FROM active_rider_table
  230. WHERE logical_card_id = ?
  231. AND NOT(deleted)
  232. order by seq_num desc limit 1;');
  233. $sth_find->execute($logical_card_id);
  234. #if ($sth_find->rows != 1) { $dbh->commit; return; }
  235. #@oldrow:
  236. #0. logical_card_id
  237. #1. rfid_token
  238. #2. mag_token
  239. #3. rule_name
  240. #4. rule_param
  241. #5. deleted
  242. #6. parent_entity
  243. #7. notes
  244. #8. seq_num
  245. my @oldrow = $sth_find->fetchrow_array();
  246. if (not @oldrow) { $dbh->commit; return; }
  247. print ">> $logical_card_id, $billing_ride_time\n";
  248. my $sth_pass = $dbh->prepare("select p.user_pass_id, p.nrides_remain, p.nday_orig, p.nday_expiration, p.rule
  249. from user_pass p, user_card c
  250. where p.logical_card_id = ?
  251. and c.logical_card_id = p.logical_card_id
  252. and c.active = 1
  253. and p.active = 1
  254. and p.expired = 0
  255. and p.activated <= ?");
  256. $sth_pass->execute($logical_card_id, $billing_ride_time);
  257. my $pass = $sth_pass->fetchrow_hashref;
  258. if ($pass) {
  259. print ">>>>" . $pass . "\n";
  260. print " ok?\n";
  261. }
  262. if ($sth_pass->rows != 1) {
  263. if (uc($billing_action) ne "REJECT") {
  264. my $sth;
  265. if ($isMySQL) {
  266. $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  267. values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', dropping billing entry: no matching pass entry') ) ");
  268. } else {
  269. $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  270. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', dropping billing entry: no matching pass entry' ) ");
  271. }
  272. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
  273. }
  274. $dbh->commit;
  275. return;
  276. }
  277. #my $pass = $sth_pass->fetchrow_hashref;
  278. my $t = $dbh->prepare("select ruleclass from rule_class where rulename = ?");
  279. $t->execute($pass->{'rule'});
  280. my $tref = $t->fetchrow_hashref;
  281. print ">>> \$t->rows " . $t->rows . "\n";
  282. my $rule_class = 'OTHER';
  283. if ($t->rows == 1) {
  284. #$rule_class = $t->fetchrow_hashref->{'ruleclass'};
  285. $rule_class = $tref->{'ruleclass'};
  286. } elsif ($t->rows < 1) {
  287. my $sth;
  288. if ($isMySQL) {
  289. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  290. values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', no rule class found, dropping billing entry') ) ");
  291. } else {
  292. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  293. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', no rule class found, dropping billing entry' ) ");
  294. }
  295. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
  296. $dbh->commit;
  297. return;
  298. } else {
  299. my $sth;
  300. if ($isMySQL) {
  301. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  302. values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', multiple rule classes found, dropping billing entry') ) ");
  303. } else {
  304. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  305. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', multiple rule classes found, dropping billing entry' ) ");
  306. }
  307. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
  308. $dbh->commit;
  309. return;
  310. }
  311. if (uc($billing_action) eq "REJECT") {
  312. # bus not sync'd?
  313. $dbh->commit;
  314. } elsif ($oldrow[3] ne $pass->{'rule'}) {
  315. # raise warning?
  316. my $sth;
  317. if ($isMySQL) {
  318. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  319. values ('warning', concat('billing_server: logical_card_id ',?,', billing_cksum ',?,', art seq_num ',?,', rule mismatch(1): art rule \"',?,'\" != user_pass_id ',?,' rule \"',?,'\"') )");
  320. } else {
  321. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  322. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', rule mismatch(1): art rule \"' || ? || '\" != user_pass_id ' || ? || ' rule \"' || ? || '\"' )");
  323. }
  324. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8], $oldrow[3], $pass->{'user_pass_id'}, $pass->{'rule'});
  325. $dbh->commit;
  326. } elsif ($billing_rule ne $pass->{'rule'}) {
  327. # bus got out of sync with art? give user this pass at the risk to prevent against
  328. # decrementing an nride when an nday (or something else) was reported
  329. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  330. values ('warning', concat('billing_server: logical_card_id ',?,', billing_cksum ',?,', art seq_num ',?,', rule mismatch(2): billing rule \"',?,'\" != user_pass_id ',?,' rule \"',?,'\"' ) )");
  331. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8], $billing_rule, $pass->{'user_pass_id'}, $pass->{'rule'});
  332. $dbh->commit;
  333. } elsif ( $rule_class eq 'NRIDE') {
  334. my $cur_rides = (($pass->{'nrides_remain'} > 0) ? ($pass->{'nrides_remain'}-1) : 0 );
  335. $oldrow[4] = $cur_rides;
  336. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nride");
  337. my $q = $dbh->prepare('update user_pass set nrides_remain = ?, lastused = ? where user_pass_id = ?');
  338. $q->execute($cur_rides, $billing_ride_time, $pass->{'user_pass_id'});
  339. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  340. # expire passes will take care of it if #rides == 0
  341. if ($cur_rides>0) {
  342. if ($isMySQL) {
  343. $q = $dbh->prepare("lock tables active_rider_table write");
  344. $q->execute();
  345. }
  346. $q = $dbh->prepare('insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, parent_entity, notes)
  347. values (?, ?, ?,?, ?, ?, ?, ?)');
  348. $q->execute(@oldrow[0..7]);
  349. }
  350. $dbh->commit;
  351. if ($cur_rides>0) {
  352. if ($isMySQL) {
  353. $q = $dbh->prepare("unlock tables");
  354. $q->execute();
  355. }
  356. }
  357. } elsif ($rule_class eq 'NDAY') {
  358. # update user_pass with expiration and update active_rider_table with new param
  359. if (!$pass->{'nday_expiration'}) {
  360. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nday");
  361. my $q;
  362. if ($isMySQL) {
  363. my $q = $dbh->prepare("update user_pass
  364. set nday_expiration = addtime( adddate(convert(date(?), datetime), nday_orig), '2:30'), firstused = ?, lastused = ?
  365. where user_pass_id = ?");
  366. $q->execute($billing_ride_time, $billing_ride_time, $billing_ride_time, $pass->{'user_pass_id'});
  367. } else {
  368. my $q = $dbh->prepare("update user_pass
  369. set nday_expiration = strftime('%Y-%m-%d %H:%M:%S', date(?, '+? days'), '+150 minutes'), firstused = ?, lastused = ?
  370. where user_pass_id = ?");
  371. $q->execute($billing_ride_time, $billing_ride_time, $billing_ride_time, $pass->{'user_pass_id'});
  372. }
  373. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  374. $oldrow[4] = $pass->{'nday_orig'} . " " . join('-', Add_Delta_Days(Today, $pass->{'nday_orig'} )) . " 2:30:00";
  375. if ($isMySQL) {
  376. $q = $dbh->prepare("lock tables active_rider_table write"); $q->execute();
  377. }
  378. 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)
  379. VALUES (?, ?, ?, ?, ?, ?, ?, ?)');
  380. $sth_new_expires->execute(@oldrow[0..7]);
  381. $dbh->commit;
  382. if ($isMySQL) {
  383. $q = $dbh->prepare("unlock tables");
  384. $q->execute();
  385. }
  386. } else { # else just update last used
  387. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nday (lastused only)");
  388. my $q = $dbh->prepare("update user_pass set lastused = ? where user_pass_id = ? and (lastused is null or lastused < ?)");
  389. $q->execute($billing_ride_time, $pass->{'user_pass_id'}, $billing_ride_time);
  390. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  391. $dbh->commit;
  392. }
  393. } else {
  394. # domain card, do nothing
  395. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating domain (lastused only)");
  396. my $q = $dbh->prepare("update user_pass set lastused = ? where user_pass_id = ? and (lastused is null or lastused < ?)");
  397. $q->execute($billing_ride_time, $pass->{'user_pass_id'}, $billing_ride_time);
  398. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  399. $dbh->commit;
  400. }
  401. ExpirePass( $dbh, $logical_card_id, $pass->{'user_pass_id'}, $billing_ride_time, @oldrow );
  402. }
  403. sub ServerReply
  404. {
  405. my $client_query = $_[0];
  406. $/="\n";
  407. chomp($client_query);
  408. my $response = "";
  409. my $client_query_md5 = md5_hex($client_query);
  410. my $dbh = DBI->connect($database_path, $database_user, $database_pass)
  411. or die "Couldn't connect to database: " . DBI->errstr;
  412. my $sth ;
  413. my $loglvl ;
  414. my $message ;
  415. my $logmsg ;
  416. if ($client_query =~ m/^[\s\x00]*$/)
  417. {
  418. $logmsg .= "Ignoring spurious blank line.\n";
  419. $response .= "IGN\t" . $client_query_md5 . "\n";
  420. }
  421. elsif ($client_query =~ m/^\!/) #error
  422. {
  423. $loglvl = "error";
  424. $message = $client_query;
  425. $message =~ s/^.//;
  426. try {
  427. $sth = $dbh->prepare('INSERT ' . ($isMySQL ? '' : ' OR ') . 'IGNORE INTO diagnostic_log (loglvl, message) VALUES (?, ?)')
  428. or die "Couldn't prepare statement: " . $dbh->errstr;
  429. $sth->execute($loglvl, $message) # Execute the query
  430. or die "Couldn't execute statement: " . $sth->errstr;
  431. if (not $isMySQL) { $sth->fetch; }
  432. }
  433. catch {
  434. $logmsg .= $_ . "\n";
  435. $response .= "IGN\t" . $client_query_md5 . "\n";
  436. };
  437. if ($sth->rows < 1) {
  438. $response .= "DUP\t" . $client_query_md5 . "\n";
  439. } else {
  440. $response .= "ACK\t" . $client_query_md5 . "\n";
  441. }
  442. }
  443. elsif ($client_query =~ m/^\*/) #warning
  444. {
  445. $loglvl = "warning";
  446. $message = $client_query;
  447. $message =~ s/^.//;
  448. try {
  449. $sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log (loglvl, message) VALUES (?, ?)')
  450. or die "Couldn't prepare statement: " . $dbh->errstr;
  451. $sth->execute($loglvl, $message) # Execute the query
  452. or die "Couldn't execute statement: " . $sth->errstr;
  453. }
  454. catch {
  455. $logmsg .= $_ . "\n";
  456. $response .= "IGN\t" . $client_query_md5 . "\n";
  457. };
  458. if ($sth->rows < 1) {
  459. $response .= "DUP\t" . $client_query_md5 . "\n";
  460. } else {
  461. $response .= "ACK\t" . $client_query_md5 . "\n";
  462. }
  463. }
  464. elsif ($client_query =~ m/^\#/) #debug
  465. {
  466. $loglvl = "debug";
  467. $message = $client_query;
  468. $message =~ s/^.//;
  469. try {
  470. $sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log (loglvl, message) VALUES (?, ?)')
  471. or die "Couldn't prepare statement: " . $dbh->errstr;
  472. $sth->execute($loglvl, $message) # Execute the query
  473. or die "Couldn't execute statement: " . $sth->errstr;
  474. }
  475. catch {
  476. $logmsg .= $_ . "\n";
  477. $response .= "IGN\t" . $client_query_md5 . "\n";
  478. };
  479. if ($sth->rows < 1) {
  480. $response .= "DUP\t" . $client_query_md5 . "\n";
  481. } else {
  482. $response .= "ACK\t" . $client_query_md5 . "\n";
  483. }
  484. }
  485. elsif ($client_query =~ m/^(?:[^\t]*\t)+[^\t]*/) #look for a list of optionally blank tab-delimited fields
  486. {
  487. my @client_values = split(/[\t]/, $client_query, -1); #the -1 keeps split from trimming trailing blank fields
  488. #0. equip_num
  489. #1. driver
  490. #2. paddle
  491. #3. route
  492. #4. trip
  493. #5. stop
  494. #6. ride_time
  495. #7. latitude
  496. #8. longitude
  497. #9. action
  498. #10. rule
  499. #11. ruleparam
  500. #12. reason
  501. #13. credential
  502. #14. logical_card_id
  503. #15. cash_value
  504. #16. stop_name
  505. #17. (unused by DB) usec
  506. my $duplicate_billing_entry=0;
  507. try {
  508. #$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;
  509. $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;
  510. $sth->execute($client_values[6], $client_query_md5) or die "Couldn't execute statement: " . $sth->errstr;
  511. $duplicate_billing_entry=1 if ($sth->fetchrow_arrayref->[0] > 0);
  512. if (!$duplicate_billing_entry) {
  513. #$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(?), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
  514. $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"), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
  515. or die "Couldn't prepare statement: " . $dbh->errstr;
  516. $sth->execute($client_query_md5, @client_values[0..16]) # Execute the query
  517. or die "Couldn't execute statement: " . $sth->errstr;
  518. }
  519. }
  520. catch {
  521. $logmsg .= $_ . "\n";
  522. $response .= "IGN\t" . $client_query_md5 . "\n";
  523. };
  524. if ($duplicate_billing_entry)
  525. {
  526. $response .= "DUP\t" . $client_query_md5 . "\n";
  527. } elsif ($sth->rows == 1) #if the billing log update was sucessful and wasn't a duplicate
  528. {
  529. AdvanceRiderPass($dbh, $client_values[14], $client_query_md5, unix_to_readable_time($client_values[6]), $client_values[9], $client_values[10]);
  530. $response .= "ACK\t" . $client_query_md5 . "\n";
  531. }
  532. #elsif ($sth->rows > 1)
  533. #{
  534. # $response .= "DUP\t" . $client_query_md5 . "\n";
  535. #}
  536. else
  537. {
  538. $logmsg .= "Error inserting $client_query_md5 $client_query into billing_log\n" ;
  539. }
  540. }
  541. else
  542. {
  543. $logmsg .= "Malformed log entry \"$client_query\".\n";
  544. $response .= "IGN\t" . $client_query_md5 . "\n";
  545. }
  546. print $logmsg if $logmsg;
  547. return $response;
  548. }
  549. sub handle_client()
  550. {
  551. close SERVER;
  552. CLIENT->autoflush(1);
  553. my $linebuffer;
  554. while($linebuffer = <CLIENT>)
  555. {
  556. open LOGFH, ">>$logfile";
  557. print LOGFH $linebuffer;
  558. close LOGFH;
  559. print CLIENT ServerReply($linebuffer);
  560. } #while data from client
  561. close CLIENT;
  562. }
  563. my $waitedpid = 0;
  564. my $sigreceived = 0;
  565. sub REAPER
  566. {
  567. while (($waitedpid = waitpid(-1, WNOHANG))>0) { }
  568. $SIG{CHLD} = \&REAPER; # loathe sysV
  569. $sigreceived = 1;
  570. }
  571. sub spawn
  572. {
  573. my $coderef = shift; #grab the first parameter
  574. unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') #verify that it consists of a non-null block of executable perl code
  575. {
  576. confess "usage: spawn CODEREF"; #complain if this is not the case
  577. }
  578. my $pid;
  579. if (!defined($pid = fork)) #attempt a fork, remembering the returned PID value
  580. {
  581. close CLIENT;
  582. return; #failed to fork, we'd better close the client
  583. }
  584. elsif ($pid) #If the returned process ID is non-zero, that indicates that we are the parent process
  585. {
  586. return; # i'm the parent
  587. }
  588. else #otherwise, if the returned process ID is 0, that means we're the child process
  589. {
  590. exit &$coderef(); #in which case, we want to execute the child handler that was passed in, and then
  591. #exit this (child) process when we've finished our conversation(s) with the
  592. #other (client) end of the socket.
  593. }
  594. }
  595. #----------------------------------------------------------------------
  596. # Local network settings for Inter-Process communication.
  597. #----------------------------------------------------------------------
  598. my $proto = getprotobyname('tcp');
  599. my $addr = sockaddr_in( $bind_port ,inet_aton($bind_ip));;
  600. #----------------------------------------------------------------------
  601. my $max_retries = 10; #Maximum number of address-binding retries before we give up.
  602. my $retry_count = $max_retries; #number of retries left...
  603. my $retry_delay = 3; #number of seconds to wait between retries at binding to our designated IPC address
  604. my $got_network = 0; #flag to let us know that we can quit retrying once we have gotten a valid listening socket
  605. while( ($retry_count > 0) && (!$got_network) )
  606. {
  607. try #Try and allocate a socket, bind it to our IPC address, and set it to listen for connections
  608. {
  609. socket(SERVER,PF_INET,SOCK_STREAM,$proto) || die "socket: $!";
  610. setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
  611. bind (SERVER, $addr) || die "bind: $!";
  612. listen(SERVER,5) || die "listen: $!";
  613. $got_network = 1;
  614. }
  615. catch #If that didn't work for some reason, log the error, clean up, and prepair to retry
  616. {
  617. my $errmsg = $_; #Remember the error message
  618. close(SERVER); #Clean up the server socket if it needs it
  619. #Decrement our remaining retry counter
  620. $retry_count = $retry_count - 1;
  621. #Log the message to our debug log
  622. print "Failed to allocate socket, will retry $retry_count times: $errmsg\n";
  623. #Wait a reasonable period before trying again
  624. sleep $retry_delay;
  625. };
  626. }
  627. if($got_network) #If we met with success binding to the network, report it
  628. {
  629. my $logmsg = "Socket setup successful. Listening for clients at $bind_ip:$bind_port\n";
  630. print $logmsg;
  631. }
  632. else #If we ran out of patience and gave up, report that as well and exit
  633. {
  634. my $errmsg = "Could not allocate and bind listening socket at $bind_ip:$bind_port after $max_retries attempts.\n";
  635. die $errmsg;
  636. }
  637. # Set up our signal handler which will clean up defunct child processes and let the main
  638. # accept() loop know that the reason accept returned was due to a signal, not a legit connection.
  639. $SIG{CHLD} = \&REAPER;
  640. #This for loop is efficient, but confusting, so I'll break it down by clause
  641. #
  642. # The first clause ($sigreceived = 0) clears the signal received flag that will be set if the
  643. # accept() call was interrupted by a signal. This clause runs once before the first run of the loop
  644. #
  645. # The second clause is the test clause, it will process the contents of the loop if EITHER
  646. # accept() has returned (presumably generating a valid file handle for the CLIENT end of the
  647. # socket, OR the signal received flag is set (thus accept would have returned early without
  648. # having actually accepted a connection.
  649. #
  650. # The third clause (the 'incrementer') is run after each time the body is executed, before the
  651. # test clause is executed again (deciding whether to run the body or drop out... This test
  652. # clause will close the parent process' copy of the CLIENT file handle since (see body below)
  653. # after the body executes, all communication with the socket referred to by that file handle
  654. # will be carried out by the spawned child process. This frees the parent's copy of the CLIENT
  655. # file handle to be used again in the parent process for the next accepted incoming connection.
  656. for ( $sigreceived = 0; accept(CLIENT,SERVER) || $sigreceived; $sigreceived = 0, close CLIENT)
  657. {
  658. 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
  659. print "connection received.\n"; #Print a diagnostic message confirming that we have made a connection
  660. spawn sub {handle_client();}; #fork() off a child process that will handle communication with the socket pointed to by the CLIENT file handle
  661. }