reports/queuegraphing/watch.pl

#!/usr/local/bin/perl -w

$| = 1;

use strict;
use iscream::XMLParser;
use IO::Socket;

if (@ARGV != 2) {
    die "Usage: ihost.pl [i-scream client interface] [TCP port]\n";
}

my($addr) = $ARGV[0];
my($cport) = $ARGV[1];

my($csock) = new IO::Socket::INET(
    PeerAddr => $addr,
    PeerPort => $cport,
    Proto => 'tcp'
    ) or die "Cannot connect!";

if (!defined $csock) {
    print "ERROR: Could not connect to $addr:$cport.\n";
    print "Please check that there is an i-scream server at this address.\n";
    exit(1);
}

my($response);

$response = <$csock>;
if ($response && $response ne "PROTOCOL 1.1\n") {
    print "The i-scream server sent an unexpected protocol id: $response\n";
    close($csock);
    exit(1);
}

print $csock "queuegrapher\n";
$response = <$csock>;
if ($response && $response ne "OK\n") {
    print "Received unexpected response: $response\n";
    close($csock);
    exit(1);
}

print $csock "SETHOSTLIST\n";
$response = <$csock>;
if ($response && $response ne "OK\n") {
    print "Received odd response: $response\n";
    close($csock);
    exit(1);
}

print $csock "_NULL_\n";
$response = <$csock>;
if ($response && $response ne "OK\n") {
    print "Received odd response: $response\n";
    close($csock);
    exit(1);
}

print $csock "STARTDATA\n";
$response = <$csock>;

chop $response;
print "Asked to connect to port $response on $addr, connecting...\n";

my($dport) = $response;

my($dsock) = new IO::Socket::INET(
    PeerAddr => $addr,
    PeerPort => $dport,
    Proto => 'tcp'
    ) or die "Cannot connect!";

if (!defined $dsock) {
    print "ERROR: Could not connect to $addr:$dport.\n";
    print "Failure in communications.\n";
    close($csock);
    exit(1);
}

while(1) {
    $response = <$dsock>;
    my($err, %xmlhash) = &iscream::XMLParser::parse($response);
    if($err) {
        print "SKIPPED (bad xml): $response";
    }
    #foreach my $key (keys %xmlhash) {
    #    print "$key == $xmlhash{$key}\n";
    #}
    if($xmlhash{"packet.attributes.type"} eq "queueStat") {
        my($hash) = $xmlhash{"packet.attributes.hashCode"};
        my($date) = $xmlhash{"packet.attributes.date"};
        my($name) = $xmlhash{"packet.attributes.name"};
        my($total) = $xmlhash{"packet.queue.attributes.total"};
        my($i) = 0;
        while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
            if( ! -f "$hash\_$i.rrd" ) {
                print "making new database for $hash\_$i\n";
                &makerrd($hash, $i, $date, $name);
            }
            my($size) = $xmlhash{"packet.queue.attributes.queue$i"};
            my($cmd);
            # see if the queue has been removed
            if($size eq "[deleted]") {
                $cmd = "rm -f $hash\_$i.rrd";
                # are there any other rrd's left? if not, cleanup!
                my($rrdcount) = `ls | grep $hash\_\\*.rrd | wc -l`;
                if($rrdcount == 0) {
                    $cmd = $cmd . " && rm -f $hash.def $hash*.png";
                }
            }
            else {
                $cmd = "rrdtool update $hash\_$i.rrd $date:$size:$total";
            }
            print `$cmd`;
            print "$cmd\n";
            ++$i;
        }
    }
    else {
        print "SKIPPED: valid xml, but not a queueStat packet";
    }
}

exit 0;

sub makerrd() {
    my($name, $queuenum, $start, $comment) = @_;
    $start = $start - 15;
    my($init) = "rrdtool create $name\_$queuenum.rrd --start $start --step 15";
    my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U";
    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
    my($cmd) = "$init $ds $rra1 $rra2";
    print `$cmd`;
    print "$cmd\n";
    print `echo "$comment" > $name.def`;
}
Revision:	1.3
Committed:	Sun Oct 21 19:01:16 2001 UTC (22 years, 6 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+4 -2 lines
Log Message:	It's only worth cleaning the png files if there are no other rrds left. In the case that there are some left, the graphs may be incorrect for a short while until graph.pl is run, but this seems better than having no graphs at all... which would break the php page.
#	User	Rev	Content
1	tdb	1.1	#!/usr/local/bin/perl -w
2
3			$\| = 1;
4
5			use strict;
6			use iscream::XMLParser;
7			use IO::Socket;
8
9			if (@ARGV != 2) {
10			die "Usage: ihost.pl [i-scream client interface] [TCP port]\n";
11			}
12
13			my($addr) = $ARGV[0];
14			my($cport) = $ARGV[1];
15
16			my($csock) = new IO::Socket::INET(
17			PeerAddr => $addr,
18			PeerPort => $cport,
19			Proto => 'tcp'
20			) or die "Cannot connect!";
21
22			if (!defined $csock) {
23			print "ERROR: Could not connect to $addr:$cport.\n";
24			print "Please check that there is an i-scream server at this address.\n";
25			exit(1);
26			}
27
28			my($response);
29
30			$response = <$csock>;
31			if ($response && $response ne "PROTOCOL 1.1\n") {
32			print "The i-scream server sent an unexpected protocol id: $response\n";
33			close($csock);
34			exit(1);
35			}
36
37			print $csock "queuegrapher\n";
38			$response = <$csock>;
39			if ($response && $response ne "OK\n") {
40			print "Received unexpected response: $response\n";
41			close($csock);
42			exit(1);
43			}
44
45			print $csock "SETHOSTLIST\n";
46			$response = <$csock>;
47			if ($response && $response ne "OK\n") {
48			print "Received odd response: $response\n";
49			close($csock);
50			exit(1);
51			}
52
53			print $csock "_NULL_\n";
54			$response = <$csock>;
55			if ($response && $response ne "OK\n") {
56			print "Received odd response: $response\n";
57			close($csock);
58			exit(1);
59			}
60
61			print $csock "STARTDATA\n";
62			$response = <$csock>;
63
64			chop $response;
65			print "Asked to connect to port $response on $addr, connecting...\n";
66
67			my($dport) = $response;
68
69			my($dsock) = new IO::Socket::INET(
70			PeerAddr => $addr,
71			PeerPort => $dport,
72			Proto => 'tcp'
73			) or die "Cannot connect!";
74
75			if (!defined $dsock) {
76			print "ERROR: Could not connect to $addr:$dport.\n";
77			print "Failure in communications.\n";
78			close($csock);
79			exit(1);
80			}
81
82			while(1) {
83			$response = <$dsock>;
84			my($err, %xmlhash) = &iscream::XMLParser::parse($response);
85			if($err) {
86			print "SKIPPED (bad xml): $response";
87			}
88			#foreach my $key (keys %xmlhash) {
89			# print "$key == $xmlhash{$key}\n";
90			#}
91			if($xmlhash{"packet.attributes.type"} eq "queueStat") {
92			my($hash) = $xmlhash{"packet.attributes.hashCode"};
93			my($date) = $xmlhash{"packet.attributes.date"};
94			my($name) = $xmlhash{"packet.attributes.name"};
95			my($total) = $xmlhash{"packet.queue.attributes.total"};
96			my($i) = 0;
97			while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
98			if( ! -f "$hash\_$i.rrd" ) {
99			print "making new database for $hash\_$i\n";
100			&makerrd($hash, $i, $date, $name);
101			}
102			my($size) = $xmlhash{"packet.queue.attributes.queue$i"};
103	tdb	1.2	my($cmd);
104	tdb	1.3	# see if the queue has been removed
105	tdb	1.2	if($size eq "[deleted]") {
106	tdb	1.3	$cmd = "rm -f $hash\_$i.rrd";
107			# are there any other rrd's left? if not, cleanup!
108	tdb	1.2	my($rrdcount) = `ls \| grep $hash\_\\*.rrd \| wc -l`;
109			if($rrdcount == 0) {
110	tdb	1.3	$cmd = $cmd . " && rm -f $hash.def $hash*.png";
111	tdb	1.2	}
112			}
113			else {
114			$cmd = "rrdtool update $hash\_$i.rrd $date:$size:$total";
115			}
116	tdb	1.1	print `$cmd`;
117			print "$cmd\n";
118			++$i;
119			}
120			}
121			else {
122			print "SKIPPED: valid xml, but not a queueStat packet";
123			}
124			}
125
126			exit 0;
127
128			sub makerrd() {
129			my($name, $queuenum, $start, $comment) = @_;
130			$start = $start - 15;
131			my($init) = "rrdtool create $name\_$queuenum.rrd --start $start --step 15";
132			my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U";
133			# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples
134			my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
135			my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
136			my($cmd) = "$init $ds $rra1 $rra2";
137			print `$cmd`;
138			print "$cmd\n";
139			print `echo "$comment" > $name.def`;
140			}