#!/usr/bin/perl

# $Id: nec_smdr 2593 2016-03-22 16:01:13Z jhealy $

# nec_smdr
#
# Reads call accounting data from our NEC phone switch over a serial
# terminal, parses the output, ans stores in a relational database for
# reporting.
#
# Jason Healy <jhealy@suffieldacademy.org>
#
# See http://web.suffieldacademy.org/ils/netadmin/software/smdr/
# for more information about this script.
#

use warnings;
use strict;

# Try to figure out our own hostname
use Sys::Hostname;

# Include modules for accessing the serial port directly
# (Debian: libdevice-serialport-perl)
use Device::SerialPort;

# Database connection modules
# (Debian: libdbd-pg-perl)
use DBI;

# Date parsing
use Time::Local;

# Log errors to syslog instead of console
# (Debian: libunix-syslog-perl)
use Unix::Syslog qw(:macros :subs);

# Dump out data that won't go in the DB
use Data::Dumper;

# Use POSIX to allow for disassociation from terminal
use POSIX 'setsid';

# get our hostname
my $HOSTNAME = hostname;

# Serial port to listen on
my $PORT = '/dev/ttyS0';

# Number of bytes to read for each record
my $RECORD_BYTES = 132;
my $RECORD_INCOMPLETE = $RECORD_BYTES-1;

# PID file to write to
my $PIDFILE = '/var/run/nec_smdr';

# Set to 0 to stop running
my $RUNNING = 1;

# Sleep time (use a binary backoff algorithm)
my $snooze = 1;

# number of retries to insert records into the database
my $MAX_RETRYS = 10;
my $retry = $MAX_RETRYS;

# Check for debug flag
my $DEBUG = 0;
if ($#ARGV > -1 && $ARGV[0] eq '-D') {
  $DEBUG = 1;
  print "Started in debug mode\n";
}

# by default, detach and background
my $DAEMON = 1;
# unless the user asked us not to...
if ($DEBUG || $#ARGV > -1 && $ARGV[0] eq '-f') {
  $DAEMON = 0;
  print "Foreground mode requested; not disassociating from terminal\n";
}

# Database settings
my $DBHOST = 'postgresql.suffieldacademy.org';
my $DBUSER = 'nec_accounting';

# read the SQL database password from a file
my $DBPASS_FILE = '/etc/nec_smdr_postgres_password';
my $DBPASS = '';

open(DBPASS, $DBPASS_FILE) or
  die "Couldn't read Postgres password file '$DBPASS_FILE': $1\n";

chomp($DBPASS = <DBPASS>);

close(DBPASS);

# Sample call accounting lines (broken over three lines):
#
# Line:  .0!KA0100170015555  10091441191009144853          
# Count: 01234567890123456789012345678901234567890123456789
#                  1         2         3         4
#
# Line:  00100401001018008002775                     
# Count: 01234567890123456789012345678901234567890123
#        5         6         7         8         9
#
# Line:  0000                  06060          .
# Count: 45678901234567890123456789012345678901
#              0         1         2         3
#              1         1         1         1

# Freaky line from 2008-07-30 (note lack of white space 18-19 and weird number
# consisting of only 0 and 1):
#.0!KE01000120101001407302024070730202411          001000010000           
#                     0000                  0808           .
# 2008-08-01:
#.0!KA01002320101001708010808170801080818          00110401001018889909002
#                     0000                  08080          .
#.0!KA01001720101002308010808170801080818          00110401001018889909002
#                     0000                  08080          .
#
# 2008-08-05:
#.0!KE01000120101000408041844520804184457          001000010000           
#                     00008666719487        0808           .
#.0!KE01000120101000508051425130805142558          001000010000           
#                     00004135671880        0808           .
#
# 2008-08-06:
#.0!KE01000120101000608061131380806113453          001000010000           
#                     00004135671880        0808           .
#.0!KE01000120101002108061524550806152938          001000010000           
#                     00008603864400        0808           .
#
# 2008-08-12:
#.0!KE01000120101000508121402570812140301          001000010000           
#                     00008603864400        0808           .
#
# 2008-08-13:
#.0!KE01000120101001608131148050813115825          001000010000           
#                     00008605583595        0808           .
#
# 2008-08-15:
#.0!KE01000420101000608151300080815130020          001000010000           
#                     00005853174717        0808           .
#.0!KE01000420101002008151301470815130154          001000010000           
#                     00005853174717        0808           .
#.0!KE01000120101001608151245500815130709          001000010000           
#                     00009786866101        0808           .
#
# 2008-08-26:
#.0!KA01000520101000708260929350826093003          0011040100102141881    
#.                     0000                  08080          .
#.0!KA01000720101000508260929350826093003          0011040100105615522    
#.                     0000                  08080          .
#.0!KE01000120101001508261108340826110943          001000010000           
#.                     00008603864400        0808           .
#
# 2008-08-29:
#.0!KA01000820101001208291410480829141147          0011040100105399024    
#                     0000                  08080          .
#.0!KA01001220101000808291410480829141147          0011040100105399024    
#                     0000                  08080          .
#.0!KA01002020101001108291411360829141224          0011040100105399024    
#                     0000                  08080          .
#.0!KA01001120101002008291411360829141224          0011040100102436720    
#                     0000                  08080          .
#
# 2008-09-03:
#.0!KA01002120101001309031349110903134938          0011040100109308422    
#                     0000                  08080          .
#.0!KA01001320101002109031349110903134938          0011040100107603959    
#                     0000                  08080          .
#
# 2008-09-10:
#.0!KE01000120101002209101603150910160332          001000010000           
#                     00008606689030        0808           .
#
# 2008-09-15:
#.0!KE01000320101000509151317040915131731          001000010000           
#                     00009786866101        0808           .
#
# 2008-10-05 @ 10:28am: Call to POD x4500 from Hat's wife (280-6535);
#                       forwarded to POD cell 463-7125 via x4400
#.0!KE01000120101001910051028551005102939          001000010000           
#                     00008602806535        0808           .

#
# 0       0x02 STX byte
# 1-4     0!KA Standard header, A=outgoing, E=incoming, B=both internal
# 5-7     010  T1 Routing (Route 001, 010, or 030)
# 8-10    023  T1 line number (0-23)
# 11-13   001  001 for normal extensions, 101 for operator, 201 for forward
# 14-17   1234 Station (extension) (4-digit) / '001 ' (3-digit) for operator
# 18-19        White space
# 20-21   mm   Call start month
# 22-23   DD   Call start day
# 24-25   HH   Call start hour
# 26-27   MM   Call start minute
# 28-29   SS   Call start second
# 30-31   mm   Call end month
# 32-33   DD   Call end day
# 34-35   HH   Call end hour
# 36-37   MM   Call end minute
# 38-39   SS   Call end second
# 40-49        White space
# 50-52   001  Always 001?
# 53      1    0 (direct?) 1 (transfer?)
# 54-55   04   00 (in station) 01 (in operator) 04 (out station) 05 (out operator)
# 56-58   010  T1 routing? (001, 010, 030) -- matches 5-7
# 59-61   010  T1 routing? (001, 010, 030) -- doesn't always match 5-7,56-58
# 62-93        Dialed Number (no leading 9, but including leading 1)
# 94-97   0000 Always 0000?
# 98-105       White Space
# 106-115      PIN (outgoing) or Caller ID (incoming)
# 116-119      0606 (incoming) 0606 (outgoing)
# 120          0 (?) or blank (?)
# 121-130      White space
# 131     0x03 ETX byte

# Here's the pattern that matches these bytes:
my $RECORD_PATTERN = '\0020!K(\w)(\d{3})(\d{3})(\d{3})(\d{3,4})\s{2,3}(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\s{10}(\d{3})(\d)(\d{2})(\d{3})(\d{3})(.{32})(0000)(.{18})(.{15})\003';

# Here are constants that name all the portions of the match
my $FLOW = 'flow';
my $ROUTE = 'route';
my $LINE = 'line';
my $PREFIX = 'prefix';
my $STATION = 'station';
my $START = 'start';
my $START_YEAR = 'startYear';
my $START_MONTH = 'startMonth';
my $START_DAY = 'startDay';
my $START_HOUR = 'startHour';
my $START_MINUTE = 'startMinute';
my $START_SECOND = 'startSecond';
my $END = 'end';
my $END_YEAR = 'endYear';
my $END_MONTH = 'endMonth';
my $END_DAY = 'endDay';
my $END_HOUR = 'endHour';
my $END_MINUTE = 'endMinute';
my $END_SECOND = 'endSecond';
my $DURATION = 'duration';
my $TRANSFER = 'transfer';
my $DESIGNATION = 'designation';
my $ROUTE_IN = 'routeIn';
my $ROUTE_OUT = 'routeOut';
my $NUMBER = 'number';
my $ID = 'id';
my $PIN = 'pin';
my $CALLER_ID = 'callerId';
my $DIRECTION = 'direction';
my $ORIGINATOR = 'originator';
my $TERMINATOR = 'terminator';


# Log messages to syslog
sub logWarn($;$) {
  my $message = shift(@_);
  my $level = shift(@_) || LOG_NOTICE;

  if ($DEBUG) {
    print "Log: $message\n";
  }
  else {
    openlog "nec_smdr", LOG_PID, LOG_DAEMON;
    syslog $level, "%s", $message;
    closelog;
  }
}

# Log errors and try to clean up before death
local $SIG{__DIE__} = sub {
  unlink $PIDFILE if -f $PIDFILE;
  logWarn($_[0], LOG_ERR);
};

# parse a single line of output into a record
sub parseRecord($;) {
  my $r = shift(@_);
  my %record = ();

  if (length($r) != $RECORD_BYTES) {
    logWarn("Invalid record length: " . length($r) . " ('$r')\n");
  }
  elsif ($r =~ /^$RECORD_PATTERN$/x) {
    %record = (
	       $FLOW => $1,
	       $ROUTE => int($2),
	       $LINE => int($3),
	       $PREFIX => int($4),
	       $STATION => int($5),
	       $START_MONTH => int($6),
	       $START_DAY => int($7),
	       $START_HOUR => int($8),
	       $START_MINUTE => int($9),
	       $START_SECOND => int($10),
	       $END_MONTH => int($11),
	       $END_DAY => int($12),
	       $END_HOUR => int($13),
	       $END_MINUTE => int($14),
	       $END_SECOND => int($15),
	       $TRANSFER => int($17),
	       $DESIGNATION => int($18),
	       $ROUTE_IN => int($19),
	       $ROUTE_OUT => int($20),
	       $NUMBER => $21,
	       $ID => $23
	      );

    # figure out if this is an inbound or outbound call
    if ($record{$FLOW} eq 'A') {
      # outgoing
      $record{$DIRECTION} = 'O';
    }
    elsif ($record{$FLOW} eq 'E') {
      # incoming
      $record{$DIRECTION} = 'I';
    }
    else {
      logWarn("Unknown flow type: $record{$FLOW}");
    }

    # the number might be blank (incoming), so only convert it if numeric
    if ($record{$NUMBER} =~ /(\d+)/) {
      $record{$NUMBER} = $1;
    }
    else {
      $record{$NUMBER} = undef;
    }

    # the PIN/ID might be blank, so only convert it to an int if it's numeric
    $record{$PIN} = undef;
    $record{$CALLER_ID} = undef;

    if ($record{$ID} =~ /(\d+)/) {
      my $num= $1;
      if ($record{$DIRECTION} eq 'O') {
	$record{$PIN} = $num;
      }
      else { # assume an inbound call
	$record{$CALLER_ID} = $num;
      }
    }

    # assign origin/termination information
    if ($record{$DIRECTION} eq 'O') {
      $record{$ORIGINATOR} = 'x' . $record{$STATION};
      $record{$TERMINATOR} = $record{$NUMBER};
    }
    elsif ($record{$DIRECTION} eq 'I') {
      $record{$ORIGINATOR} = $record{$CALLER_ID};
      $record{$TERMINATOR} = 'x' . $record{$STATION};
    }

    # was the call a transfer?
    if ($record{$TRANSFER} == 1) {
      $record{$TRANSFER} = 'Y';
    }
    else {
      $record{$TRANSFER} = 'N';
    }

    # now divine the year based on the current time
    # set START_YEAR and END_YEAR
    my ($sec,$min,$hour,$day,$mon,$year,undef,undef,$dst) = localtime(time);
    # offset corrections for localtime:
    $mon++;
    $year += 1900;

    # Start out assuming the current year is when the call took place
    $record{$START_YEAR} = $year;
    $record{$END_YEAR} = $year;

    # This checks to see if the year of the call is the same as the current
    # year.  NOTE: this is a quick check; we assume phone calls do not last
    # more than 1 month (which would be a loooooooong call)
    if ($mon < $record{$START_MONTH}) {
      $record{$START_YEAR} = $year - 1;

      if ($mon < $record{$END_MONTH}) {
	$record{$END_YEAR} = $year - 1;
      }
    }

    # parse full time and date into single strings
    $record{$START} = $record{$START_YEAR} . '-' . $record{$START_MONTH} .
      '-' . $record{$START_DAY} . ' ' . $record{$START_HOUR} .
	':' . $record{$START_MINUTE} . ':' . $record{$START_SECOND};
    $record{$END} = $record{$END_YEAR} . '-' . $record{$END_MONTH} .
      '-' . $record{$END_DAY} . ' ' . $record{$END_HOUR} .
	':' . $record{$END_MINUTE} . ':' . $record{$END_SECOND};

    # compute the duration of the call based on the start and end time
    # note that month is zero-based; all others are 1-based
    my $startTime = timelocal($record{$START_SECOND}, $record{$START_MINUTE},
			      $record{$START_HOUR}, $record{$START_DAY},
			      $record{$START_MONTH}-1, $record{$START_YEAR});
    my $endTime = timelocal($record{$END_SECOND}, $record{$END_MINUTE},
			    $record{$END_HOUR}, $record{$END_DAY},
			    $record{$END_MONTH}-1, $record{$END_YEAR});

    # get duration (in seconds)
    $record{$DURATION} = $endTime - $startTime;

  }
  else {
    my $hex = "";

    for my $c (split("", $r)) {
      my $p = pack "a", $c;
      my $u = unpack "H*", $p;
      $hex .= "$u ";
    }

    logWarn("Invalid record format:\n'$r'\n($hex)\n");
  }

  return %record;
}


# Connect to the database and insert a record
my $INSERT_CALL = "INSERT INTO calls(start_time, end_time, duration, " .
  "direction, station, originator, terminator, pin, " .
  "line, prefix, transfer, designation, route, route_in, route_out) " .
  "VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)";

my $INSERT_LOGGER = "INSERT INTO loggers(calls_id, logger) VALUES(?, ?)";

my $SELECT_CALL = "SELECT id FROM calls WHERE start_time=? AND end_time=? " .
  "AND station=?";

my $dbh;
my $insertCall;
my $insertLogger;
my $selectCall;

sub insertRecord(%;) {

  my %rec = @_;

  # don't bother trying to insert an empty record
  return unless %rec;

  if (!defined($dbh) || !$dbh->ping) {

    logWarn("Database handle no longer valid; reconnecting...", LOG_DEBUG);

    # (re-)connect to the database
    $dbh = DBI->connect("dbi:Pg:dbname=suffield;host=$DBHOST",
			$DBUSER, $DBPASS, {
					   AutoCommit => 1,
					   RaiseError => 0
					  })
      or die ("Could not connect to database: " . $dbh->errstr . "\n");

    # prepare the statements so they're ready to execute
    $insertCall = $dbh->prepare($INSERT_CALL) or
      die "Could not prepare INSERT_CALL statement: " . $dbh->errstr . "\n";

    $insertLogger = $dbh->prepare($INSERT_LOGGER) or
      die "Could not prepare INSERT_LOGGER statement: " . $dbh->errstr . "\n";

    $selectCall = $dbh->prepare($SELECT_CALL) or
      die "Could not prepare SELECT_CALL statement: " . $dbh->errstr . "\n";
  }

  $retry = $MAX_RETRYS;
  while ($retry > 0) {

    my $id = undef;

    # first, search for an exsiting record:
    if ($selectCall->execute($rec{$START}, $rec{$END}, $rec{$STATION})) {
      my $ids = $selectCall->fetchall_arrayref([0]);
      $id = $ids->[0][0];
    }
    else {
      logWarn("Could not execute search for existing call record: " .
	      $dbh->err . "\n");
    }

    if (defined($id)) { # found existing ID
      if ($insertLogger->execute($id, $HOSTNAME)) {
	# mark insert as done
	$retry = -1;
	if ($DEBUG) {
	  print "\n\nTagged on logger for: $id\n";
	}
      }
      elsif ($DEBUG) {
	print "Unable to insert logger record: " . $dbh->err . "\n";
      }
    }
    else { # try to insert our own copy of the record
      if ($insertCall->execute
	  ($rec{$START}, $rec{$END}, $rec{$DURATION}, $rec{$DIRECTION},
	   $rec{$STATION}, $rec{$ORIGINATOR}, $rec{$TERMINATOR}, $rec{$PIN},
	   $rec{$LINE}, $rec{$PREFIX}, $rec{$TRANSFER}, $rec{$DESIGNATION},
	   $rec{$ROUTE}, $rec{$ROUTE_IN}, $rec{$ROUTE_OUT})
	 ) {

	if ($DEBUG) {
	  print "\n\nInserted record:\n\n";
	  for my $key (sort keys %rec) {
	    print "\t$key\t$rec{$key}\n" if defined($rec{$key});
	  }
	}
      }
      elsif ($DEBUG) {
	print "Unable to insert our own call record: " . $dbh->err . "\n";
      }
    }

    if ($retry > 0) {
      if ($DEBUG) {
	print "Could not find call record.  $retry retries left";
      }

      # wait for the other insert to complete
      sleep 2;

      # decrement the retry count
      $retry--;
    }
  }

  if ($retry == 0) {
    logWarn("Gave up trying to insert call record: " . $dbh->errstr);

    # attempt to save record to local disk
    my $tmp = `mktemp -t nec_smdr.XXXXXXXXXX`;
    if (open(DUMP, ">$tmp")) {
      print DUMP Dumper(\%rec);
      logWarn("Uninserted record dumped to $tmp");
      close(DUMP);
    }
    else {
      logWarn("Could not open file $tmp to save uninserted record: $!\n");
    }

  }
}

# signal handlers; clean up safely when its time to quit
sub quit {
  my $signal = shift;
  $RUNNING = 0;
  $snooze = 0;
  $MAX_RETRYS = 0;
  $retry = 0;
  logWarn("Caught signal $signal, cleaning up");
}

$SIG{INT}  = \&quit;
$SIG{TERM} = \&quit;


############################################################################
###                               MAIN                                   ###
############################################################################

if ($DAEMON) {
  # disassociate from controlling terminal
  chdir '/'                 or die "Can't chdir to /: $!";
  open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
  defined(my $pid = fork)   or die "Can't fork: $!";
  exit if $pid;
  setsid                    or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT'   or die "Can't dup stdout: $!";

  # now log the PID so we can be killed later
  open(PID, ">$PIDFILE") or logWarn("Couldn't open PID file: $!\n", LOG_ERR);
  print PID $$;
  close(PID);
}
else {
  print "Foreground or Debug mode requested; no detach or PID file\n";
}

# open serial port connection
my $port = Device::SerialPort->new($PORT) or
  die "Can't open serial port $PORT: $!";
$port->baudrate(9600)       or die "failed setting baudrate";
$port->parity("none")       or die "failed setting parity";
$port->databits(7)          or die "failed setting databits";
$port->stopbits(1)          or die "failed setting stopbits";
$port->handshake("rts")     or die "failed setting handshake";
$port->write_settings       or die "failed writing settings";

logWarn("Started and ready to process data");

# buffer to hold data until we have a full record
my $buffer = '';

# loop forever and process data
while ($RUNNING) {
  my ($count, $data) = $port->read($RECORD_BYTES-length($buffer));

  if ($count == 0) {
    if ($DEBUG) {
      print "No data available, sleeping for $snooze\n";
    }

    sleep $snooze;

    # binary backoff; double each time
    if ($snooze < 30) {
      $snooze = $snooze * 2;
    }
  }
  else {

    if ($DEBUG) {
      print "Read $count bytes: '$data'\n";
    }

    # add data to the buffer
    $buffer .= $data;

    # throw away any garbage at the start of the line (in case we picked
    # up a read in the middle of a record
    while ($buffer =~ s/^(.{1,$RECORD_INCOMPLETE})\002/\002/) {
      logWarn("Threw away garbage: '$1'\n");
    }

    # if the buffer is big enough, read out a record
    if (length($buffer) >= $RECORD_BYTES) {

      # read out the number of bytes, and clobber what was there
      my $record = substr($buffer, 0, $RECORD_BYTES, '');

      if ($DEBUG) {
	print "Buffer has enough for a record, parsing this line:\n'$record'\n";
      }

      my %rec = parseRecord($record);

      # insert the record into the database
      insertRecord(%rec);
    }

    # reset snooze on successful read
    $snooze = 1;
  }
}

# delete the PID file
unlink $PIDFILE if -f $PIDFILE;
logWarn("Exiting", LOG_ERR);