eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}' if 0;
use strict;
use IO::Socket::INET;
use Tk;
use Tk::Dialog;
my $mw = MainWindow->new;
my $top = $mw->Frame();
my $middle = $mw->Frame();
my $bottom = $mw->Frame();
$top->pack();
my $text = $middle->Scrolled('Text', -width => 50, -scrollbars => 'ow')->pack;
$middle->pack();
my $b1 = $bottom->Button(-text => 'About', -command => \&about)->pack(-side => 'left');
my $b2 = $bottom->Button(-text => 'Quit', -command => \&exit)->pack(-side => 'left');
$bottom->pack();
my @machines;
if(@ARGV) {
my $offset = 0;
foreach(@ARGV) {
$machines[$offset++] = $top->Button(-text => $_, -command => [ \&drill, $_ ])->pack(-side => 'left');
}
&pinger;
$mw->repeat(60000, \&pinger);
}
my $history = "";
my $sock = IO::Socket::INET->new(
LocalPort => 3310,
Proto => 'udp',
Type => SOCK_DGRAM) or die "$0: socket: $!\n";
$sock->shutdown(SHUT_WR);
$mw->fileevent($sock, 'readable', [ \&packet_ready, $sock ]);
MainLoop;
sub packet_ready {
my $sock = shift;
my $mess;
$sock->recv($mess, 128);
my $peeraddr = $sock->peerhost;
$text->insert('end', "From $peeraddr: $mess\n");
}
sub pinger {
foreach(@machines) {
my $machine = $_->cget('-text');
my $sock = IO::Socket::INET->new(
PeerPort => 3310,
PeerAddr => $machine,
Proto => 'tcp',
Timeout => 5,
Type => SOCK_STREAM);
if($sock) {
$mw->fileevent($sock, 'readable', [ \&pinger_ready, $_, $sock ]);
print $sock "PING\n";
$sock->shutdown(SHUT_WR);
$mw->update;
} else {
my $background = $_->cget('-background');
if($background ne 'red') {
$_->configure(-background => 'red');
}
}
}
}
sub pinger_ready {
my $machine = shift;
my $sock = shift;
my $mess;
$sock->recv($mess, 6);
my $peeraddr = $sock->peerhost;
close $sock;
my $background = $machine->cget('-background');
if($mess && ($mess ne "PONG\n")) {
if($background ne 'red') {
$machine->configure(-background => 'red');
}
} else {
if($background ne 'green') {
$machine->configure(-background => 'green');
}
}
}
sub about {
my $about = $mw->DialogBox(
-title=>"About clamAVmon",
-buttons=>["OK"]
);
$about->add('Label',
-anchor => 'w',
-justify => 'left',
-text => "clamAVmon\n" .
"Copyright (C) 2004 Nigel Horne njh\@bandsman.co.uk\n" .
"The GPL Licence will appear here")->pack;
$about->Show();
}
sub drill {
my $machine = shift;
my $sock = IO::Socket::INET->new(
PeerPort => 3310,
PeerAddr => $machine,
Proto => 'tcp',
Timeout => 5,
Type => SOCK_STREAM) or die "$0: socket: $!\n";
print $sock "VERSION\n";
my $mess = <$sock>;
close $sock;
print $mess;
my $state = $mw->DialogBox(
-title => $machine,
-buttons => ["OK"]
);
$state->add('Label',
-anchor => 'w',
-justify => 'left',
-text => $mess)->pack;
$state->Show();
}