popufare/server/scripts/RideLogic.pm

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; $i<scalar(@field); $i++) {
    $ins_query .= ", old_" . $field[$i];
    $tail_ins_query .= ", " . ($pass_id ? $field[$i] : "null" );
  }
  $ins_query .= ") ";
  $tail_ins_query .= ($pass_id ? " from user_pass where user_pass_id = ?" : "");
  $ins_query .= $tail_ins_query;

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $up_query .= ", audit_user_pass.new_".$field[$i] . " = user_pass." . $field[$i];
  }
  $up_query .= " where audit_user_pass.audit_user_pass_id = ? and user_pass.user_pass_id = ? ";

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $ins_query .= ", old_" . $field[$i];
    $tail_ins_query .= ", " . ($card_id ? $field[$i] : "null");
  }
  $ins_query .= ") ";
  $tail_ins_query .= ($card_id ? " from user_card where logical_card_id = ?" : "");
  $ins_query .= $tail_ins_query;

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $up_query .= ", audit_user_card.new_".$field[$i] . " = user_card." . $field[$i];
  }
  $up_query .= " where audit_user_card.audit_user_card_id = ? and user_card.logical_card_id = ? ";

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $ins_query .= ", old_".$field[$i];
    $tail_ins_query .= ", " . ($userid ? $field[$i] : "null");
  }
  $ins_query .= ") ";
  $tail_ins_query .= ($userid ? " from users where userid = ?" : "");
  $ins_query .= $tail_ins_query;

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $up_query .= ", audit_users.new_".$field[$i] . " = users." . $field[$i];
  }
  $up_query .= " where audit_users.audit_users_id = ? and users.userid = ? ";

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $ins_query .= ", old_".$field[$i];
    $tail_ins_query .= ", " . ($userid ? $field[$i] : "null");
  }
  $ins_query .= ") ";
  $tail_ins_query .= ($userid ? " from admins where userid = ?" : "");
  $ins_query .= $tail_ins_query;

  my $query = $dbh->prepare($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; $i<scalar(@field); $i++) {
    $up_query .= ", audit_admins.new_".$field[$i] . " = admins." . $field[$i];
  }
  $up_query .= " where audit_admins.audit_admins_id = ? and admins.userid = ? ";

  my $query = $dbh->prepare($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;