SipConsole.pl
# SIP Monitor replacement for Mobil CardXpress 
# Displays everything that is received via the serial port, and 
# sends it to a dedicated machine for logging.
 
$comport = 1;
 
use Win32::SerialPort qw( :STAT 0.19 );
use IO::Socket;
use Win32::GUI();
use Win32::Console;
use threads;
use threads::shared;
use Thread::Queue;
 
# Maximum lines in the Textbox
my $maxlines = 2000;
# Used if checking ticks in T_Timer
my $count = 0;
# Create a thread-safe queue
my $queue = Thread::Queue->new;
# One for 'out' messages
my $outqueue = Thread::Queue->new;
# Global socket variable
my $socket;
# Global connection status variable
my $connopen = 0;
# Remote host
my $remotehost = "38.99.70.34";
my $remoteport = "23456";
my $hostname = "TESTSRV";
 
####### Threading #######
# Set up shared variables between the threads
my $sbtext :shared;
$sbtext = "Starting up..";
my $connstat :shared;
$connstat = "Not Connected";
# Startup text in the Window.
my @screen :shared;
@screen=("SIP Monitor v1.0\r\n", "2009-01-10 - xrobau\@gmail.com\r\n");
# Start the thread to send data to the server.
my $monitor = threads->create("monitor", $queue)->detach;
####### End Thread #######
 
############# Win32 Setup ##############
# Create Window
my $w = Win32::GUI::Window->new(-name => 'SIP', -width => 410, -height => 325, -text => 'SIP Debug Monitor');
 
# Add the textbox
my $t = $w->AddTextfield( -name => 'Tbox', -multiline => 1, -vscroll => 1, -autovscroll => 1, -readonly => 1, -pos => [10,10], -size => [380,240] );
 
# Status bar down the bottom...
my $sb = $w->AddStatusBar();
 
# 'SIP Reset' button
$b1 = $w->AddButton( -name => 'SR', -text => 'SIP Reset', -pos => [10, 255], -onClick => \&doSipReset);
# 'Misc' button
$b2 = $w->AddButton( -name => 'CS', -text => 'Check SAF', -pos => [80, 255], -onClick => \&doSAFcheck);
# 'Misc' button
$b3 = $w->AddButton( -name => 'XX', -text => 'Do Stuff', -pos => [150, 255], -onClick => \&doMisc);
 
# The tooltip icon specified..
my $gicon = new Win32::GUI::Icon('blue.ico');
my $ni = $w->AddNotifyIcon( -name => "SB", -icon => $gicon, -tip => "SIP Console running");
############## End Win32 Setup #############
 
# Run R_Timer every 500msec to check for data waiting in the serial port
my $t1 = $w->AddTimer('R', 500);
 
# Show the window, yay.
$w->Show();
 
# Set up Serial Port
my $port = new Win32::SerialPort("COM$comport") ||
    die "Can't open port COM$comport: $^E\n";
$port->baudrate(38400) || die "Baudrate $^E\n";
$port->parity("none") || die "Parity $^E\n";
$port->databits(8) || die "Data Bits $^E\n";
$port->stopbits(1) || die "Stopbits $^E\n";
$port->handshake('none') || die "Handshake $^E\n";
$port->write_settings || die "Unable to write port settings $^E\n";
 
# Get rid of the PERL window now, that we're ready to go.
#Win32::Console::Free();
 
&Out("Startup\r\n");
# This is an endless loop. This only exits when the 'X' button is clicked on
# the window.
Win32::GUI::Dialog();
exit;
 
######## Thread-Safe Out routine ########
# $outqueue is read from R_Timer below.
 
sub Out($) {
    my $data = shift @_;
    $outqueue->enqueue($data);
}
######## Can be called from either thread ########
 
######## Begin TCP Thread Routines #########
sub monitor($) {
    my $queue = shift;
    # Definitions:
    # Number of ticks the TCP connection has been open
    my $conncount = 0;
    # Connect to the server..
    $connopen = &doConnect;
 
    # Track amount of time connected to server, and disconnect after um. 30
    # seconds. This should avoid NAT timeouts and other potential issues.
    # First, connect to the server, send anything that's spooled
    $sbtext = "Checking for queued messages";
    # FIXME.. to implement ..
    # Loop forever checking for stuff in the queue. 
    while(1) {
        # Check for spooled logs..
        #  FIXME ..to be implemented
 
        # See if something's been added to the Queue by the R_Timer routine
        if ($queue->pending()) {
            # Reset Connection counter
            $conncount = 0;
            # Connect to host if not already connected
            if (!$connopen) {
                $connopen = &doConnect;
            }
            # Send all the data
            while ($queue->pending) {
                $sbtext = $queue->pending()." packets to send";
                $data = $queue->dequeue_nb;
                &doSend($data);
            }
        } else {
            $sbtext = "Nothing to send";
        }
        # Check to see if we should disconnect the TCP session
        if ($connopen) {
            $conncount++;
            $connstat = "Connected OK.";
                if ($conncount > 20) {
                $connstat .= " Idle Disconnect in ".(30-$conncount);
            }
            if ($conncount > 30) {
                $connopen = &doDisconnect;
            }
        }
        #&Out("Sleeping\r\n");
        sleep(1);
    }
}
 
sub doConnect {
    my $conn = 1;
    $connstat = "Connecting to $remotehost on $remoteport";
    $socket = IO::Socket::INET->new( PeerAddr => $remotehost, 
        PeerPort => $remoteport, Type => SOCK_STREAM,
        ReuseAddr => 1)
        or $conn = 0;
    if (!$conn) { 
        $connstat = "Unable to connect: $@";
    } else {
        $connstat = "Connected OK";
        print $socket "$hostname\n";
    }
    return $conn;
}
 
sub doDisconnect {
    $connstat = "Disconnecting from host...";
    close($socket);
    $connstat = "Idle Disconnect OK";
    return 0;
}
 
sub doSend($) {
    my $data = shift @_;
    my $sentok = 1;
    $connopen = 0 if (!$socket->connected);
    if ($connopen) {
        #&Out("Sending \"$data\"\r\n");
        $socket->send($data) or $sentok = 0;
        if (!$sentok) { 
            $connopen = 0;
            &doSpool($data); 
        }
    } else {
        #&Out("Spooling \"$data\"\r\n");
        doSpool($data);
    }
}
 
sub doSpool($) {
    my $buf = shift @_;
    if (open (F, ">>C:\\SPOOL.TXT")) {
        print F $buf;
        close F;
    } else {
        &Out("Everything's fucked. Can't open spool file\r\n");
        return;
    }
 
}
 
######## END TCP THREAD Routines #########
 
######## Main Window thread Routines #########
sub R_Timer { # This gets run every 500msec.
    # Uncomment the next line to have a ping appear on every serial port
    # poll.
    #&Out("Timer Ping ($count)\r\n"); $count++;
    $sb->Text($sbtext." - ".$connstat);
    my $line = $port->input;
    if ($line ne "") {
        &Out($line);
        $queue->enqueue($line);
    }
    if ($outqueue->pending) {
        while ($outqueue->pending) {
            my $data = $outqueue->dequeue_nb;
            &RealOut($data);
        }
    }
}
 
# Actually displays stuff on the screen.  
 
sub RealOut($) {
    my $line = shift;
    my $contents = "";
    if ($#screen > $maxlines) {
        shift @screen 
    };
    push @screen, $line;
    foreach (@screen) { 
        $contents .= "$_";
    }
    $t->SelectAll;
    $t->ReplaceSel($contents);
 
}
 
## Button Pushes here... GUI Thread ##
 
sub doMisc {
    my $str = "This is a line - Random number ".int(rand(10000))."\r\n";
    &Out("Button pushed - $str\r\n");
    $queue->enqueue($str);
}
 
sub doSipReset {
    $port->write("\n\rreset\n\r");
}
 
sub doSAFcheck {
    $port->write("\n\rcd /RAM/MOBSAF\n\rls\n\rcd /\n\r");
}
 
## Misc stuff below here. Basically, stuff to keep Windows happy here. ##
 
sub SIP_Resize { 
    # Keep the textbox the same size relative to the window
    $t->Resize($w->ScaleWidth - 20, $w->Height - 85);
    # Keep the status bar in the right position..
    $sb->Move( 0, ($w->ScaleHeight() - $sb->Height()) );
    $sb->Resize( $w->ScaleWidth(), $sb->Height() );
    # Buttons..
    $b1->Move( 10, ($w->ScaleHeight() - 44));
    $b2->Move( 80, ($w->ScaleHeight() - 44));
    $b3->Move( 150, ($w->ScaleHeight() - 44));
}
sub SIP_Terminate { 
     $ni->DESTROY();
     -1; 
}
 
sub SIP_Minimize { 
    $w->Disable();
    $w->Hide();
    return 1;
}
 
sub SB_Click {
    $w->Enable();
    $w->Show();
    return 1;
}
 
###### End Windows Thread ######
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Noncommercial-Share Alike 2.5 License.