#!/usr/bin/perl -w
use strict;
use IO::Socket;
use Tk 8.0;
use Tk::Checkbutton;
use Tk::Menubutton;
use Tk::Optionmenu;
#---------------------------------------------------
# Begin variable declaration
#---------------------------------------------------
my $version = "1.4";
my $mainWindow;
my ($menuBar, $fileMenu, $updateMenuItem, $addMenuItem, $deleteMenuIte
+m, $configMenuItem, $exitMenuItem, $helpMenu, $aboutMenuItem);
my ($labelFrame, $mainFrame, @listFrame);
my (@serverList, @portList, @statusList, @deleteCheckbox, @serverDelet
+e);
my ($serverTitle, $portTitle, $statusTitle, $deleteTitle);
my ($buttonFrame, $updateButton, $addButton, $deleteButton, $exitButto
+n);
my (%config, %servers, %ports);
my $serverCount = 0;
#---------------------------------------------------
# End variable declaration
#---------------------------------------------------
#---------------------------------------------------
# Begin main program
#---------------------------------------------------
# First off, see if there's a config file. If not, create it.
open (CONFIG, "status.cfg")
|| &createConfig();
# Pull the servers and ports out of the XML file into a hash
my $fileError;
open (FH, ".serverlist")
or $fileError = 1;
if (!$fileError) {
while (<FH>) {
if (/<server address="(.*?)" name="(.*?)" port="(.*?)" \/>/) {
$servers{$2} = $1;
$ports{$2} = $3;
}
}
}
close (FH);
# Just get the number of servers in the list so we can make the list
# boxes the right size
foreach (keys %servers) {
$serverCount++;
}
# Let's create the interface
#
# Create the main window where it will all be displayed
$mainWindow = MainWindow->new;
$mainWindow->title("Server Status");
# End main window creation
# Create a simple menubar with a File menu and a Help menu
$menuBar = $mainWindow->Frame(
-relief => 'groove',
-borderwidth => 2)
->pack(-side => 'top', -fill => 'x');
# Create the File menu
$fileMenu = $menuBar->Menubutton(
-text => 'File',
-underline => 0,
-tearoff => 0)
->pack(-side => 'left');
$updateMenuItem = $fileMenu->command(
-label => 'Update',
-underline => 0,
-command => sub {
\&updateServerList();
});
$addMenuItem = $fileMenu->command(
-label => 'Add server',
-underline => 0,
-command => sub {
\&addServerWindow();
});
$deleteMenuItem = $fileMenu->command(
-label => 'Delete server(s)',
-underline => 0,
-command => sub {
\&deleteServer();
});
$configMenuItem = $fileMenu->command(
-label => 'Configure',
-underline => 0,
-command => sub {
\&configWindow();
});
$exitMenuItem = $fileMenu->command(
-label => 'Exit',
-underline => 1,
-command => sub {
exit;
});
# Create the Help menu
$helpMenu = $menuBar->Menubutton(
-text => 'Help',
-underline => 0,
-tearoff => 0)
->pack(-side => 'right');
$aboutMenuItem = $helpMenu->command(
-label => 'About',
-underline => 1,
-command => sub {
\&aboutWindow();
});
# End menubar creation
# Create three frames... one for some labels, one for the list boxes,
# and one for the buttons
$labelFrame = $mainWindow->Frame()
->pack(-side => 'top', -anchor => 'w');
$mainFrame = $mainWindow->Frame()
->pack(-side => 'top');
$buttonFrame = $mainWindow->Frame(
-relief => 'groove',
-borderwidth => 2)
->pack(-side => 'top', -pady => 10, -fill => 'x');
# End frame creation
# Create the list box labels
$serverTitle = $labelFrame->Label(
-text => "Server",
-justify => 'left',
-width => 34)
->pack(-side => 'left');
$portTitle = $labelFrame->Label(
-text => "Port",
-justify => 'right',
-width => 6)
->pack(-side => 'left');
$statusTitle = $labelFrame->Label(
-text => "Status",
-justify => 'right',
-width => 6)
->pack(-side => 'left');
$deleteTitle = $labelFrame->Label(
-text => "Delete",
-justify => 'right',
-width => 7)
->pack(-side => 'left');
# End list box label creation
# Create the Update, Add, and Exit buttons
$updateButton = $buttonFrame->Button(
-text => "Update",
-underline => 0,
-command => sub {
\&updateServerList();
},
-width => 6)
->pack(-side => 'left');
$addButton = $buttonFrame->Button(
-text => "Add",
-underline => 0,
-command => sub {
\&addServerWindow();
},
-width => 6)
->pack(-side => 'left');
$deleteButton = $buttonFrame->Button(
-text => "Delete Selected",
-underline => 0,
-command => sub {
\&deleteServer();
},
-width => 12)
->pack(-side => 'left');
$exitButton = $buttonFrame->Button(
-text => "Exit",
-underline => 1,
-command => sub {
exit;
},
-width => 6)
->pack(-side => 'right');
# End button creation
# Create some key bindings for the buttons and menus
$mainWindow->bind('<Alt-Key-u>' => sub {
\&updateServerList();
});
$mainWindow->bind('<Alt-Key-a>' => sub {
\&addServerWindow();
});
$mainWindow->bind('<Alt-Key-d>' => sub {
\&deleteServer();
});
$mainWindow->bind('<Alt-Key-c>' => sub {
\&configWindow();
});
$mainWindow->bind('<Alt-Key-x>' => sub {
exit;
});
$mainWindow->bind('<Alt-Key-b>' => sub {
\&aboutWindow();
});
$mainWindow->bind('<Alt-Key-f>' => sub {
$fileMenu->Post('','',0);
return;
});
$mainWindow->bind('<Alt-Key-h>' => sub {
$helpMenu->Post('','',0);
return;
});
# End key bindings
#
# End interface creation
# Read the config file
%config = readConfig();
# Fill in the list boxes with server info
drawServerList();
# Cause the server info list boxes to refresh
$mainWindow->repeat($config{refresh}, \&updateServerList);
MainLoop;
#---------------------------------------------------
# End main program
#---------------------------------------------------
#---------------------------------------------------
# Begin subroutines
#---------------------------------------------------
#---------------------------------------------------
# Simply displays an About window
sub aboutWindow {
$aboutMenuItem->configure(-state => 'disabled');
my $aboutText = " -= Server Status v".$version." =-\n\nWritten by
+ :\tMike Roessing\nEmail\t :\tjaraxle\@the-den.org\nAddres
+s\t :\thttp:\/\/www.the-den.org\n";
my $aboutWindow = $mainWindow->Toplevel();
$aboutWindow->title("About Server Status");
$aboutWindow->focus();
$aboutWindow->resizable(0,0);
my $x = $mainWindow->rootx();
my $y = $mainWindow->rooty();
my $xCoord = $x + 38;
my $yCoord = $y + 10;
$aboutWindow->geometry("250x135+$xCoord+$yCoord");
# Make a top and bottom frame, top for the picture and About info,
# bottom for the Done button
my $topFrame = $aboutWindow->Frame()
->pack(-side => 'top');
my $bottomFrame = $aboutWindow->Frame()
->pack(-side => 'bottom');
# And now make a frame for the About info inside the topFrame
my $aboutFrame = $topFrame->Frame()
->pack(-side => 'left', padx => 15, pady => 10);
my $aboutLabel = $aboutFrame->Label(
-text => $aboutText,
-justify => 'left')
->pack(-side => 'top');
# Put the doneButton in the bottomFrame
my $closeButton = $bottomFrame->Button(
-text => "Close",
-underline => 0,
-command => sub {
$aboutMenuItem->configure(-state => 'active');
$aboutWindow->destroy();
},
-width => 6)
->pack(-side => 'top');
$aboutWindow->bind("<Alt-Key-c>" => sub {
$aboutMenuItem->configure(-state => 'active');
$aboutWindow->destroy();
});
}
#---------------------------------------------------
# Add the server and update the list
sub addServer {
my ($serverNameEntry, $serverIPEntry, $serverPortEntry) = @_;
my $serverName = $serverNameEntry->get;
my $serverIP = $serverIPEntry->get;
my $serverPort = $serverPortEntry->get;
# Check if the ip address entered fits the
# x(x(x)).x(x(x)).x(x(x)).x(x(x)) format
if ((!$serverName) || (!$serverIP) || !($serverIP =~ /^\d{1,3}\.\d
+{1,3}\.\d{1,3}\.\d{1,3}$/)) {
# Just draw a simple error window explaining the problem
my $errorWindow = $mainWindow->Toplevel();
$errorWindow->title("Error");
$errorWindow->focus();
$errorWindow->Label(
-text => "\nPlease make sure you entered\nan appropriate S
+erver Name.\n")
->pack(-side => 'top') if (!$serverName);
$errorWindow->Label(
-text => "\nPlease make sure you entered\na valid Server I
+P Address.\n")
->pack(-side => 'top') if ((!$serverIP) || !($serverIP =~
+/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/));
my $closeButtonFrame = $errorWindow->Frame()
->pack(-side => 'bottom', -pady => 10);
my $closeButton = $closeButtonFrame->Button(
-text => "Close",
-underline => 0,
-command => sub {
$errorWindow->destroy();
},
-width => 6)
->pack(-side => 'top');
$errorWindow->bind("<Alt-Key-c>" => sub {
$errorWindow->destroy();
});
} else {
# Delete the server list
clearServerList();
# Add the server and port to the hash and XML file
$servers{$serverName} = $serverIP;
$ports{$serverName} = $serverPort;
&writeServerList();
# Increment the server count and redraw the server list
$serverCount++;
drawServerList();
# Delete the server info we typed in, ready to add another
$serverNameEntry->delete(0, 'end');
$serverIPEntry->delete(0, 'end');
$serverPortEntry->delete(0, 'end');
}
}
#---------------------------------------------------
# Allow the user to add a server to the list
sub addServerWindow {
# Disable the Add button and menu item while the window is open
$addButton->configure(-state => 'disabled');
$addMenuItem->configure(-state => 'disabled');
# Draw the Add window
my $addServerWindow = $mainWindow->Toplevel();
$addServerWindow->title("Add a server");
$addServerWindow->resizable(0,0);
my $x = $mainWindow->rootx();
my $y = $mainWindow->rooty();
my $xCoord = $x + 11;
my $yCoord = $y + 10;
$addServerWindow->geometry("310x170+$xCoord+$yCoord");
# Create one frame for the text entry boxes, another frame for the
# buttons
my $topFrame = $addServerWindow->Frame()
->pack(-side => 'top');
my $bottomFrame = $addServerWindow->Frame(
-relief => 'groove',
-borderwidth => 2)
->pack(-side => 'top', -pady => 10, -fill => 'x');
# Draw the text entry boxes, with labels (give the Server Name entry
# focus)
my $serverNameLabel = $topFrame->Label(
-text => "Server Name")
->pack(-side => 'top');
my $serverNameEntry = $topFrame->Entry(
-width => 50)
->pack(-side => 'top');
$serverNameEntry->focus();
my $serverIPLabel = $topFrame->Label(
-text => "Server IP Address")
->pack(-side => 'top');
my $serverIPEntry = $topFrame->Entry(
-width => 50)
->pack(-side => 'top');
my $serverPortLabel = $topFrame->Label(
-text => "Server Port")
->pack(-side => 'top');
my $serverPortEntry = $topFrame->Entry(
-width => 10)
->pack(-side => 'top');
# Draw the buttons to add the server, clear the entered info, and clos
+e
# the Add window
my $addServerButton = $bottomFrame->Button(
-text => "Add",
-underline => 0,
-command => sub {
&addServer($serverNameEntry, $serverIPEntry, $serverPortEn
+try);
$serverNameEntry->focus();
},
-width => 6)
->pack(-side => 'left');
my $resetButton = $bottomFrame->Button(
-text => "Reset",
-underline => 0,
-command => sub {
$serverNameEntry->delete(0, 'end');
$serverIPEntry->delete(0, 'end');
$serverNameEntry->focus();
},
-width => 6)
->pack(-side => 'left');
my $closeButton = $bottomFrame->Button(
-text => "Close",
-underline => 0,
-command => sub {
$addServerWindow->destroy();
$addButton->configure(-state => 'active');
$addMenuItem->configure(-state => 'active');
},
-width => 6)
->pack(-side => 'right');
# Create the bindings for the buttons
$addServerWindow->bind('<Alt-Key-a>' => sub {
&addServer($serverNameEntry, $serverIPEntry);
$serverNameEntry->focus();
});
$addServerWindow->bind('<Alt-Key-r>' => sub {
$serverNameEntry->delete(0, 'end');
$serverIPEntry->delete(0, 'end');
$serverNameEntry->focus();
});
$addServerWindow->bind('<Alt-Key-c>' => sub {
$addServerWindow->destroy();
$addButton->configure(-state => 'active');
$addMenuItem->configure(-state => 'active');
});
}
#---------------------------------------------------
# Pretty self explanatory... clears the list boxes of info then redraw
+s
# them after a short delay (for that "refresh" look)
sub clearServerList {
# I wish i could avoid using $serverCount altogether but as of now,
# with my ability, the deletion requires it
for (0..$serverCount-1) {
$listFrame[$_]->destroy();
}
}
#---------------------------------------------------
# Simply displays the Configuration window
sub configWindow {
$configMenuItem->configure(-state => 'disabled');
my $configWindow = $mainWindow->Toplevel();
$configWindow->title("Server Status Configuration");
$configWindow->focus();
$configWindow->resizable(0,0);
my $x = $mainWindow->rootx();
my $y = $mainWindow->rooty();
my $xCoord = $x + 58;
my $yCoord = $y + 10;
$configWindow->geometry("215x130+$xCoord+$yCoord");
# Temp variables for the colors, if the user hits cancel,
# these will be used to revert back to original colors
my $tempConfigUpColor = $config{color_up};
my $tempConfigDownColor = $config{color_down};
# Make a top and bottom frame, top for the config info,
# bottom for the Close button
my $topFrame = $configWindow->Frame()
->pack(-side => 'top');
my $bottomFrame = $configWindow->Frame(
-relief => 'groove',
-borderwidth => 2)
->pack(-side => 'bottom', -pady => 10, -fill => 'x');
# Make the frames for each option setting
my $configUpFrame = $topFrame->Frame()
->pack(-side => 'top', -fill => 'x');
my $configDownFrame = $topFrame->Frame()
->pack(-side => 'top', -fill => 'x');
my $configRefreshFrame = $topFrame->Frame()
->pack(-side => 'top', -fill => 'x');
# Add the label and optionmenu for the Up color
my $configUpLabel = $configUpFrame->Label(
-text => "Up status color:\t",
-justify => 'left',
-width => 20)
->pack(side => 'left');
my $configUpOptionmenu = $configUpFrame->Optionmenu(
-options => [qw(red blue green yellow black)],
-variable => \$config{color_up})
->pack(-side => 'right');
# Add the label and optionmenu for the Down color
my $configDownLabel = $configDownFrame->Label(
-text => "Down status color:\t",
-justify => 'left',
-width => 20)
->pack(side => 'left');
my $configDownOptionmenu = $configDownFrame->Optionmenu(
-options => [qw(red blue green yellow black)],
-variable => \$config{color_down})
->pack(-side => 'right');
# Add the label and optionmenu for the refresh rate
my $refreshSeconds = $config{refresh} / 1000;
my $configRefreshLabel = $configRefreshFrame->Label(
-text => "Refresh (seconds):\t",
-justify => 'left',
-width => 20)
->pack(side => 'left');
my $configRefreshEntry = $configRefreshFrame->Entry(
-width => 5,
-textvariable => \$refreshSeconds)
->pack(-side => 'right');
# Put the saveButton in the bottomFrame
# Will write the new settings to the config file, close
# the options window, then refresh the server list
my $saveButton = $bottomFrame->Button(
-text => "Save",
-underline => 0,
-command => sub {
&writeConfig($configRefreshEntry);
$configMenuItem->configure(-state => 'active');
$configWindow->destroy();
&updateServerList();
},
-width => 6)
->pack(-side => 'left');
# Put the cancelButton in the bottomFrame
# Will revert the colors back to original, close the
# options window, then refresh the server list
my $cancelButton = $bottomFrame->Button(
-text => "Cancel",
-underline => 0,
-command => sub {
$config{color_up} = $tempConfigUpColor;
$config{color_down} = $tempConfigDownColor;
$configMenuItem->configure(-state => 'active');
$configWindow->destroy();
&updateServerList();
},
-width => 6)
->pack(-side => 'right');
# Same as hitting the saveButton
$configWindow->bind("<Alt-Key-s>" => sub {
&writeConfig($configRefreshEntry);
$configMenuItem->configure(-state => 'active');
$configWindow->destroy();
&updateServerList();
});
# Same as hitting the cancelButton
$configWindow->bind("<Alt-Key-c>" => sub {
$config{color_up} = $tempConfigUpColor;
$config{color_down} = $tempConfigDownColor;
$configMenuItem->configure(-state => 'active');
$configWindow->destroy();
&updateServerList();
});
}
#---------------------------------------------------
# Called at the beginning of the program. If the
# config file doesn't exist, a default will be made
sub createConfig {
$config{color_up} = "green";
$config{color_down} = "red";
$config{refresh} = "60000";
open (CONFIG, ">status.cfg")
|| die "Cannot open file: status.cfg: $!\n";
print CONFIG "<opt>\n";
print CONFIG " <config color_up=\"".$config{color_up}."\" />\n";
print CONFIG " <config color_down=\"".$config{color_down}."\" />\
+n";
print CONFIG " <config refresh=\"".$config{refresh}."\" />\n";
print CONFIG "</opt>\n";
close (CONFIG);
}
#---------------------------------------------------
# An error window in case you hit Delete without selecting a server
sub deleteError {
my $errorText = "\nYou must select a server to delete!\n";
my $errorWindow = $mainWindow->Toplevel();
$errorWindow->title("Error");
$errorWindow->focus();
# Make a top and bottom frame, top for the picture and About info,
# bottom for the Done button
my $topFrame = $errorWindow->Frame()
->pack(-side => 'top');
my $bottomFrame = $errorWindow->Frame()
->pack(-side => 'bottom');
# And now make a frame for the About info inside the topFrame
my $messageLabel = $topFrame->Label(
-text => $errorText,
-justify => 'left')
->pack(-side => 'top');
# Put the doneButton in the bottomFrame
my $closeButton = $bottomFrame->Button(
-text => "Close",
-underline => 0,
-command => sub {
$errorWindow->destroy();
},
-width => 6)
->pack(-side => 'top');
$errorWindow->bind("<Alt-Key-c>" => sub {
$errorWindow->destroy();
});
}
#---------------------------------------------------
# Delete the server(s) selected and update the list
sub deleteServer {
my $deleted = 0;
my $i = 0;
# Ugh, I hate having to do it this way, but whatever
foreach my $serverName (sort(keys %servers)) {
# If the checkbox is selected...
if ($serverDelete[$i]) {
# unselect the checkbox...
$deleteCheckbox[$i]->deselect();
# grab the server name...
my $serverToDelete = $serverList[$i]->get(0);
# delete the server and from the hash...
delete $servers{$serverToDelete};
delete $ports{$serverToDelete};
$deleted++;
}
$i++;
}
if ($deleted == 0) {
&deleteError();
}
&writeServerList();
# and update the server list and number of servers we have
&updateServerList();
$serverCount = $serverCount - $deleted;
}
#---------------------------------------------------
# Fills the list boxes with the server name and status (Up or Down)
sub drawServerList {
# Draw the list boxes for the server and status info, each set in
# their own frame
my $i = 0;
foreach my $server (keys %servers) {
$listFrame[$i] = $mainFrame->Frame()
->pack(-side => 'top');
$serverList[$i] = $listFrame[$i]->Listbox(
-background => 'white',
-height => 1,
-width => 34)
->pack(-side => 'left');
$portList[$i] = $listFrame[$i]->Listbox(
-background => 'white',
-height => 1,
-width => 6)
->pack(-side => 'left');
$statusList[$i] = $listFrame[$i]->Listbox(
-background => 'white',
-height => 1,
-width => '6')
->pack(-side => 'left');
$deleteCheckbox[$i] = $listFrame[$i]->Checkbutton(
-variable => \$serverDelete[$i])
->pack(-side => 'left');
$i++;
}
$i = 0;
foreach my $server (sort(keys %servers)) {
# Put the server name in its list box
$serverList[$i]->insert('end', $server);
$portList[$i]->insert('end', $ports{$server});
# Open a socket connection to the specified port on each ip address
my $s = IO::Socket::INET->new(
PeerHost => $servers{$server},
PeerPort => $ports{$server},
Timeout => 2,
Proto => 'tcp');
if ($s) {
# If the socket is created, color the text the up color and the
# status is "Up"
close ($s);
$statusList[$i]->configure(-foreground => $config{color_up
+});
$statusList[$i]->insert('end', "Up");
} else {
# If the socket is not created, color the text the down color and
# the status is "Down"
$statusList[$i]->configure(-foreground => $config{color_do
+wn});
$statusList[$i]->insert('end', "Down");
}
# Update the main window after each server so the program doesn't
# look like it has stalled
$mainWindow->update;
$i++;
}
}
#---------------------------------------------------
# Reads the config file for color/refresh info
sub readConfig {
my %config;
open (CONFIG, "status.cfg")
|| die "Cannot open file: status.cfg: $!\n";
while (<CONFIG>) {
$config{color_up} = $1 if (/<config color_up="(.*?)"/);
$config{color_down} = $1 if (/<config color_down="(.*?)"/);
$config{refresh} = $1 if (/<config refresh="(.*?)"/);
}
close (CONFIG);
return %config;
}
#---------------------------------------------------
# Just runs the clearServerList and drawServerList subroutines
# (mainly for the $mainWindow->repeat(); before MainLoop; above)
sub updateServerList {
clearServerList();
drawServerList();
}
#---------------------------------------------------
# Simply writes the changed configuration out to
# the configuration file
sub writeConfig {
my ($configRefreshEntry) = @_;
$config{refresh} = $configRefreshEntry->get * 1000;
open (CONFIG, ">status.cfg")
|| die "Cannot open file: status.cfg: $!\n";
print CONFIG "<opt>\n";
print CONFIG " <config color_up=\"".$config{color_up}."\" />\n";
print CONFIG " <config color_down=\"".$config{color_down}."\" />\
+n";
print CONFIG " <config refresh=\"".$config{refresh}."\" />\n";
print CONFIG "</opt>\n";
close (CONFIG);
}
#---------------------------------------------------
# Write the server list to the .serverlist file
# Called when a server is added or deleted
sub writeServerList {
open (SERVERLIST, ">.serverlist")
|| die "Cannot open file: .serverlist: $!\n";
print SERVERLIST "<opt>\n";
foreach my $key (sort(keys %servers)) {
print SERVERLIST " <server address=\"$servers{$key}\" name=\"
+$key\" port=\"$ports{$key}\" />\n";
}
print SERVERLIST "</opt>\n";
close (SERVERLIST);
}
#---------------------------------------------------
# End subroutines
#---------------------------------------------------
|