package RideLogic; use strict; use POSIX; require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.01"; @ISA = qw(Exporter); #@EXPORT = qw( daemonize # read_config # strip_whitespace # try # catch ); #@EXPORT_OK = qw( daemonize # read_config # strip_whitespace # try # catch ); #%EXPORT_TAGS = ( DEFAULT => [qw( &daemonize # &read_config # &strip_whitespace # &try # &catch )] ); @EXPORT = qw( audit_user_card_start audit_user_card_end audit_user_pass_start audit_user_pass_end audit_users_start audit_users_end audit_admins_start audit_admins_end daemonize read_config strip_whitespace try catch ); @EXPORT_OK = qw( audit_user_card_start audit_user_card_end audit_user_pass_start audit_user_pass_end audit_users_start audit_users_end audit_admins_start audit_admins_end daemonize read_config strip_whitespace try catch ); %EXPORT_TAGS = ( DEFAULT => [qw( &audit_user_card_start &audit_user_card_end &audit_user_pass_start &audit_user_pass_end &audit_users_start &audit_users_end &audit_admins_start &audit_admins_end &daemonize &read_config &strip_whitespace &try &catch )] ); our @ISA = qw(Exporter); our $VERSION="0.1"; our $RIDELOGIC_DAEMON_CONF="/etc/ridelogic/daemon.conf"; our $RIDELOGIC_DAEMON_LOG_DIR="/var/log/ridelogic"; our $RIDELOGIC_DAEMON_PID_DIR="/var/run/ridelogic"; our $RIDELOGIC_API_CONF="/etc/ridelogic/api.conf"; our $RIDELOGIC_IS_SQLITE=1; sub audit_user_pass_start { my $dbh = shift; my $pass_id = shift; my $comment = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return -1; } my @field = qw( user_pass_id logical_card_id issued activated firstused lastused nrides_orig nrides_remain nday_orig nday_expiration active rule queue_order comment expired paytype deactivated ); my $ins_query = " insert into audit_user_pass ( timestamp, comment, old_" . $field[0]; my $tail_ins_query = " select " . ($isSqlite ? "datetime('now', 'localtime')" : "now()") . ", ?, " . ($pass_id ? $field[0] : "null"); for (my $i=1; $iprepare($ins_query); my $response = ($pass_id ? $query->execute($comment, $pass_id) : $query->execute($comment)); return ($dbh->last_insert_id(undef, undef, undef, undef)); } sub audit_user_pass_end { my $dbh = shift; my $pass_id = shift; my $audit_id = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return; } my @field = qw( user_pass_id logical_card_id issued activated firstused lastused nrides_orig nrides_remain nday_orig nday_expiration active rule queue_order comment expired paytype deactivated ); my $up_query = " update audit_user_pass, user_pass set audit_user_pass.new_" . $field[0] . " = user_pass." . $field[0]; for (my $i=1; $iprepare($up_query); my $response = $query->execute($audit_id, $pass_id); } sub audit_user_card_start { my $dbh = shift; my $card_id = shift; my $comment = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return -1; } my @field = qw( logical_card_id mag_token rfid_token comment lastused userid issued firstused group_id active deactivated issuetype ); my $ins_query = " insert into audit_user_card ( timestamp, comment, old_" . $field[0]; my $tail_ins_query = " select " . ($isSqlite ? "datetime('now', 'localtime')" : "now()") . ", ?, " . ($card_id ? $field[0] : "null"); for (my $i=1; $iprepare($ins_query); my $response = ($card_id ? $query->execute($comment, $card_id) : $query->execute($comment) ); return ($dbh->last_insert_id(undef, undef, undef, undef)); } sub audit_user_card_end { my $dbh = shift; my $card_id = shift; my $audit_id = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return; } my @field = qw( logical_card_id mag_token rfid_token comment lastused userid issued firstused group_id active deactivated issuetype ); my $up_query = " update audit_user_card, user_card set audit_user_card.new_" . $field[0] . " = user_card." . $field[0]; for (my $i=1; $iprepare($up_query); my $response = $query->execute($audit_id, $card_id); } sub audit_users_start { my $dbh = shift; my $userid = shift; my $comment = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return -1; } my @field = qw( username passwordhash userid comment first_name last_name phone email address city state zip created active shipping_address shipping_city shipping_state shipping_zip shipping_name shipping_country_code shipping_country_name reset_attempts ); my $ins_query = " insert into audit_users ( timestamp, comment, old_" . $field[0]; my $tail_ins_query = " select " . ($isSqlite ? "datetime('now', 'localtime')" : "now()") . ", ?, " . ($userid ? $field[0] : "null"); for (my $i=1; $iprepare($ins_query); my $response = ($userid ? $query->execute($comment, $userid) : $query->execute($comment) ); return ($dbh->last_insert_id(undef, undef, undef, undef)); } sub audit_users_end { my $dbh = shift; my $userid = shift; my $audit_id = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return; } my @field = qw( username passwordhash userid comment first_name last_name phone email address city state zip created active shipping_address shipping_city shipping_state shipping_zip shipping_name shipping_country_code shipping_country_name reset_attempts ); my $up_query = " update audit_users, users set audit_users.new_" . $field[0] . " = users." . $field[0]; for (my $i=1; $iprepare($up_query); my $response = $query->execute($audit_id, $userid); } sub audit_admins_start { my $dbh = shift; my $userid = shift; my $comment = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return -1; } my @field = qw( username password userid ); my $ins_query = " insert into audit_admins ( timestamp, comment, old_" . $field[0]; my $tail_ins_query = " select " . ($isSqlite ? "datetime('now', 'localtime')" : "now()") . ", ?, " . ($userid ? $field[0] : "null"); for (my $i=1; $iprepare($ins_query); my $response = ($userid ? $query->execute($comment, $userid) : $query->execute($comment) ); return ($dbh->last_insert_id(undef, undef, undef, undef)); } sub audit_admins_end { my $dbh = shift; my $userid = shift; my $audit_id = shift; my $isSqlite = $RIDELOGIC_IS_SQLITE; if ($isSqlite) { return; } my @field = qw( username password userid ); my $up_query = " update audit_admins, admins set audit_admins.new_" . $field[0] . " = admins." . $field[0]; for (my $i=1; $iprepare($up_query); my $response = $query->execute($audit_id, $userid); } #----------------------------------------------Ugly exception handling logic using closures and anonymous functions---- #-------------------------------------------This is in there to deal with the fact that CreditCall uses the die("error") #-------------------------------------------function instead of returning an error message in many cases... # This utility function returns the passed string sans any leading or trailing whitespace. # sub strip_whitespace { my $str = shift; #grab our first parameter $str =~ s/^\s+//; #strip leading whitespace $str =~ s/\s+$//; #strip trailing whitespace return $str; #return the improved string } # This function takes two coderef parameters, the second of which is usually an explicit call to the # 'catch' function which itself takes a coderef parameter. This allows the code employing this suite of # functions to look somewhat like a conventional exception handling mechanism: # # try # { # do_something_that_might_die(); # } # catch # { # my $errmsg = $_; # log_the_error_message($errmsg); # perform_some_cleanup(); # }; # # DO NOT FORGET THAT LAST SEMICOLON, EVERYTHING GOES TO HELL IF YOU DO! # sub try(&$) { my ($attempt, $handler) = @_; eval { &$attempt; }; if($@) { do_catch($handler); } } # This function strips off the whitespace from the exception message reported by die() # and places the result into the default variable such that the code in the catch block can # just examine $_ to figure out what the cause of the error is, or to display or log # the error message. # sub do_catch(&$) { my ($handler) = @_; local $_ = strip_whitespace($@); &$handler; } # This just takes an explicit coderef and returns it unharmed. The only # purpose of this is so the try/catch structure looks pretty and familiar. # sub catch(&) {$_[0]} sub read_config { my $cfg_file = shift; my $cfg_href = shift; try { open my $fh, "$cfg_file"; while (<$fh>) { next if /^#/; chomp; s/^\s+//; s/\s+$//; next if !$_; my ($var, $val) = split(/=/, $_); $cfg_href->{$var} = $val; } close $fh; } catch { my $errmsg = $_; die "Error processing config file $cfg_file, '$errmsg'. exiting\n"; }; } sub daemonize { my $logfile = shift; my $pidfile = shift; my ($untainted_lf, $untainted_pf); $untainted_lf = $1 if ($logfile =~ /^([^\0]+)$/); $untainted_pf = $1 if ($pidfile =~ /^([^\0]+)$/); try { chdir '/'; umask 0; open STDIN, '/dev/null'; open STDOUT, '/dev/null'; open STDERR, '/dev/null'; my $pid = fork; exit if $pid; setsid; if ($untainted_lf) { close STDOUT; close STDERR; sysopen( STDOUT, $untainted_lf, O_WRONLY|O_APPEND|O_CREAT, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH ); sysopen( STDERR, $untainted_lf, O_WRONLY|O_APPEND|O_CREAT, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH ); } if ($untainted_pf) { sysopen( my $fh, $untainted_pf, O_WRONLY|O_APPEND|O_CREAT, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH ); #open my $fh, ">$untainted_pf"; print $fh $$, "\n"; close $fh ; } } catch { my $errmsg = $_; die "Failed to daemonize: '$errmsg', exiting\n"; }; } return 1;