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);
            if($size eq "[deleted]") {
                $cmd = "rm -f $hash\_$i.rrd $hash*.png";
                my($rrdcount) = `ls | grep $hash\_\\*.rrd | wc -l`;
                if($rrdcount == 0) {
                    $cmd = $cmd . " && rm -f $hash.def";
                }
            }
            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.2
Committed:	Sun Oct 21 18:57:40 2001 UTC (23 years ago) by tdb
Content type:	text/plain
Branch:	MAIN
Changes since 1.1:	+11 -24 lines
Log Message:	Now cable to detect when queue's have been deleted. Still need to watch out for a Queue being shutdown though. When a queue is deleted it's rrd is removed, and it's def file cleaned up if there are no other rrds associated with the Queue. All the png images are cleaned up, as they will be remade later on.
#	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			if($size eq "[deleted]") {
105			$cmd = "rm -f $hash\_$i.rrd $hash*.png";
106			my($rrdcount) = `ls \| grep $hash\_\\*.rrd \| wc -l`;
107			if($rrdcount == 0) {
108			$cmd = $cmd . " && rm -f $hash.def";
109			}
110			}
111			else {
112			$cmd = "rrdtool update $hash\_$i.rrd $date:$size:$total";
113			}
114	tdb	1.1	print `$cmd`;
115			print "$cmd\n";
116			++$i;
117			}
118			}
119			else {
120			print "SKIPPED: valid xml, but not a queueStat packet";
121			}
122			}
123
124			exit 0;
125
126			sub makerrd() {
127			my($name, $queuenum, $start, $comment) = @_;
128			$start = $start - 15;
129			my($init) = "rrdtool create $name\_$queuenum.rrd --start $start --step 15";
130			my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U";
131			# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples
132			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";
133			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";
134			my($cmd) = "$init $ds $rra1 $rra2";
135			print `$cmd`;
136			print "$cmd\n";
137			print `echo "$comment" > $name.def`;
138			}