billing_server.pl 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811
  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. print "#bill: cp0\n";
  142. my $passid = $href->{'user_pass_id'};
  143. my $current_q_num = $href->{'queue_order'};
  144. # expire old pass
  145. my $audit_pass_id = audit_user_pass_start($dbh, $passid, "billing_server: ExpirePass: deactivating and expiring pass");
  146. $query = $dbh->prepare("update user_pass set active = 0, expired = 1, deactivated = " . ($isMySQL ? "now()" : "datetime('now', 'localtime')") . " where user_pass_id = ?");
  147. $query->execute($passid);
  148. audit_user_pass_end($dbh, $passid, $audit_pass_id);
  149. print "#bill: cp1\n";
  150. # activate new pass
  151. $query = $dbh->prepare("select p.user_pass_id, p.rule, p.nday_orig, p.nday_expiration, p.nrides_orig, p.queue_order, rc.ruleclass
  152. from user_pass p, rule_class rc
  153. where p.logical_card_id = ?
  154. and p.expired = 0 and p.rule = rc.rulename
  155. and p.queue_order = ( select min(t.queue_order)
  156. from user_pass t
  157. where t.logical_card_id = ?
  158. and t.queue_order > ?
  159. and t.expired = 0) ");
  160. $query->execute($cardid, $cardid, $current_q_num);
  161. print "#bill: cp2\n";
  162. $href = $query->fetchrow_hashref;
  163. # no passes left, put in reject rule, finish transaction
  164. if ($query->rows == 0) {
  165. if ($isMySQL) {
  166. $query = $dbh->prepare("lock tables active_rider_table write");
  167. $query->execute();
  168. }
  169. $query = $dbh->prepare("insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, notes)
  170. values (?,?,?,?,?,?,?)");
  171. $query->execute($cardid, @oldrow[1,2], $ORG . '-REJECT', 'reject', 0, $oldrow[7]);
  172. $dbh->commit;
  173. if ($isMySQL) {
  174. $query = $dbh->prepare("unlock tables");
  175. $query->execute();
  176. }
  177. return;
  178. }
  179. print "#bill: cp3\n";
  180. # else make new pass active and update art with new pass
  181. #$href = $query->fetchrow_hashref;
  182. my $pass_param = '';
  183. if ($href->{'ruleclass'} eq 'NRIDE') {
  184. $pass_param = $href->{'nrides_orig'};
  185. } elsif ($href->{'ruleclass'} eq 'NDAY') {
  186. $pass_param = $href->{'nday_orig'};
  187. $pass_param .= " " . $href->{'nday_expiration'} if $href->{'nday_expiration'};
  188. }
  189. $audit_pass_id = audit_user_pass_start($dbh, $href->{'user_pass_id'}, "billing_server: ExpirePass: activating pass");
  190. $query = $dbh->prepare("update user_pass set active = 1, activated = ? where user_pass_id = ?");
  191. $query->execute($ride_time, $href->{'user_pass_id'} );
  192. audit_user_pass_end($dbh, $href->{'user_pass_id'}, $audit_pass_id);
  193. print "#bill: cp4\n";
  194. if ($isMySQL) {
  195. $query = $dbh->prepare("lock tables active_rider_table write");
  196. $query->execute();
  197. }
  198. $query = $dbh->prepare("insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, notes)
  199. values (?,?,?,?,?,?,?)");
  200. $query->execute($cardid, @oldrow[1,2], $href->{'rule'}, $pass_param, 0, $oldrow[7]);
  201. $dbh->commit;
  202. if ($isMySQL) {
  203. $query = $dbh->prepare("unlock tables");
  204. $query->execute();
  205. }
  206. print "#bill: cp5\n";
  207. }
  208. sub AdvanceRiderPass {
  209. my $dbh = shift;
  210. my $logical_card_id = shift;
  211. my $billing_cksum = shift;
  212. my $billing_ride_time = shift;
  213. my $billing_action = shift;
  214. my $billing_rule = shift;
  215. local $dbh->{RaiseError};
  216. local $dbh->{PrintError};
  217. $dbh->{RaiseError} = 1;
  218. $dbh->{PrintError} = 1;
  219. print "#bill: advance: cp0, logical_card_id " . $logical_card_id . "\n";
  220. $dbh->begin_work;
  221. # my $sth_find = $dbh->prepare('SELECT active_rider_table.logical_card_id, active_rider_table.rfid_token,
  222. # active_rider_table.mag_token, active_rider_table.rule_name,
  223. # active_rider_table.rule_param, active_rider_table.deleted,
  224. # active_rider_table.parent_entity, active_rider_table.notes,
  225. # active_rider_table.seq_num
  226. # FROM active_rider_table
  227. # WHERE logical_card_id = ?
  228. # AND NOT(deleted)
  229. # AND seq_num = (SELECT max(seq_num) FROM active_rider_table WHERE logical_card_id = ?) ');
  230. # my $xx = $sth_find->execute($logical_card_id, $logical_card_id);
  231. my $sth_find = $dbh->prepare('SELECT active_rider_table.logical_card_id, active_rider_table.rfid_token,
  232. active_rider_table.mag_token, active_rider_table.rule_name,
  233. active_rider_table.rule_param, active_rider_table.deleted,
  234. active_rider_table.parent_entity, active_rider_table.notes,
  235. active_rider_table.seq_num
  236. FROM active_rider_table
  237. WHERE logical_card_id = ?
  238. AND NOT(deleted)
  239. order by seq_num desc limit 1;');
  240. $sth_find->execute($logical_card_id);
  241. #if ($sth_find->rows != 1) { $dbh->commit; return; }
  242. #@oldrow:
  243. #0. logical_card_id
  244. #1. rfid_token
  245. #2. mag_token
  246. #3. rule_name
  247. #4. rule_param
  248. #5. deleted
  249. #6. parent_entity
  250. #7. notes
  251. #8. seq_num
  252. my @oldrow = $sth_find->fetchrow_array();
  253. if (not @oldrow) { $dbh->commit; return; }
  254. print ">> $logical_card_id, $billing_ride_time\n";
  255. my $sth_pass = $dbh->prepare("select p.user_pass_id, p.nrides_remain, p.nday_orig, p.nday_expiration, p.rule
  256. from user_pass p, user_card c
  257. where p.logical_card_id = ?
  258. and c.logical_card_id = p.logical_card_id
  259. and c.active = 1
  260. and p.active = 1
  261. and p.expired = 0
  262. and p.activated <= ?");
  263. $sth_pass->execute($logical_card_id, $billing_ride_time);
  264. my $pass = $sth_pass->fetchrow_hashref;
  265. if ($pass) {
  266. print ">>>>" . $pass . "\n";
  267. print " ok?\n";
  268. }
  269. if ($sth_pass->rows != 1) {
  270. if (uc($billing_action) ne "REJECT") {
  271. my $sth;
  272. if ($isMySQL) {
  273. $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  274. values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', dropping billing entry: no matching pass entry') ) ");
  275. } else {
  276. $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  277. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', dropping billing entry: no matching pass entry' ) ");
  278. }
  279. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
  280. }
  281. $dbh->commit;
  282. return;
  283. }
  284. print "#bill: advance: cp2\n";
  285. #my $pass = $sth_pass->fetchrow_hashref;
  286. my $t = $dbh->prepare("select ruleclass from rule_class where rulename = ?");
  287. $t->execute($pass->{'rule'});
  288. my $tref = $t->fetchrow_hashref;
  289. print ">>> \$t->rows " . $t->rows . "\n";
  290. my $rule_class = 'OTHER';
  291. if ($t->rows == 1) {
  292. #$rule_class = $t->fetchrow_hashref->{'ruleclass'};
  293. $rule_class = $tref->{'ruleclass'};
  294. } elsif ($t->rows < 1) {
  295. my $sth;
  296. if ($isMySQL) {
  297. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  298. values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', no rule class found, dropping billing entry') ) ");
  299. } else {
  300. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  301. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', no rule class found, dropping billing entry' ) ");
  302. }
  303. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
  304. $dbh->commit;
  305. return;
  306. } else {
  307. my $sth;
  308. if ($isMySQL) {
  309. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  310. values ('warning', concat('billing_server: logical_card_id ', ?, ', billing_cksum ', ?, ', art seq_num ', ?, ', multiple rule classes found, dropping billing entry') ) ");
  311. } else {
  312. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  313. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', multiple rule classes found, dropping billing entry' ) ");
  314. }
  315. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8]);
  316. $dbh->commit;
  317. return;
  318. }
  319. print "#bill: advance: cp3\n";
  320. if (uc($billing_action) eq "REJECT") {
  321. # bus not sync'd?
  322. $dbh->commit;
  323. } elsif ($oldrow[3] ne $pass->{'rule'}) {
  324. # raise warning?
  325. my $sth;
  326. if ($isMySQL) {
  327. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  328. values ('warning', concat('billing_server: logical_card_id ',?,', billing_cksum ',?,', art seq_num ',?,', rule mismatch(1): art rule \"',?,'\" != user_pass_id ',?,' rule \"',?,'\"') )");
  329. } else {
  330. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  331. values ('warning', 'billing_server: logical_card_id ' || ? || ', billing_cksum ' || ? || ', art seq_num ' || ? || ', rule mismatch(1): art rule \"' || ? || '\" != user_pass_id ' || ? || ' rule \"' || ? || '\"' )");
  332. }
  333. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8], $oldrow[3], $pass->{'user_pass_id'}, $pass->{'rule'});
  334. $dbh->commit;
  335. } elsif ($billing_rule ne $pass->{'rule'}) {
  336. # bus got out of sync with art? give user this pass at the risk to prevent against
  337. # decrementing an nride when an nday (or something else) was reported
  338. my $sth = $dbh->prepare("insert into diagnostic_log (loglvl, message)
  339. values ('warning', concat('billing_server: logical_card_id ',?,', billing_cksum ',?,', art seq_num ',?,', rule mismatch(2): billing rule \"',?,'\" != user_pass_id ',?,' rule \"',?,'\"' ) )");
  340. $sth->execute($logical_card_id, $billing_cksum, $oldrow[8], $billing_rule, $pass->{'user_pass_id'}, $pass->{'rule'});
  341. $dbh->commit;
  342. } elsif ( $rule_class eq 'NRIDE') {
  343. my $cur_rides = (($pass->{'nrides_remain'} > 0) ? ($pass->{'nrides_remain'}-1) : 0 );
  344. $oldrow[4] = $cur_rides;
  345. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nride");
  346. my $q = $dbh->prepare('update user_pass set nrides_remain = ?, lastused = ? where user_pass_id = ?');
  347. $q->execute($cur_rides, $billing_ride_time, $pass->{'user_pass_id'});
  348. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  349. # expire passes will take care of it if #rides == 0
  350. if ($cur_rides>0) {
  351. if ($isMySQL) {
  352. $q = $dbh->prepare("lock tables active_rider_table write");
  353. $q->execute();
  354. }
  355. $q = $dbh->prepare('insert into active_rider_table (logical_card_id, rfid_token, mag_token, rule_name, rule_param, deleted, parent_entity, notes)
  356. values (?, ?, ?,?, ?, ?, ?, ?)');
  357. $q->execute(@oldrow[0..7]);
  358. }
  359. $dbh->commit;
  360. if ($cur_rides>0) {
  361. if ($isMySQL) {
  362. $q = $dbh->prepare("unlock tables");
  363. $q->execute();
  364. }
  365. }
  366. } elsif ($rule_class eq 'NDAY') {
  367. print "#>> nday expiration " . $pass->{'nday_expiration'} . "\n";
  368. # update user_pass with expiration and update active_rider_table with new param
  369. if (!$pass->{'nday_expiration'}) {
  370. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nday");
  371. my $q;
  372. if ($isMySQL) {
  373. my $q = $dbh->prepare("update user_pass
  374. set nday_expiration = addtime( adddate(convert(date(?), datetime), nday_orig), '2:30'), firstused = ?, lastused = ?
  375. where user_pass_id = ?");
  376. $q->execute($billing_ride_time, $billing_ride_time, $billing_ride_time, $pass->{'user_pass_id'});
  377. } else {
  378. my $q = $dbh->prepare("update user_pass
  379. set nday_expiration = strftime('%Y-%m-%d %H:%M:%S', date(?, '+? days'), '+150 minutes'), firstused = ?, lastused = ?
  380. where user_pass_id = ?");
  381. $q->execute($billing_ride_time, $billing_ride_time, $billing_ride_time, $pass->{'user_pass_id'});
  382. }
  383. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  384. $oldrow[4] = $pass->{'nday_orig'} . " " . join('-', Add_Delta_Days(Today, $pass->{'nday_orig'} )) . " 2:30:00";
  385. if ($isMySQL) {
  386. $q = $dbh->prepare("lock tables active_rider_table write"); $q->execute();
  387. }
  388. 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)
  389. VALUES (?, ?, ?, ?, ?, ?, ?, ?)');
  390. $sth_new_expires->execute(@oldrow[0..7]);
  391. $dbh->commit;
  392. if ($isMySQL) {
  393. $q = $dbh->prepare("unlock tables");
  394. $q->execute();
  395. }
  396. } else { # else just update last used
  397. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating nday (lastused only)");
  398. my $q = $dbh->prepare("update user_pass set lastused = ? where user_pass_id = ? and (lastused is null or lastused < ?)");
  399. $q->execute($billing_ride_time, $pass->{'user_pass_id'}, $billing_ride_time);
  400. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  401. $dbh->commit;
  402. }
  403. } else {
  404. # domain card, do nothing
  405. my $audit_pass_id = audit_user_pass_start($dbh, $pass->{'user_pass_id'}, "billing_server: AdvanceRiderPass: updating domain (lastused only)");
  406. my $q = $dbh->prepare("update user_pass set lastused = ? where user_pass_id = ? and (lastused is null or lastused < ?)");
  407. $q->execute($billing_ride_time, $pass->{'user_pass_id'}, $billing_ride_time);
  408. audit_user_pass_end($dbh, $pass->{'user_pass_id'}, $audit_pass_id);
  409. $dbh->commit;
  410. }
  411. print "#bill: advance: cp4\n";
  412. ExpirePass( $dbh, $logical_card_id, $pass->{'user_pass_id'}, $billing_ride_time, @oldrow );
  413. print "#bill: advance: cp5\n";
  414. }
  415. sub ServerReply
  416. {
  417. my $client_query = $_[0];
  418. $/="\n";
  419. chomp($client_query);
  420. my $response = "";
  421. my $client_query_md5 = md5_hex($client_query);
  422. my $dbh = DBI->connect($database_path, $database_user, $database_pass)
  423. or die "Couldn't connect to database: " . DBI->errstr;
  424. my $sth ;
  425. my $loglvl ;
  426. my $message ;
  427. my $logmsg ;
  428. if ($client_query =~ m/^[\s\x00]*$/)
  429. {
  430. $logmsg .= "Ignoring spurious blank line.\n";
  431. $response .= "IGN\t" . $client_query_md5 . "\n";
  432. }
  433. elsif ($client_query =~ m/^\!/) #error
  434. {
  435. $loglvl = "error";
  436. $message = $client_query;
  437. $message =~ s/^.//;
  438. try {
  439. $sth = $dbh->prepare('INSERT ' . ($isMySQL ? '' : ' OR ') . 'IGNORE INTO diagnostic_log (loglvl, message) VALUES (?, ?)')
  440. or die "Couldn't prepare statement: " . $dbh->errstr;
  441. $sth->execute($loglvl, $message) # Execute the query
  442. or die "Couldn't execute statement: " . $sth->errstr;
  443. if (not $isMySQL) { $sth->fetch; }
  444. }
  445. catch {
  446. $logmsg .= $_ . "\n";
  447. $response .= "IGN\t" . $client_query_md5 . "\n";
  448. };
  449. if ($sth->rows < 1) {
  450. $response .= "DUP\t" . $client_query_md5 . "\n";
  451. } else {
  452. $response .= "ACK\t" . $client_query_md5 . "\n";
  453. }
  454. }
  455. elsif ($client_query =~ m/^\*/) #warning
  456. {
  457. $loglvl = "warning";
  458. $message = $client_query;
  459. $message =~ s/^.//;
  460. try {
  461. $sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log (loglvl, message) VALUES (?, ?)')
  462. or die "Couldn't prepare statement: " . $dbh->errstr;
  463. $sth->execute($loglvl, $message) # Execute the query
  464. or die "Couldn't execute statement: " . $sth->errstr;
  465. }
  466. catch {
  467. $logmsg .= $_ . "\n";
  468. $response .= "IGN\t" . $client_query_md5 . "\n";
  469. };
  470. if ($sth->rows < 1) {
  471. $response .= "DUP\t" . $client_query_md5 . "\n";
  472. } else {
  473. $response .= "ACK\t" . $client_query_md5 . "\n";
  474. }
  475. }
  476. elsif ($client_query =~ m/^\#/) #debug
  477. {
  478. $loglvl = "debug";
  479. $message = $client_query;
  480. $message =~ s/^.//;
  481. try {
  482. $sth = $dbh->prepare('INSERT IGNORE INTO diagnostic_log (loglvl, message) VALUES (?, ?)')
  483. or die "Couldn't prepare statement: " . $dbh->errstr;
  484. $sth->execute($loglvl, $message) # Execute the query
  485. or die "Couldn't execute statement: " . $sth->errstr;
  486. }
  487. catch {
  488. $logmsg .= $_ . "\n";
  489. $response .= "IGN\t" . $client_query_md5 . "\n";
  490. };
  491. if ($sth->rows < 1) {
  492. $response .= "DUP\t" . $client_query_md5 . "\n";
  493. } else {
  494. $response .= "ACK\t" . $client_query_md5 . "\n";
  495. }
  496. }
  497. elsif ($client_query =~ m/^(?:[^\t]*\t)+[^\t]*/) #look for a list of optionally blank tab-delimited fields
  498. {
  499. my @client_values = split(/[\t]/, $client_query, -1); #the -1 keeps split from trimming trailing blank fields
  500. #0. equip_num
  501. #1. driver
  502. #2. paddle
  503. #3. route
  504. #4. trip
  505. #5. stop
  506. #6. ride_time
  507. #7. latitude
  508. #8. longitude
  509. #9. action
  510. #10. rule
  511. #11. ruleparam
  512. #12. reason
  513. #13. credential
  514. #14. logical_card_id
  515. #15. cash_value
  516. #16. stop_name
  517. #17. (unused by DB) usec
  518. my $duplicate_billing_entry=0;
  519. try {
  520. #$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;
  521. $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;
  522. $sth->execute($client_values[6], $client_query_md5) or die "Couldn't execute statement: " . $sth->errstr;
  523. $duplicate_billing_entry=1 if ($sth->fetchrow_arrayref->[0] > 0);
  524. if (!$duplicate_billing_entry) {
  525. #$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(?), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
  526. $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"), ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')
  527. or die "Couldn't prepare statement: " . $dbh->errstr;
  528. $sth->execute($client_query_md5, @client_values[0..16]) # Execute the query
  529. or die "Couldn't execute statement: " . $sth->errstr;
  530. }
  531. }
  532. catch {
  533. $logmsg .= $_ . "\n";
  534. $response .= "IGN\t" . $client_query_md5 . "\n";
  535. };
  536. if ($duplicate_billing_entry)
  537. {
  538. $response .= "DUP\t" . $client_query_md5 . "\n";
  539. } elsif ($sth->rows == 1) #if the billing log update was sucessful and wasn't a duplicate
  540. {
  541. AdvanceRiderPass($dbh, $client_values[14], $client_query_md5, unix_to_readable_time($client_values[6]), $client_values[9], $client_values[10]);
  542. $response .= "ACK\t" . $client_query_md5 . "\n";
  543. }
  544. #elsif ($sth->rows > 1)
  545. #{
  546. # $response .= "DUP\t" . $client_query_md5 . "\n";
  547. #}
  548. else
  549. {
  550. $logmsg .= "Error inserting $client_query_md5 $client_query into billing_log\n" ;
  551. }
  552. }
  553. else
  554. {
  555. $logmsg .= "Malformed log entry \"$client_query\".\n";
  556. $response .= "IGN\t" . $client_query_md5 . "\n";
  557. }
  558. print $logmsg if $logmsg;
  559. return $response;
  560. }
  561. sub handle_client()
  562. {
  563. close SERVER;
  564. CLIENT->autoflush(1);
  565. my $linebuffer;
  566. while($linebuffer = <CLIENT>)
  567. {
  568. ## DEBUG
  569. print "## billing: $linebuffer\n";
  570. open LOGFH, ">>$logfile";
  571. print LOGFH $linebuffer;
  572. close LOGFH;
  573. print CLIENT ServerReply($linebuffer);
  574. } #while data from client
  575. close CLIENT;
  576. }
  577. my $waitedpid = 0;
  578. my $sigreceived = 0;
  579. sub REAPER
  580. {
  581. while (($waitedpid = waitpid(-1, WNOHANG))>0) { }
  582. $SIG{CHLD} = \&REAPER; # loathe sysV
  583. $sigreceived = 1;
  584. }
  585. sub spawn
  586. {
  587. my $coderef = shift; #grab the first parameter
  588. unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') #verify that it consists of a non-null block of executable perl code
  589. {
  590. confess "usage: spawn CODEREF"; #complain if this is not the case
  591. }
  592. my $pid;
  593. if (!defined($pid = fork)) #attempt a fork, remembering the returned PID value
  594. {
  595. close CLIENT;
  596. return; #failed to fork, we'd better close the client
  597. }
  598. elsif ($pid) #If the returned process ID is non-zero, that indicates that we are the parent process
  599. {
  600. return; # i'm the parent
  601. }
  602. else #otherwise, if the returned process ID is 0, that means we're the child process
  603. {
  604. exit &$coderef(); #in which case, we want to execute the child handler that was passed in, and then
  605. #exit this (child) process when we've finished our conversation(s) with the
  606. #other (client) end of the socket.
  607. }
  608. }
  609. #----------------------------------------------------------------------
  610. # Local network settings for Inter-Process communication.
  611. #----------------------------------------------------------------------
  612. my $proto = getprotobyname('tcp');
  613. my $addr = sockaddr_in( $bind_port ,inet_aton($bind_ip));;
  614. #----------------------------------------------------------------------
  615. my $max_retries = 10; #Maximum number of address-binding retries before we give up.
  616. my $retry_count = $max_retries; #number of retries left...
  617. my $retry_delay = 3; #number of seconds to wait between retries at binding to our designated IPC address
  618. my $got_network = 0; #flag to let us know that we can quit retrying once we have gotten a valid listening socket
  619. while( ($retry_count > 0) && (!$got_network) )
  620. {
  621. try #Try and allocate a socket, bind it to our IPC address, and set it to listen for connections
  622. {
  623. socket(SERVER,PF_INET,SOCK_STREAM,$proto) || die "socket: $!";
  624. setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
  625. bind (SERVER, $addr) || die "bind: $!";
  626. listen(SERVER,5) || die "listen: $!";
  627. $got_network = 1;
  628. }
  629. catch #If that didn't work for some reason, log the error, clean up, and prepair to retry
  630. {
  631. my $errmsg = $_; #Remember the error message
  632. close(SERVER); #Clean up the server socket if it needs it
  633. #Decrement our remaining retry counter
  634. $retry_count = $retry_count - 1;
  635. #Log the message to our debug log
  636. print "Failed to allocate socket, will retry $retry_count times: $errmsg\n";
  637. #Wait a reasonable period before trying again
  638. sleep $retry_delay;
  639. };
  640. }
  641. if($got_network) #If we met with success binding to the network, report it
  642. {
  643. my $logmsg = "Socket setup successful. Listening for clients at $bind_ip:$bind_port\n";
  644. print $logmsg;
  645. }
  646. else #If we ran out of patience and gave up, report that as well and exit
  647. {
  648. my $errmsg = "Could not allocate and bind listening socket at $bind_ip:$bind_port after $max_retries attempts.\n";
  649. die $errmsg;
  650. }
  651. # Set up our signal handler which will clean up defunct child processes and let the main
  652. # accept() loop know that the reason accept returned was due to a signal, not a legit connection.
  653. $SIG{CHLD} = \&REAPER;
  654. #This for loop is efficient, but confusting, so I'll break it down by clause
  655. #
  656. # The first clause ($sigreceived = 0) clears the signal received flag that will be set if the
  657. # accept() call was interrupted by a signal. This clause runs once before the first run of the loop
  658. #
  659. # The second clause is the test clause, it will process the contents of the loop if EITHER
  660. # accept() has returned (presumably generating a valid file handle for the CLIENT end of the
  661. # socket, OR the signal received flag is set (thus accept would have returned early without
  662. # having actually accepted a connection.
  663. #
  664. # The third clause (the 'incrementer') is run after each time the body is executed, before the
  665. # test clause is executed again (deciding whether to run the body or drop out... This test
  666. # clause will close the parent process' copy of the CLIENT file handle since (see body below)
  667. # after the body executes, all communication with the socket referred to by that file handle
  668. # will be carried out by the spawned child process. This frees the parent's copy of the CLIENT
  669. # file handle to be used again in the parent process for the next accepted incoming connection.
  670. for ( $sigreceived = 0; accept(CLIENT,SERVER) || $sigreceived; $sigreceived = 0, close CLIENT)
  671. {
  672. 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
  673. print "connection received.\n"; #Print a diagnostic message confirming that we have made a connection
  674. spawn sub {handle_client();}; #fork() off a child process that will handle communication with the socket pointed to by the CLIENT file handle
  675. }