This is a small GUI tool to check whether a network service is available, by simply trying to establish TCP connection to it. Of course, that service has to be TCP based. Also I take the assumption that, as long as I can establish the connection, the service is available. This assumption is not 100% correct, but I expect it to be alright for most of the time. Obviously I want this small tool to be generic, and not to get into the detail of each service.

To use it:

1. Add your own services to DATA part of the script. One line for each service. Each line starts with hostname, which could be name, could be IP address, followed by port number, with a ‘:’ in between IP address and port number. The last part of each line is a description of the service in free text, but make sure you have at least one space after the port number.
2. You can select service from the list widget. Those are the services defined in DATA. It responses to single click, as well as up, down, and return keys.
3. You can type a service into the entry widget on fly, as long as you follow the ip_address:port format. It responses to return key.
4. click “connect” button, it will try to connect to whatever shows in entry widget at that time.

#!/usr/bin/perl

use strict;

use Tk;
use IO::Socket::INET;

my $poll_result = "";
my $sel_node;
my $service = init_service();

my $mw = new MainWindow(title => "Service Polling");

my $operation_frame = $mw->Frame(relief => "sunken",
                                 background => "pink",
                                 borderwidth => 1)
                         ->pack(fill => "x");
my $entry = $operation_frame->Entry(width => 20, 
                                    textvariable => \$sel_node)
                            ->pack(side => "left",
                                   padx => 5);
$entry->bind("<Return>", \&poll_service);
$operation_frame->Button(text => "Connect",
                         background => "green",
                         activebackground => "yellow",
                         command => \&poll_service)       
                ->pack(side => "left",
                       padx => 5,
                       pady => 5);

my $node_list = $mw->Scrolled("Listbox",
                              background => "pink",
                              height => 10,
                              yscrollcommand => \&change_service,
                              -scrollbars => "e")
                   ->pack(fill => "x");
$node_list->bind("<Button-1>", \&change_service);
$node_list->bind("<Down>", \&change_service);
$node_list->bind("<Up>", \&change_service);
$node_list->bind("<Return>", \&poll_service);
foreach (keys %{$service}) {
    $node_list->insert("end", $_);
}

$mw->Label(textvariable => \$poll_result,
           foreground => "red",
           anchor => "w")
   ->pack(fill => "x");

MainLoop;

sub init_service {
    my $services = {};
    while (<DATA>) {
        m/^(.*?)\s+(.*)$/;
        $service->{$2} = $1;
    }
    return $service;
}

sub change_service {
    $node_list->focus();
    my $sel_index = $node_list->curselection;
    $sel_node = $service->{$node_list->get($sel_index)} if (defined($s
+el_index));
}

sub poll_service {
    if (defined($sel_node)) {
        $sel_node =~ /(.*?):(.*)/;
        my $connection = new IO::Socket::INET(Proto => "tcp", 
                                            PeerAddr => $1, 
                                            PeerPort => $2);
        $poll_result = (defined($connection)) ? "Service available" : 
+" Service unavailable";
        close($connection) if (defined($connection));
    }
}

__DATA__
ofgaix2:27011 AADV1 WebLogic 
ofgaix2:28001 AAUA1 WebLogic
ofgaix2:27021 AATS1 WebLogic
[download]