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 ######
page revision: 4, last edited: 04 Jan 2009 23:02