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]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.