#!/usr/bin/perl

# xdmf2ncid - XDMF Caller ID to NCID gateway

# Supports CTI Comet USB, Holtek HT9032D based PSTN Caller ID module or 56K Modem configured for AT+VCID=2

# Copyright (c) 2005-2024
#  by John L. Chmielewski <jlc@users.sourceforge.net>

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

use POSIX qw(strftime);
use Device::SerialPort qw( :PARAM :STAT 0.07 );
use Getopt::Long qw(:config no_ignore_case_always);
use File::Basename;
use Config::Simple;
use Data::HexDump;
use Sys::Hostname;
use Pod::Usage;
use IO::Socket::INET;
use IO::Select;
use Fcntl;
use Symbol;
use Time::HiRes qw(usleep);
use Switch;

# given and when replaced by switch and case

my $prog = basename($0);
my $confile = basename($0, '.pl');
my $VERSION = "(NCID) 1.18";
my $API = "API XXX";

my $IDENT = "HELLO: IDENT: gateway $prog $VERSION";
my $COMMAND = "HELLO: CMD: no_log";

my $ConfigDir = "/etc/ncid";
my $ConfigFile = "$ConfigDir/$confile.conf";

# Constants
my $nonumber = "NO-NUMBER";
my $nomesg = "NONE";
my $noname = "NO NAME";
my $portspeed = "1200";

# delay needed to receive entire message at 1200 baud
my $msgdelay = 360000;
my $ht9032delay = 720000;

my ($ncidaddr, $ncidport) = ('localhost', 3333);
my $ncidhost = "";
my $ncidsock = undef;
my $ncidline = undef;
my $usbport = "/dev/ttyUSB0";
my $cl_usbport = undef;
my $port = undef;
my $portHandle = undef;
my $selectTO = undef;
my $delay = 15;
my $cl_delay = undef;
my $logfile = basename($0, '.pl');
   $logfile = "/var/log/" . $logfile . ".log";
my ($logfileMode, $logfileModeEnglish);
my $logfileAppend;
my $logfileOverwrite;
my $debug;
my $verbose = 1;
my $cl_verbose = undef;
my ($help, $man, $version);
my $pidfile = "";
my $savepid;
my $pid;
my ($test, $fh);
my $testFile = "";
my $decodePretty;
my $fileopen;
my $select;
my @ready;
my $rh;
my ($cksum, $mesg, $mesglen, $format, $val, $hexval, $hexstr, $noval);
my $cfg;
my %config;
my ($cl_hostnameflag, $hostname, $lineid);
my $HostnameFlag = 0;
my ($cl_ht9032, $ht9032);
my $read1 = 1;
my ($cntu, $mesg1);

my $date = strftime("%m/%d/%Y %H:%M:%S", localtime);

# Start of XDMF message is one of the following:
#      $SDMF_CALLER_ID
#      $MDMF_CALLER_ID
#      $MDMF_MSG_WAITING
# $MDMF_MSG_WAITING is seldom used, it indicates voicemail
# https://en.wikipedia.org/wiki/Message-waiting_indicator

my $SDMF_CALLER_ID    = 0x04;

my $MDMF_CALLER_ID    = 0x80; # CID
my $MDMF_MSG_WAITING  = 0x82; # MWI
my $MDMF_VISUAL_IND   = 0x0B;

my $MDMF_DATETIME     = 0x01;
my $MDMF_CALLER_NMBR  = 0x02;
my $MDMF_CALLER_NAME  = 0x07;

# WHY_NO_NMBR has 2 reasons defined
my $MDMF_WHY_NO_NMBR  = 0x04;
my $WITHHELD          = 0x50; # 'P'RIVATE
my $UNAVAILABLE       = 0x4F; # 'O'UT OF AREA

# WHY_NO_NAME reasons same as WHY_NO_NMBR
my $MDMF_WHY_NO_NAME  = 0x08;

# US message waiting indicator is either on or off
my $MDMF_VISUAL_OFF   = 0x00;
my $MDMF_VISUAL_ON    = 0xFF;

# CALL_TYPE_UK is only sent for ETSI FSK and BT FSK
# In general it can be ignored.
my $CALL_TYPE_UK     = 0x11;

# There are three call types defined:
my $VOICE_UK         = 0x01;
my $RINGBACK_UK      = 0x02;
my $MSG_WAITING_UK   = 0x81;

my $MDMF_NMSS_UK     = 0x13; # Network Message System Status


# command line processing
my @save_argv = @ARGV;
Getopt::Long::Configure ("bundling");
my ($result) = GetOptions("ncidhost|n=s" => \$ncidhost,
               "configfile|C=s" => \$ConfigFile,
               "logfile-append|l=s" => \$logfileAppend,
               "logfile-overwrite|L=s" => \$logfileOverwrite,
               "debug|D" => \$debug,
               "delay|d" => \$cl_delay,
               "help|h" => \$help,
               "hostname-flag|H=i" => \$cl_hostnameflag,
               "ht9032-ic|I=i" => \$cl_ht9032,
               "man|m" => \$man,
               "pretty" => \$decodePretty,
               "verbose|v=i" => \$cl_verbose,
               "version|V" => \$version,
               "test|t" => \$test,
               "test-file|T=s" => \$testFile,
               "usbport|u=s" => \$cl_usbport,
               "pidfile|p=s" => \$pidfile
             ) || pod2usage(2);
die "$prog $VERSION\n$API\n" if $version;
pod2usage(-verbose => 1, -exitval => 0) if $help;
pod2usage(-verbose => 2, -exitval => 0) if $man;

# reading configuration file after command line processing
# is necessary because the command line can change the
# location of the configuration file
$cfg = new Config::Simple($ConfigFile);
if (defined $cfg) {
    # opened config file
    %config = $cfg->vars();
    my $x;
    $x = "default.verbose";      $verbose      = $config{$x} if defined $config{$x};
    $x = "default.ncidaddr";     $ncidaddr     = $config{$x} if defined $config{$x};
    $x = "default.ncidport";     $ncidport     = $config{$x} if defined $config{$x};
    $x = "default.delay";        $delay        = $config{$x} if defined $config{$x};
    $x = "default.usbport";      $usbport      = $config{$x} if defined $config{$x};
    $x = "default.HostnameFlag"; $HostnameFlag = $config{$x} if defined $config{$x};
    $x = "default.ht9032";       $ht9032       = $config{$x} if defined $config{$x};
}

if ($test) {
    $debug = 1;
    $verbose = 3;
}

if ($testFile ne "") {
    $debug = 1;
    $verbose = 4;
}

# these command line values override the configuration file values
$ncidport     = $1 if $ncidhost =~ s/:(\d+)//;
$ncidaddr     = $ncidhost if $ncidhost;
$usbport      = $cl_usbport if $cl_usbport;
$delay        = $cl_delay if $cl_delay;
$verbose      = $cl_verbose if defined $cl_verbose;
$HostnameFlag = $cl_hostnameflag if $cl_hostnameflag;
$ht9032       = $cl_ht9032 if $cl_ht9032;

$logfileMode = ">>"; # default to append
$logfileModeEnglish = "Appending to";

if ($logfileAppend and $logfileOverwrite) { $logfileOverwrite = undef; }

if ($logfileOverwrite) {
   $logfileMode = ">";
   $logfileModeEnglish = "Overwriting";
   $logfile = $logfileOverwrite;
} else {
  if ($logfileAppend) {
     $logfile = $logfileAppend;
  }
}

if (open(LOGFILE, "$logfileMode$logfile")) {
    LOGFILE->autoflush(1); # make LOGFILE handle 'hot', i.e., no buffering
    $fileopen = 1;
}

if ($HostnameFlag) {
    $hostname = hostname;
    $IDENT =~ s/(gateway )/$1$hostname\//;
}

logMsg(1, "Started: $date\n");

# log command line and any options on separate lines
my $cl = "Command line: " . $0;
for my $arg (@save_argv) {
    if ( '-' eq substr($arg, 0, 1)) {
        logMsg(1, "$cl\n");
        $cl = "              $arg";
    } else {
        $cl = $cl . " " . $arg;
    }
}
logMsg(1, "$cl\n");

if ($fileopen) {logMsg(1, "Logfile: $logfileModeEnglish $logfile\n");}
else {logMsg(1, "Could not open logfile: $logfile\n");}

if (defined $cfg) {logMsg(1, "Processed config file: $ConfigFile\n");}
else {logMsg(1, "Config file not found: $ConfigFile\n");}

logMsg(1, "Gateway: $prog version $VERSION\n");

if ($ht9032) {
    logMsg(1, "Configured for a Holtek HT9032D based PSTN Caller ID module\n");
} else {
    logMsg(1, "Configured for a Comet device or a modem\n");
}

logMsg(1, "Verbose level: $verbose\n");
logMsg(1, "HostnameFlag: $HostnameFlag\n");
logMsg(1, "Ident: $IDENT\n");
logMsg(1, "Command: $COMMAND\n");
logMsg(1, "Debug mode\n") if ($debug);
logMsg(1, "Test mode - Not sending data to NCID\n") if $test;
logMsg(1, "Test file - using test file: $testFile\n") if $testFile ne "";

if ($testFile ne "") {
    open($fh, '<:encoding(UTF-8)', $testFile)
    or die "Could not open file '$testFile' $!";
}

if (!$test) {
    if ($testFile eq "") {
        $lineid = basename($usbport);
        logMsg(1, "Line ID: $lineid\n");
        logMsg(1, "Delay between each try to reconnect to server: $delay seconds\n");
    }

    &doPID;

    $SIG{'HUP'}  = 'sigHandle';
    $SIG{'INT'}  = 'sigHandle';
    $SIG{'QUIT'} = 'sigHandle';
    $SIG{'TERM'} = 'sigHandle';
    $SIG{'PIPE'} = 'sigIgnore';

    # Suppress annoying errors case $usbport gets disconnected
    # (e.g., at EOF in text-xdmf-calls)
    # bug report: https://rt.cpan.org/Public/Bug/Display.html?id=76881
    # work around: https://stackoverflow.com/a/10370811/2329642
    $SIG{'__WARN__'} = sub { warn $_[0] unless (caller eq "Device::SerialPort"); };

    $select = IO::Select->new();

    # $select undefined if could not create new object
    errorExit("ERROR in Select Object Creation : $!") if !defined $select;

    &connectNCID;
}

if ($testFile ne "") {
    $lineid = "testFile";
    while (<$fh>) {
        chomp;
        next if /^\s*[:#]/;  # skip comment and info lines
        next if /^\s*$/;  # skip blank lines
        $_ =~ s/\s+$//; # remove trailing spaces
        $mesglen = vec($_, 1, 8) + 3;
        $mesg = pack('H*', $_);
        my $hexdump = HexDump $mesg;
        logMsg(4, "$hexdump\n");
        &doMessage;
    }
} else {
    &connectXDMF;

    logMsg(1, "Waiting for calls from $usbport\n\n");
    # get a set of readable handles, block until at least one is ready
    while (1) {
        if (!(@ready = $select->can_read($selectTO))) {
            # select timeout
            if (!$test && !defined $ncidsock) {
                connectNCID();
                if (defined  $ncidsock) {
                    $selectTO = undef;
                    logMsg(1, "Waiting for calls from $usbport\n");
                }
            }
        }
        foreach $rh (@ready) {
            if (defined $ncidsock && $rh == $ncidsock) {
                # NCID server Caller ID
                $ncidline = <$rh>;
                if (!defined $ncidline) {
                    $select->remove($ncidsock);
                    $selectTO = $delay;
                    logMsg(1, "NCID server at $ncidaddr:$ncidport disconnected\n");
                    logMsg(1, "Trying to reconnect every $delay seconds\n");
                } else { logMsg(5, $ncidline); }
            } elsif ($rh == $portHandle) {
                # XDMF Caller ID message
                if ($ht9032) { usleep($ht9032delay); }
                else { usleep($msgdelay); }
                $cksum = $mesg = "";
                $mesglen = read($portHandle, $mesg, 1024);
                if (!defined $mesglen) { errorExit("Device: $usbport $!"); }
                if ($mesglen > 0) {
                    if ($ht9032) {
                        $hexstr = unpack 'H*C', $mesg;
                        if ($read1) {
                            if ($mesg =~ /UUUUUUUUUU|U$/) {
                                logMsg(3, "Received from Holtek HT9032D based PSTN Caller ID module\n$hexstr\n");

                                # get count of number of U's
                                $cntu = "";
                                while ($mesg =~ /((U)\2*)/gs) { $cntu = $1 if length($1) > length($cntu); }
                                $cntu = length($cntu);
                                logMsg( 4, "U count from first read: $cntu\n");
                                $mesg =~ s/.*U+//;
                                $mesglen = length($mesg);
                                if ($cntu < 10 || $mesglen < 3 || $mesglen < (vec($mesg, 2, 8) + 3)) {
                                    $mesg1 = $mesg;
                                    $read1 = 0;
                                    next
                                }
                            } else {
                                # ignored Holtek HT9032D random characters
                                next;
                            }
                        } else {
                            logMsg(3, "Second read from the Holtek HT9032D\n$hexstr\n");
                            $read1 = 1;

                            # if number of U's (0x55) less than 10 ignore packet
                            my $cnt2 = "";
                            while ($mesg =~ /((U)\2*)/gs) {
                                $cnt2 = $1 if length($1) > length($cnt2);
                            }
                            $cnt2 = length($cnt2);
                            my $cnt1 = $cntu;
                            $cntu = $cnt1 + $cnt2;
                            logMsg( 4, "U count from read1 + read2: $cntu ($cnt1 + $cnt2)\n");
                            if ($cntu < 10) {
                                logMsg( 3, "Ignored Holtek HT9032D noise packet: $cntu < 10\n");
                                next;
                            }

                            $mesg =~ s/^U+//;
                            $mesg = $mesg1 . $mesg;
                        }
                        $mesg =~ s/^.//;
                        $mesglen = vec($mesg, 1, 8) + 3;
                        $mesg = substr($mesg, 0, $mesglen);
                        $hexstr = unpack 'H*C', $mesg;
                    } elsif ($mesg =~ /^\r\n/) {
                        $mesg =~ s/\r|\n//g;
                        next if !$mesg;
                        logMsg(3, "Detected ASCII characters\n");
                        if ($mesg =~ /^04|^80|^82/) {
                            logMsg(3, "Detected XDMF Hex message\n");
                            $hexstr = $mesg;
                            $hexstr = uc $hexstr;
                            $mesg = pack('H*', $mesg);
                            $mesglen = length($mesg);
                        } else { logMsg(3, "Skipping: $mesg\n"); }
                    } else {
                        logMsg(3, "Detected CTI Comet USB device\n");
                        $hexstr = unpack 'H*C', $mesg;
                    }

                    logMsg(3, "\nReceived Packet\n$hexstr\n");
                    my $hexdump = HexDump $mesg;
                    logMsg(4, "$hexdump\n");
                    &doPretty if $decodePretty;
                    &doMessage;
                    next;
                }
            }
        }
    }
}

sub connectNCID {
  $ncidsock = IO::Socket::INET->new (
    Proto    => 'tcp',
    PeerAddr => $ncidaddr,
    PeerPort => $ncidport,
  );

  # $ncidsock undefined if could not connect to server
  if (!defined $ncidsock) {
    if (defined $selectTO) {return;}
    else {errorExit("NCID server: $ncidaddr:$ncidport $!");}
  }

  logMsg(1, "Connected to NCID server at $ncidaddr:$ncidport\n");

  # send ident to server
  print $ncidsock "$IDENT\n";
  logMsg(1, "Sent: $IDENT\n");

  # make sure call log not sent
  print $ncidsock "$COMMAND\n";
  logMsg(1, "Sent: $COMMAND\n");

  my $greeting = <$ncidsock>;
  logMsg(1, "$greeting");

  # read and discard cidcall log sent from server
  while (<$ncidsock>)
  {
    # a log file may or nay not be sent
    # but a 300 message is always sent

    if (/^[23]\d\d/) { logMsg(1, $_); }
    else { logMsg(5, $_); }
    last if /^300/;
  };

  $select->add($ncidsock);
}

sub connectXDMF {
  my $flags = 0;

  $portHandle = gensym();
  $port = tie( *$portHandle, "Device::SerialPort", $usbport ) ||
          die "Can not open port $usbport: $!\n";  # tie Handle

  $port->baudrate($portspeed);
  $port->databits(8);
  $port->parity("none");
  $port->stopbits(1);

  # use non-blocking read on serial port
  #$port->read_char_time(5);
  #$port->read_const_time(500);

  logMsg(1, "Connected to port $usbport at $portspeed baud\n");

  $select->add($portHandle);
}

# ======================================================================
# SDMF OVERVIEW AND CALLER ID EXAMPLE
# ======================================================================
#
# SDMF payloads have data in fixed positions with only the NMBR having a
# variable length. SDMF never has a NAME.
#
# byte      1: 04h indicates SDMF
# byte      2: XXh total length of date+time+nmbr but not including checksum
# bytes  3-10: MMDDHHMM (date & time)
# bytes   11+: nmbr, or single letter to indicate why phone# not available
#              ('P'rivate, 'O'ut-of-area)
# byte   last: two's complement checksum of ALL bytes excluding checksum byte
#
# Example:
# 041230393330313232343630393535353132313251
#      byte      1: 04h indicates SDMF
#      byte      2: 12h (18 decimal)
#      bytes  3-10: '09301224'    (8 bytes)
#      bytes 11-20: '6095551212'  (10 bytes)
#      byte     21: 51h checksum

# ======================================================================
# MDMF OVERVIEW AND CALLER ID EXAMPLES FOR US, UK
# ======================================================================
#
# MDMF payloads start off similar to SDMF in that the first two bytes
# identify the overall payload purpose and its length and with the last
# byte being a checksum. The rest of the payload consists of multiple
# variable length records with a parameter type, parameter length and
# zero or more bytes for the parameter value. Sometimes different
# parameter types are used depending on whether it's US or UK telcos.
#
# byte      1: 80h or 82h indicates MDMF Caller ID or message waiting
# byte      2: XXh total length of ALL records but not including checksum
# bytes    3+: multiple records
#              record 1 byte   1: parameter type
#              record 1 byte   2: parameter length
#              record 1 bytes 3+: parameter value
#
#              record 2 byte   1: parameter type
#              record 2 byte   2: parameter length
#              record 2 bytes 3+: parameter value
#              ...
# byte   last: two's complement checksum of ALL bytes excluding checksum byte
#
# It is perfectly valid for a parameter length to be zero, indicating
# there is no parameter value.
#
# Example of a typical US MDMF Caller ID payload:
# 802501083034323631353336020B3134303735353537373737070C4A6F686E206F6E2043656C6C24
#      byte      1: 80h MDMF Caller ID
#      byte      2: 25h (37 decimal) total length of ALL records excluding checksum
#      bytes  3-39: multiple records
#                   byte      3:  record 1 byte     1: 01h date and time
#                   byte      4:  record 1 byte     2: 08h length
#                   bytes  5-12:  record 1 bytes 3-10: '04261536'
#
#                   byte     13:  record 2 byte     1: 02h number
#                   byte     14:  record 2 byte     2: 0Bh (11 decimal) length
#                   bytes 15-25:  record 2 bytes 3-13: '14075557777'
#
#                   byte     26:  record 3 byte     1: 07h name
#                   byte     27:  record 3 byte     2: 0Ch (12 decimal) length
#                   bytes 28-39:  record 3 bytes 3-14: 'John on Cell'
#      byte     40: 24h checksum
#
# Example of the same Caller ID data but formatted as typical UK MDMF
# payload. The primary change is inserting a new record#1 for parameter
# type 11h.
# 802811010101083034323631353336020B3134303735353537373737070C4A6F686E206F6E2043656C6C0E
#      byte      1: 80h MDMF Caller ID
#      byte      2: 28h (40 decimal) total length of ALL records excluding checksum
#      bytes  3-42: multiple records
#                   byte      3:  record 1 byte     1: 11h UK Caller ID
#                   byte      4:  record 1 byte     2: 01h length
#                   byte      5:  record 1 byte     3: 01h Voice call
#
#                   byte      6:  record 2 byte     1: 01h date and time
#                   byte      7:  record 2 byte     2: 08h length
#                   bytes  8-15:  record 2 bytes 3-10: '04261536'
#
#                   byte     16:  record 3 byte     1: 02h number
#                   byte     17:  record 3 byte     2: 0Bh (11 decimal) length
#                   bytes 18-28:  record 3 bytes 3-13: '14075557777'
#
#                   byte     29:  record 4 byte     1: 07h name
#                   byte     30:  record 4 byte     2: 0Ch (12 decimal) length
#                   bytes 31-42:  record 4 bytes 3-14: 'John on Cell'
#      byte     43: 0Eh checksum
#

# ======================================================================
# MDMF VISUAL MESSAGE WAITING INDICATOR (MWI) AND EXAMPLES FOR US, UK
# ======================================================================
#
# US telcos indicate only whether the indicator is on or off.
# UK telcos indicate the number of voicemail messages waiting.
#
# Example for US indicating MWI is OFF:
# 82030B01006F
#      byte      1: 82h MDMF Message Waiting.
#      byte      2: 03h total length of ALL records excluding checksum
#      bytes   3-5: one record
#                   byte      3:  record 1 byte     1: 0Bh message waiting type
#                   byte      4:  record 1 byte     2: 01h length
#                   byte      5:  record 1 byte     3: 00h MWI is OFF
#      byte      6: 6Fh checksum
#
# Example for US indicating MWI is ON. Byte 5 changes from 00h to FFh,
# which also causes the checksum byte to change from 6Fh to 70h.
# 82030B01FF70
#
# Example for UK indicating there are FIVE voicemail messages waiting:
# 8006110181130105CE
#      byte      1: 80h MDMF Caller ID.
#      byte      2: 06h total length of ALL records excluding checksum
#      bytes   3-8: two records
#                   byte      3:  record 1 byte     1: 11h UK Caller ID
#                   byte      4:  record 1 byte     2: 01h length
#                   byte      5:  record 1 byte     3: 81h Message waiting
#
#                   byte      6:  record 2 byte     1: 13h Message count
#                   byte      7:  record 2 byte     2: 01h length
#                   byte      8:  record 2 byte     3: 05h Five messages
#      byte      9: CEh checksum
#
# Example for UK indicating there are ZERO voicemail messages waiting.
# Byte 8 changes from 05h to 00h, which also causes the checksum byte
# to change from CEh to D3h.
# 8006110181130100D3
#
# Example for UK indicating there is ONE voicemail messages waiting.
# Byte 8 becomes 01h and the checksum becomes D2h. The 01h can also
# simply mean MWI is ON and represents an unspecified number of messages
# waiting.
# 8006110181130101D2

sub doMessage {
  my $nciddate = strftime("%m%d%H%M", localtime);
  my ($msgtype, $callmsg, $datetime);
  my $cidnmbr = $nonumber;
  my $cidmesg = "";
  my $cidname = $noname;
  my $reclen = 0;
  my ($calltype) = "";

  # First byte indicates XDMF format
  $format = vec($mesg, 0, 8);
  my $formatText = "";
  switch ($format) {
    case "$SDMF_CALLER_ID"   { $formatText = "SDMF"; $calltype = "CID"; }
    case "$MDMF_CALLER_ID"   { $formatText = "MDMF"; $calltype = "CID"; }
    case "$MDMF_MSG_WAITING" { $formatText = "MDMF"; $calltype = "MWI"; }
  }
  if ($formatText) {
     $reclen = vec($mesg, 1, 8);
     logMsg(4, "Got $format ($formatText packet): bytes to checksum = $reclen\n");
  } else {
    logMsg(3, "ERROR - not an XDMF packet\n");
    return;
  }

  # Get the checksum
  $cksum = unpack('%8C*', $mesg); # decimal
  my $cksumHexCalc = "0x" . sprintf("%.2X", $cksum);
  my $cksumHexRecv = "0x" . uc(unpack('H*', substr($mesg, -1)));
  logMsg(4, "Message Length: $mesglen bytes\n");
  if ($cksum) { logMsg(3, "Received Bad Checksum: $cksumHexRecv (should be $cksumHexCalc)\n"); }
  else {
      logMsg(4, "Calculated Checksum Good: received $cksumHexRecv, result $cksumHexCalc\n");
  }

  if ( $format == $SDMF_CALLER_ID ) {
     $val = $format;
     $reclen = 8;
     my $i = 2;
     $datetime = substr($mesg, $i, $reclen);
     $datetime = unpack('A*', $datetime);
     logMsg(4, "Got $val (Date & Time): length = $reclen: $datetime\n");
     $i += $reclen;
     $reclen = $mesglen - $reclen - 3;
     $cidnmbr = substr($mesg, $i, $reclen);
     $cidnmbr = unpack('A*', $cidnmbr);
     $cidnmbr =~ s/^\s+|\s+$//;
     $cidnmbr = $nonumber if !$cidnmbr; # shouldn't happen
     logMsg(4, "Got $val (Caller Number): length = $reclen: $cidnmbr\n");
     $noval = $cidnmbr;
     my $reason;
     switch ($noval) {
       case "P" { $reason = $cidnmbr; $cidnmbr = "WITHHELD"; }
       case "O" { $reason = $cidnmbr; $cidnmbr = "UNAVAILABLE"; }
     }
     logMsg(4, "Got $val (Why No Number): length = $reclen: $cidnmbr\n") if defined $reason;
  }
  else {
     # total message length calculated from second byte
     $mesglen = vec($mesg, 1, 8) + 2;
     # MDMF - Read each record of message
     for (my $i = 2; $i < $mesglen; $i++) {
       $val = vec($mesg, $i, 8);
       $hexval = "0x" . sprintf("%.2X", $val);
       switch($val) {
         case "$MDMF_VISUAL_IND" { # MESSAGE WAITING INDICATOR
           $reclen = vec($mesg, ++$i, 8);
           $noval = vec($mesg, ++$i, 8);
           $cidnmbr = "Voicemail";
           $cidname = $noval == $MDMF_VISUAL_ON ? "Message(s) Waiting" : "No Messages Waiting";
           logMsg(4, "Got $hexval (Message Waiting Indicator): length = $reclen: $cidnmbr $cidname\n");
         }
         case "$CALL_TYPE_UK" { # CALL TYPE -- ETSI FSK AND BT FSK
           $reclen = vec($mesg, ++$i, 8);
           $noval = vec($mesg, ++$i, 8);
           switch ($noval) {
             case "$VOICE_UK" { $calltype = "CID"; }       # Voice
             case "$RINGBACK_UK" { $calltype = "RID"; }    # Ringback
             case "$MSG_WAITING_UK" { $calltype = "MWI"; } # Message Waiting
           }
           logMsg(4, "Got $hexval (Call Type): length = $reclen: $calltype\n");
           if ($noval == $MSG_WAITING_UK) {
              # $MSG_WAITING_UK has an additional record to indicate NMSS
              # (Network Message System Status) with the count of the
              # number of voicemail messages waiting. It is assumed that
              # these bytes immediately follow the $CALL_TYPE_UK record.
              $val = vec($mesg, ++$i, 8); # assumed to be $MDMF_NMSS_UK
              $reclen = vec($mesg, ++$i, 8);
              $noval = vec($mesg, ++$i, 8);
              $cidnmbr = "Voicemail";
              switch ($noval) {
                case 0 { $cidname = "No Messages Waiting"; }
                case 1 { $cidname = "1 Message Waiting"; }
                else  { $cidname = "$noval Messages Waiting"; }
              }
              logMsg(4, "Got $hexval (NMSS UK Message Waiting Indicator): length = $reclen: $cidnmbr $cidname\n");
           }
         }
         case "$MDMF_DATETIME" { # DATE & TIME
           $reclen = vec($mesg, ++$i, 8);
           $datetime = substr($mesg, ++$i, $reclen);
           $datetime = unpack('A*', $datetime);
           logMsg(4, "Got $hexval (Date & Time): length = $reclen: $datetime\n");
           $i += $reclen - 1;
         }
         case "$MDMF_CALLER_NMBR" { # CALLER NUMBER
           $reclen = vec($mesg, ++$i, 8);
           if ($reclen) {
             $cidnmbr = substr($mesg, ++$i, $reclen);
             $cidnmbr = unpack('A*', $cidnmbr);
             $i += $reclen - 1;
             $cidnmbr =~ s/^\s+|\s+$//;
           }
           logMsg(4, "Got $hexval (Caller Number): length = $reclen: $cidnmbr\n");
         }
         case "$MDMF_WHY_NO_NMBR" { # NO NMBR PRESENT
           $reclen = vec($mesg, ++$i, 8);
           $noval = vec($mesg, ++$i, 8);
           switch ($noval) {
             case "$WITHHELD" { $cidnmbr = "WITHHELD"; }
             case "$UNAVAILABLE" { $cidnmbr = "UNAVAILABLE"; }
           }
           logMsg(4, "Got $hexval (Why No Number): length = $reclen: $cidnmbr\n");
         }
         case "$MDMF_CALLER_NAME" { # CALLER NAME
           $reclen = vec($mesg, ++$i, 8);
           if ($reclen) {
             $cidname = substr($mesg, ++$i, $reclen);
             $cidname = unpack('A*', $cidname);
             $i += $reclen - 1;
             $cidname =~ s/^\s+|\s+$//;
           }
           logMsg(4, "Got $hexval (Caller Name): length = $reclen: $cidname\n");
         }
         case "$MDMF_WHY_NO_NAME" { # NO NAME PRESENT
           $reclen = vec($mesg, ++$i, 8);
           $noval = vec($mesg, ++$i, 8);
           switch ($noval) {
             case "$WITHHELD" { $cidname = "WITHHELD"; }
             case "$UNAVAILABLE" { $cidname = "UNAVAILABLE"; }
           }
           logMsg(4, "Got $hexval (Why No Name): length = $reclen: $cidname\n");
         }
         else   {
           $reclen = vec($mesg, ++$i, 8);
           $hexval = sprintf("%.2X", $val);
           my $hexlen = sprintf("%.2X", $reclen);
           if ($i == $mesglen) {
             logMsg(4, "Got $hexval (Checksum)\n");
             if ($cidmesg == "") {$cidmesg = "NOMESG";}
           } else { # Adding Unknown records, if any
             logMsg(4, "Got Unknown =  $hexval length = $reclen\n");
             if ($cidmesg ne "") {$cidmesg .= "|";}
             my $temp .= $hexval.$hexlen;
             $cidmesg .= $temp;
             if ($reclen == 1) {
                $temp = vec($mesg, ++$i, 8);
                $temp = sprintf("%.2X", $temp);
             } else {
                $temp = substr($mesg, ++$i, $reclen);
                $temp = unpack('H*', $temp);
             }
             $cidmesg .= $temp;
             $hexlen = sprintf("%.2X", $mesglen);
             $i += $reclen - 1;
           }
         }
       }
     }
     logMsg(4, "\$cidmesg: $cidmesg\n");
  }

  if ($calltype) { logMsg(4, "Detected Call type: $calltype\n"); }
  else { $calltype = "CID"; }

  if (!$datetime) {
     logMsg(4, "No date or time detected -- using current date and time.\n");
     $datetime = $nciddate;
  }

  # create NCID gateway message for call
  $callmsg =
  sprintf("CALL: ###DATE%s...CALL%s...LINE%s...NMBR%s...MESG%s...NAME%s+++",
          $datetime, $calltype, $lineid, $cidnmbr, $cidmesg, $cidname);
  logMsg(3, "$callmsg\n\n");

  if ($callmsg) {
    if (!$test && !defined $selectTO) {
      print $ncidsock $callmsg, "\r\n";
    }
  }
}

sub doPretty {
  my $reclen = 0;
  my $reclenHex;
  my ($calltype) = "";

  my ($formatHex, $formatText);
  my ($val, $valHex);
  my $i;
  my ($paramLabel, $dataLabel, $dataHexPairs, $dataText);

  # First byte indicates XDMF format
  $format = vec($mesg, 0, 8);
  $formatHex = uc(unpack('H*', substr($mesg, 0, 1)));
  $formatText = "";
  switch ($format) {
    case "$SDMF_CALLER_ID"   { $formatText = "SDMF"; $calltype = "Call"; }
    case "$MDMF_CALLER_ID"   { $formatText = "MDMF"; $calltype = "Call"; }
    case "$MDMF_MSG_WAITING" { $formatText = "MDMF"; $calltype = "Voicemail message waiting"; }
  }

  if (!$formatText) { return; }

  logMsg(1, "\nPretty decode\n");


  # indicate which bytes are parameter type, length and checksum
  my $marker = "^^";
  my $topLine = "#" . uc(unpack('H*', substr($mesg, 0, 2)));;
  my $botLine = "#    "; # don't need marker for payload type and length bytes
  if ( $format == $SDMF_CALLER_ID ) {
     # SDMF
     $i = 2; $reclen = 8;
     $topLine = $topLine . " " . uc(unpack('H*', substr($mesg, $i, $reclen))); #datetime
     $botLine = $botLine . " " . "  " x 8;
     $i += $reclen; $reclen = $mesglen - $i - 1;
     $topLine = $topLine . " " . uc(unpack('H*', substr($mesg, $i, $reclen))); #number
     $botLine = $botLine . " " . "  " x $reclen;
  }
  else {
    # MDMF
    for (my $i = 2; $i < $mesglen - 1; $i++) {
      $topLine = $topLine . " " . uc(unpack('H*', substr($mesg, $i, 1))); # param type
      $botLine = $botLine . " " . $marker;
      $i++;
      $reclen = vec($mesg, $i, 8);
      $reclenHex = uc(unpack('H*', substr($mesg, $i, 1)));
      $i++;
      $topLine = $topLine . $reclenHex . uc(unpack('H*', substr($mesg, $i, $reclen)));
      $botLine = $botLine . $marker . "  " x $reclen;
      $i += $reclen -1;
    }
  }
  $topLine = $topLine . " " . uc(unpack('H*', substr($mesg, $mesglen - 1, 1))); # checksum
  $botLine = $botLine . " " . $marker;
  logMsg(1, "$topLine\n");
  logMsg(1, "$botLine\n");
  logMsg(1, "#\n");


  #show a generic decode of the data structure
  logMsg(1,         "# Type Len              Data\n");
  my $outerFormat = "#  %3s %3s %s\n";
  my $innerFormat = "#  %3s %3s >%-11s %-38s %s\n";

  $reclen = vec($mesg, 1, 8);
  $reclenHex = uc(unpack('H*', substr($mesg, 1, 1)));

  logMsg(1, sprintf($outerFormat, $formatHex . "h", $reclenHex . "h", $formatText . " " . $calltype));

  if ( $format == $SDMF_CALLER_ID ) {
     # SDMF
     $i = 2; $reclen = 8;
     ($dataHexPairs, $dataText) = &hexPairs (substr($mesg, $i, $reclen));
     $paramLabel = "DateTime";
     $dataLabel = "";
     logMsg(1, sprintf($innerFormat, "", "",
                       $paramLabel, "$dataHexPairs $dataLabel", $dataText));

     $i += $reclen; $reclen = $mesglen - $i - 1;
     ($dataHexPairs, $dataText) = &hexPairs (substr($mesg, $i, $reclen));
     $paramLabel = $reclen == 1 ? "WhyNoNumber" : "Number";
     $dataLabel = "";
     logMsg(1, sprintf($innerFormat, "", "",
                       $paramLabel, "$dataHexPairs $dataLabel", $dataText));
  }
  else {
     # MDMF - Read each record of message
     for (my $i = 2; $i < $mesglen - 1; $i++) {
       $val = vec($mesg, $i, 8);
       $valHex = uc(unpack('H*', substr($mesg, $i, 1)));
       $i++;
       $reclen = vec($mesg, $i, 8);
       $reclenHex = uc(unpack('H*', substr($mesg, $i, 1)));
       $paramLabel = "";
       $dataLabel = "";
       $dataHexPairs = "";
       $dataText = "";
       $i++;
       ($dataHexPairs, $dataText) = &hexPairs (substr($mesg, $i, $reclen));
       switch($val) {
         case "$MDMF_VISUAL_IND" { # MESSAGE WAITING INDICATOR
           $paramLabel = "Voicemail";
           $noval = vec($mesg, $i, 8);
           $dataLabel = $noval == $MDMF_VISUAL_ON ? "  (Message(s) Waiting)" : "  (No Messages Waiting)";
         }
         case "$CALL_TYPE_UK" { # CALL TYPE -- ETSI FSK AND BT FSK
           $paramLabel = "ETSI/BT FSK";
           $noval = vec($mesg, $i, 8);
           switch ($noval) {
             case "$VOICE_UK" { $dataLabel = "  (Voice call)"; }       # Voice
             case "$RINGBACK_UK" { $dataLabel = "  (Ringback)"; }    # Ringback
             case "$MSG_WAITING_UK" { $dataLabel = "  (Message waiting)"; } # Message Waiting
           }
         }
         case "$MDMF_NMSS_UK" { # NUMBER OF WAITING VOICEMAIL MESSAGES
           # In &doMessage this case() assumes $MDMF_NMSS_UK immediately
           # follows $CALL_TYPE_UK. In &doPretty it does not assume this
           # and treats it generically like any other MDMF record.
           $paramLabel = "NMSS UK";
           $noval = vec($mesg, $i, 8);
           $dataLabel = "  (# of voicemail msgs waiting)";
         }
         case "$MDMF_DATETIME" { # DATE & TIME
           $paramLabel = "DateTime";
           $i += $reclen -1;
         }
         case "$MDMF_CALLER_NMBR" { # CALLER NUMBER
           $paramLabel = "Number";
           $i += $reclen -1;
         }
         case "$MDMF_WHY_NO_NMBR" { # NO NMBR PRESENT
           $paramLabel = "WhyNoNumber";
           $i += $reclen -1;
         }
         case "$MDMF_CALLER_NAME" { # CALLER NAME
           $paramLabel = "Name";
           $i += $reclen -1;
         }
         case "$MDMF_WHY_NO_NAME" { # NO NAME PRESENT
           $paramLabel = "WhyNoName";
           $i += $reclen -1;
         }
         else { # Skipping other records, if any
             $paramLabel = "Unknown";
             $i += $reclen -1;
         }
       }

       logMsg(1, sprintf($innerFormat, $valHex . "h", $reclenHex . "h",
                         $paramLabel, "$dataHexPairs $dataLabel", $dataText));
     }
  }

  $valHex = uc(unpack('H*', substr($mesg, $mesglen-1, 1)));
  logMsg(1, sprintf($outerFormat, $valHex . "h", "", "Checksum\n"));

}

sub hexPairs {
    # a more compact but still readable hexdump

    my $s = shift;
    my $text = $s;

    my $pairs = "";
    my $counter = 0;

    if ($s) {
       $text =~ s/[^[:print:]]/./g; # human readable
       if ($s ne $text ) {
          # There were one or more non-printable characters.
          # If there is only one, don't bother showing it;
          # its hex data will still be shown via $pairs.
          if ($text eq ".") { $text = ""; }
       }
       if ($text) { $text = "'$text'" };
       for (my $j = 0; $j < length($s); $j++) {
           if (($counter) && ($counter % 2 == 0)) { $pairs = $pairs . " "; }
           $pairs = $pairs . uc(unpack('H*', substr($s, $j, 1)));
           $counter++;
       }
    } else {
      $text = "<length is 0>";
    }

    return ( $pairs, $text );
}

sub doPID {
    # Only create a PID file if $pidfile contains a file name
    if ($pidfile ne "") {
        if (-e $pidfile) {
            # only one instance per computer permitted
            unless (open(PIDFILE, $pidfile)) {
                errorExit("pidfile exists and is unreadable: $pidfile\n");
            }
            $savepid = <PIDFILE>;
            close(PIDFILE);
            chop $savepid;

            # Check PID file to see if active PID in it
            # Does not work for Windows
            if (-d "/proc") {
                if (-d "/proc/$savepid") {
                    errorExit("Process ($savepid) already running: $pidfile\n");
                } else {
                    logMsg(1, "Found stale pidfile: $pidfile\n");
                }
            } else {
                my $ret = `ps $savepid 2>&1`;
                if ($? == 0) {
                    errorExit("Process ($savepid) already running: $pidfile\n");
                } elsif ($? != -1) {
                    logMsg(1, "Found stale pidfile: $pidfile\n");
                } else {
                    logMsg(1, "ps command not found\n");
                }
            }
        }

        if (open(PIDFILE, ">$pidfile")) {
            print(PIDFILE "$$\n");
            $pid = $$;
            close(PIDFILE);
            logMsg(1, "Wrote pid $pid in $pidfile\n");
        } else { logMsg(1, "Could not write pidfile: $pidfile\n"); }
    }
    else {logMsg(1, "Not using PID file\n");}
}

sub logMsg {
    my($level, $message) = @_;

    if (!defined $message) {print "Oops, unexpected exit\n"; exit 1}

    # write to STDOUT
    print $message if $debug && $verbose >= $level;

    # write to logfile
    print LOGFILE $message if $fileopen && $verbose >= $level;
}

sub cleanup() {
    close($ncidsock) if $ncidsock;
    if ($portHandle) {
      $port->close;
      untie($portHandle);
    }
    if ($pid) {
        unlink($pidfile);
        logMsg(1, "Removed $pidfile\n");
    }
}

sub sigHandle {
    my $sig = shift;
    cleanup();
    my $date = strftime("%m/%d/%Y %H:%M:%S", localtime);
    logMsg(1, "\nTerminated $date: Caught SIG$sig\n");
    close(LOGFILE);
    exit(0);
}

sub sigIgnore {
    my $sig = shift;
    my $date = strftime("%m/%d/%Y %H:%M:%S", localtime);
    logMsg(1, ": Ignored SIG$sig: $date\n");
}

sub errorExit {
    logMsg(1, "@_");
    cleanup();
    my $date = strftime("%m/%d/%Y %H:%M:%S", localtime);
    logMsg(1, "\nTerminated: $date\n");
    close(LOGFILE);
    exit(-1);
}

=head1 NAME

xdmf2ncid - XDMF Caller ID to NCID gateway

=head1 SYNOPSIS

 xdmf2ncid [--configfile        | -C <filename>]
           [--debug             | -D]
           [--delay             | -d <seconds>]
           [--help              | -h]
           [--hostname-flag     | -H <0|1>]
           [--ht9032-ic         | -I <0|1>]
           [--logfile-append    | -l <filename>]
           [--logfile-overwrite | -L <filename>]
           [--man               | -m]
           [--ncidhost          | -n <[host][:port]>]
           [--pidfile           | -p <filename>]
           [--pretty]
           [--test              | -t]
           [--test-file         | -T <testfile>]
           [--usbport           | -u <USB port>]
           [--verbose           | -v <1-9>]
           [--version           | -V]

=head1 DESCRIPTION

The B<xdmf2ncid> gateway obtains Caller ID and messages from an SDMF
or MDMF USB device (or modem) and sends the information to the
NCID server. The server then sends the CID information to the NCID clients.

The USB port is set to 1200 baud with 1 start bit, 8 data bits,
1 stop bit and no parity.

The gateway uses the USB port as the default B<line identifier>,
for example ttyUSB0.

The B<line identifier> can be aliased by the NCID server so you can give
each phone line a meaningful identification such as  the last 4 digits of
the phone number.  For example: B<1234>.  You can even use the complete
phone number if you desire.

The configuration file is B</etc/ncid/xdmf2ncid.conf>.
See the xdmf2ncid.conf man page for more details.

The B<xdmf2ncid> gateway can run on any computer, but normally it is run
on the same box as the NCID server.  If it is not run on the same box as the
NCID server, you must configure the server IP address in the configuration
file.

=head1 REQUIREMENTS

Perl 5.6 or higher,
perl(Config::Simple)

=over

=item The NCID server

http://ncid.sourceforge.net/ncid/ncid.html

=back

Either one of the following:

=over

=item CTI Comet USB Caller ID

http://www.crucible-technologies.co.uk/products/WEB-COMET

=item Modem

configured for Caller ID by setting AT+VCID=2

=item Holtek HT9032D based PSTN Caller ID module with required USB adapter

https://www.aliexpress.com/item/-/32807442435.html

http://cutedigi.com/pstn-caller-id-module-for-arduino-pcduino/

=over

=item USB to UART TTL cable adapter for PC connection

https://www.aliexpress.com/item/-/1859099599.html

http://store.linksprite.com/ttl-uart-to-usb-cable-serial-usb-debug-cable/

=back

=item Possibly other Type I Caller ID devices using the HT9032

http://www.holtek.com.tw/documents/10179/116745/an0053e.pdf

=back

=head1 OPTIONS

=over 2

=item -C, --configfile <filename>

Specifies the configuration file to use.  The program will still run if
a configuration file is not found.

Default: /etc/ncid/xdmf2ncid.conf

=item -D, --debug

Debug mode, displays all messages that go into the log file.
Use this option to run interactively.

=item -d <seconds>, --delay <seconds>

If the connection to the NCID server is lost,
try every <delay> seconds to reconnect.

Default: 15

=item -h, --help

Displays the help message and exits.

=item -H <0|1>, --hostname-flag <0|1>

When the hostname flag is set to 1, the IDENT string sent to a server
will include the hostname with the program name.

Default: 0

=item -I <0|1>, --ht9032-ic <0|1>

Set to 0 for input from either the CTI Comet USB or modem, or set to 1 for
input from the Holtek HT9032D based PSTN Caller ID module or
possibly other devices based on the Holtek HT9032 IC.

Default: 0

=item -l, --logfile-append <filename>

=item -L, --logfile-overwrite <filename>

Specifies the logfile name to write.  The program will still run if
it does not have permission to write to it.

If both options are present, --logfile-append takes precedence.

Default: Append to /var/log/xdmf2ncid.log

=item -m, --man

Displays the manual page and exits.

=item -n <[host][:port]>, --ncidhost <[host][:port]>

Specifies the NCID server.
Port may be specified by suffixing the hostname with :<port>.

Input must be <host> or <host:port>, or <:port>

Default:  localhost:3333

=item -p, --pidfile <filename>

Specifies the pidfile name to write. The program will still run if
it does not have permission to write a pidfile. The pid filename that
should be used is F</var/run/xdmf2ncid.pid>.

Default: no pidfile

=item --pretty

Provides a more structured, decoded output for debugging and development
purposes. Output is in the form of perl comment lines, suitable for
insertion into F<test-xdmf-calls.data>.

=item -t, --test

Test mode is a connection to the SDMF or MDMF USB Caller ID device,
to the gateway without a connection to the NCID server.
It sets debug mode and verbose = 4.
The verbose level can be changed on the command line.

Default: no test mode

=item -T, --test-file

The test-file mode uses a test file as input instead of a SDMF or MDMF USB Caller ID device.
If test mode is also set, there is no connection to the NCID server.
It sets debug mode and verbose = 4.
The verbose level can be changed on the command line.

Default: no test file mode

=item -u <USB port>, --usbport <USB port>

Specifies the USB port to listen on for messages from an XDMF device.

Default "/dev/ttyUSB0"

=item -v, --verbose <1-9>

Output information, used for the logfile and the debug option.  Set
the level to a higher number for more information.  Levels range from
1 to 9, but not all levels are used.

Default: verbose = 1

=item -V, --version

Displays the version.

=back

=head1 EXAMPLES

=over 4

=item Start xdmf2ncid in test mode at verbose level 3

xdmf2ncid --test

=item Start xdmf2ncid in debug mode at verbose level 1

xdmf2ncid -D

=back

=head1 FILES

/etc/ncid/xdmf2ncid.conf

=head1 SEE ALSO

xdmf2ncid.conf.5,
ncidd.8,
ncidd.conf.5,
ncid_gateways.7

=cut
