#!/usr/bin/perl
#
# Purpose:      Dial the OOB on a cisco router
#               and determine the OOB if the
#               OOB line is up and functioning
#               properly
#
# Code by Brad Lhotsky <brad@divisionbyzero.net>
# Based off code by jcwren on http://perlmonks.org
#
# Note: The modem (US Robotics 56k v.90 Fax Sportster)
#       had no support for advanced error messages such
#       as "ring no answer" and various other "higher
#       level" error messages so I am using my own methods
#       to report what error messages get generated.
#
$|++;
use strict;                                     # always
use Device::SerialPort;                         # so we can communicate with modem
use IPC::ShareLite;                             # for sharing memory
use POSIX "sys_wait_h";                         # for flags for waitpid
use Time::HiRes qw(gettimeofday);               # for more error handling using times
use Time::localtime;                            # for logging date format crap.
use Getopt::Std;                                # to get command line options

###################
# Defaults, for my
# sanity more than 
# anything else
my $DEF_DEV = '/dev/cua1';                      # set this for fun
my $DEF_USR = '';                        # should be a "read only" user
my $DEF_PWD = '';                      # see above
my $DEF_RTR = 3;                                # for sanity
my $DEF_TMO = 90;                               # for sanity

###################
# configs.
my %OPTS = ();                                  # options hash
getopts("d:l:nr:t:u:p:hva", \%OPTS);            # get options
help() if $OPTS{'h'};
my $DEVICE = $OPTS{'i'} || $DEF_DEV;            # serial port ext. modem is on
my $NOISEDIAL = $OPTS{'n'};                     # Turn on/off the modem speaker
my $BAUD = 9600;                                # our initial baud rate
my $MINBAUD = 9600;                             # if we find a baud less than this, bitch
my $USERNAME = ($OPTS{'u'} || $DEF_USR) . "\n"; # username for the router
my $PASSWORD = ($OPTS{'p'} || $DEF_PWD)."\n";   # password for the router
my $MAX_RETRY = $OPTS{'r'} || $DEF_RTR;         # number of times we retry
my $LOG = $OPTS{'l'};                           # log file
my $TIMEOUT = $OPTS{'t'} || $DEF_TMO;           # how long before we determine failure
my $DIALPREFIX = 91;                            # to get an outside line

if($LOG) {
        open LOG, ">>$LOG" or die "couldn't open debug.out: $!\n";
        select(LOG); $|++; select('stdout');
}
###################
# Globals.
my %FAILED = ();
my @GOOD = ();

####################
# Modem commands 
# that might be fun.
my $MODEM_HANGUP = "ATH1\n";            # modem hangup, clear the line.
my $MODEM_QUIET = "ATM0\n";             # silence the speaker
my $MODEM_SOUND = "ATM1\n";             # unsilence the speaker

####################
# assemble our list
# of modems to dial
my $LIST = $ARGV[0];
die "usage: $0 sitefile ($ -h for more info)\n" unless -e $LIST;
my %SITES = ();         # Global sites hash.

open(CFG, "<$LIST") or die "could not open $LIST: $!\n";
my $TOTALNUM = 0;
while(local $_ = <CFG>) {
        s/^\s+//; s/\s+$//;
        next if !$_ || /^#/;
        ($_, undef) = split /\s*#\s*/;
        next if !$_;
        my ($site,$number) = split/\s*:\s*/;
        next unless $site && $number;
        next if exists $SITES{$site};   # no duplicates over writing crap.
        $SITES{$site} = $number;
        $TOTALNUM++;
}
close CFG;
die "$LIST: empty configuration file!\n" unless $TOTALNUM;
logthis("SYSTEM","Loaded $TOTALNUM numbers to check!");

foreach my $site (sort keys %SITES) {
        print "Testing $site ... " unless $OPTS{'v'};
        my $share = new IPC::ShareLite( -key => 6969,
                                        -create => 'yes',
                                        -destroy => 'no',
                                        -size => 1024) or die "Couldn't share memory: $!\n";
        my $SUCCESS = 0;
        my $REASON = "";
        # using this method of forking
        # is the only way to "next" in a loop using
        # alarm and trapping SIG_ALRM
        # many thanks to mikfire for this idea
        my $pid = fork();
        if($pid == 0) {
                # we're the child, do the grunt work
                exit OOBtest($site,$SITES{$site});
        } elsif(defined $pid) {
                # wait for the child to finish
                my $tmp = waitpid($pid,'');
                # Success/failure returned through OOBtest()
                # gets thrown in $? so lets check it.
                $SUCCESS = $?;
        } else {
                die "fork error: $!\n";
        }
        if(!$SUCCESS) {
                $REASON = $share->fetch() || "Unknown failure condition";
                $FAILED{$site} = $REASON;
        } else {
                push @GOOD,$site;
        }
        print "done.\n" unless $OPTS{'v'};
} # EOForeach


for(sort keys %FAILED) { print "FAILED: $_ : " . $FAILED{$_} . "\n"; }
for(sort @GOOD) { print "GOOD: $_\n"; }


#################################
# here's where the work is done.
sub OOBtest {
        my ($site,$number) = @_;
        # we'll use this hash to determine whether
        # or not we miss any steps along the way
        my %STAGES = (  "connect" => 0,
                        "login" => 0,
                        "password" => 0,
                        "prompt" => 0
                );
        my @STAGES = ("connect", "login", "password", "prompt");
        my $share = new IPC::ShareLite( -key => 6969,
                                        -create => 'no',
                                        -destroy => 'no',
                                        -size => 1024) or die "couldn't share memory: $!\n";
        $share->store('NONE');
        my $ob = new Device::SerialPort ($DEVICE, 1);
                die "Couldn't access $DEVICE: $!\n" unless $ob;
        $SIG{"ALRM"} = sub {
                                select undef, undef, undef, 0.5;
                                if($share->fetch ne 'NONE') {
                                        my $newmsg = $share->fetch() . ", Timeout after $TIMEOUT seconds";
                                        $share->store($newmsg);
                                } else {
                                        $share->store("Timeout after $TIMEOUT seconds");
                                }
                                logthis($site,"FATAL ERROR: Connection Timedout after $TIMEOUT seconds");
                                $ob->close;
                                select undef, undef, undef, 0.5;
                                undef $ob;
                                select undef, undef, undef, 0.5;
                                exit 0; 
                        }; 
        alarm($TIMEOUT);
        ###################
        # setup device
        select undef, undef, undef, 0.5;        # sleep for half a second
        $ob->baudrate($BAUD);
        $ob->parity('none');
        $ob->databits(8);
        $ob->stopbits(1);
        $ob->handshake('none');
        $ob->stty_icrnl(1);
        $ob->stty_ocrnl(1);
        $ob->stty_onlcr(1);
        $ob->stty_opost(1);
        $ob->write_settings;
        select undef, undef, undef, 0.5;        # sleep for half a second

        $ob->write($MODEM_HANGUP);              # clear the line
        select undef, undef, undef, 1.5;        # sleep for one and half a second
        my $buff = $ob->input;
        if($buff =~ /OK/) {
                logthis($site,"INIT: Modem hangup sent, line cleared.");
        } else { 
                logthis($site,"INIT ERROR: Modem did not respond to hangup");
        }
        if(!$NOISEDIAL && !$OPTS{'a'}) {
                $ob->write($MODEM_QUIET);               # silence the modem
                select undef, undef, undef, 1.5;        # sleep for one and half a second
                my $buff = $ob->input;
                if($buff =~ /OK/) {
                        logthis($site,"INIT: Modem sound off.");
                } else {
                        logthis($site,"INIT ERROR: Modem did not respond to sound off");
                }
        } else {
                $ob->write($MODEM_SOUND);               # make some noise
                select undef, undef, undef, 1.5;        # sleep for one and half a second
                my $buff = $ob->input;
                if($buff =~ /OK/) {
                        logthis($site,"INIT: Modem sound on.");
                } else {
                        logthis($site,"INIT ERROR: Modem did not respond to sound on");
                }
        }
        select undef, undef, undef, 0.5;        # sleep for half a second

        my $dial = $OPTS{'a'} ? "ATDP $DIALPREFIX$number\n" : "ATDT $DIALPREFIX$number\n";
        logthis($site,"DIAL STR: $dial"); 
        ########################
        # Setup the environment
        my $RETRY = 0;
        my $DONE = 0;
        my $TOTALIN = 0;
        my $TOTALOUT = 0;
        my $SUCCESS = 0;
        my $ERROR = "";
        my $DIAL_TIME = gettimeofday;
        $ob->write($dial);
        select undef, undef, undef, 0.5;        # sleep for half a second
        while(!$DONE) {
                # this next bit of code is purely
                # for my own amusement.
                my ($inbytes,$outbytes) = (0,0);
                (undef, $inbytes, $outbytes, undef) = $ob->status or
                        warn "could not get port status!\n";
                $TOTALIN += $inbytes;
                $TOTALOUT += $outbytes;
                # end amusement
                if(my $line = $ob->input) {
                        $line =~ s/[\r\n\cM]//mg;
                        if($line =~ /CONNECT\s+(\d+)/i) {
                                # We have initialized!
                                $STAGES{"connect"}++;
                                # Check other end's baudrate and 
                                # adjust if need be.
                                if($1 != $BAUD) {
                                        if($1 < $MINBAUD) {
                                                $share->store("Baudrate of $1 is less than minimum ($MINBAUD)");
                                        }
                                        logthis($site,"CONN: baudrate is now $1");
                                        $ob->baudrate($1);
                                        $ob->write_settings;
                                        # pause momentarily
                                        select undef, undef, undef, 1.2;
                                }
                                # now we have to "press enter a few times"
                                $ob->write("\n\n");
                        } elsif($line =~ /(NO CARRIER)/i || $line =~ /(BUSY)/i) {
                                # we failed, keep trying!
                                my $err = $1;
                                if($RETRY > $MAX_RETRY) {
                                        if($line =~ /(BUSY)/i) {
                                                logthis($site,"DIAL ERROR: Remote line busy");
                                                $share->store("Line was busy");
                                        } else {
                                                # using the time between dialing to determine
                                                # local or remote lack of a carrier
                                                my $diff = gettimeofday - $DIAL_TIME;
                                                $diff *= 100;
                                                logthis($site,"DIAL DIFF: $diff");
                                                if($diff > 800) {
                                                        $share->store("Local modem had no free line");
                                                } else {
                                                        $share->store("No answer from remote modem");
                                                }
                                        }
                                        logthis($site,"FATAL ERROR: Reached maximum retry for $site");
                                        $DONE++;
                                        last;
                                }
                                $share->store("line status $err (retry $RETRY of $MAX_RETRY)");
                                logthis($site,"ERROR: line status $err (retry $RETRY of $MAX_RETRY)");
                                $RETRY++;
                                my $diff = (gettimeofday - $DIAL_TIME)*100;
                                if($diff > 800) {
                                        if($line =~ /BUSY/i) {
                                                logthis($site,"DIAL ERROR: Remote line was busy");
                                        } else {
                                                logthis($site,"DIAL ERROR: Remote modem did not pickup");
                                        }
                                } else {
                                        if($line =~ /BUSY/i) {
                                                logthis($site,"DIAL ERROR: Remote line was busy");
                                        } else {
                                                logthis($site,"DIAL ERROR: Local modem had no free line");
                                        }
                                }
                                $ob->write($MODEM_HANGUP);
                                logthis($site,"REDIAL: clearing line");
                                select undef, undef, undef, 1.5;
                                $DIAL_TIME = gettimeofday;
                                $ob->write($dial);
                                select undef, undef, undef, 0.5;
                                logthis($site,"REDIAL ($RETRY of $MAX_RETRY): dialing $number"); 
                        } elsif($line =~ /sername\:/i || $line =~ /ogin\:/i) {
                                # got login prompt
                                $STAGES{"login"}++;
                                # attempt to login
                                $ob->write($USERNAME);
                                logthis($site,"CONN: sent username");
                        } elsif($line =~ /assword\:/i) {
                                # password prompt
                                $STAGES{"password"}++;
                                $ob->write($PASSWORD);
                                logthis($site,"CONN: sent password");
                        } elsif($line =~ /[\w().-]*[\$#>]/) {
                                # prompt
                                # which is all we were looking for!
                                $STAGES{"prompt"}++;
                                logthis($site,"CONN: Got to our prompt!");
                                $DONE++;
                                last;
                        }
                }
                select undef, undef, undef, 0.5;        # sleep for half a second.
        }
        logthis($site,"Closing serial port.");
        sleep 1;
        $ob->close;
        sleep 1;
        undef $ob;
        logthis($site,"Total bytes transferred: $TOTALIN (in), $TOTALOUT (out)","Session closed.");
        my $stageError = 0;
        for(keys %STAGES) { $stageError++ if !$STAGES{$_}; }
        if($stageError) {
                my $logmsg = "FAILED CONNECTION STAGES: ";
                if($share->fetch eq 'NONE') {
                        $share->store("FAILED CONNECTION STAGES: ");
                } else {
                        my $new = $share->fetch() . ", FAILED CONNECTION STAGES:";
                        $share->store($new);
                }
                foreach my $stage (@STAGES) {
                        if(!$STAGES{$stage}) {
                                $logmsg .= " $stage";
                                my $new = $share->fetch() . " $stage";
                                $share->store($new);
                        }
                }
                logthis($site,$logmsg);
                return 0;
        }
        return 1;
}

sub logthis {
        my $site = shift;
        my @msgs = @_;
        my $date = ctime();
        foreach my $msg (@msgs) {
                $msg =~ s/[\r\n\cM]//g;
                $LOG && print LOG "$date - $site - $msg\n";
                print "$date - $site - $msg\n" if $OPTS{'v'};
        }
}

sub help {
        print <<"       EOHELP";
        OOB Test Dialer v0.1
        --------------------
        Code by:
                Brad Lhotsky <brad\@divisionbyzero.net>
        Distributed under the same license as perl itself,
        use at your own risk, and fight UCITA.

        usage: $0 [-anhv] [-l logfile] [-r maxretry] [-d device] \
                [-t timeout (in seconds)] [-u username] [-p password] \
                filewithnumbers

        options:
                h - display this message
                d <device> - interface, typically /dev/cuaN of /dev/ttySN
                             where N is the port number.
                                default: $DEF_DEV
                l <logfile> - file to append information to
                                default: off
                v - display all log info to STDOUT (can be used with -l)
                                default: off
                n - noisy dialing (turn modem speaker on)
                                default: off
                a - annoying (enable pulsa dialing)
                                default: off
                t <timeout> - timeout in seconds
                                default: $DEF_TMO
                r <number> - number of retries per number
                                default: $DEF_RTR
                u <username> - username to login
                p <password> - password to login

        EOHELP
        exit 0;
}