billing_server.pl 29 KB

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