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";
    }
    ## -- mental note, think about ordering checks for optimal speed ;)
    # take a look to see if we have a shutdown packet...
    if(defined($xmlhash{"packet.attributes.shutdown"}) && $xmlhash{"packet.attributes.shutdown"} eq "true") {
        my($hash) = $xmlhash{"packet.attributes.hashCode"};
        my($cmd) = "rm -f $hash\_*.rrd $hash*.png $hash.def";
        print `$cmd`;
        print "$cmd\n";
        next;
    }
    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.4
Committed:	Mon Oct 22 22:21:33 2001 UTC (23 years ago) by tdb
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.3:	+9 -3 lines
Log Message:	Now keeps an eye out for shutdown packets... not that I've seen one ;) Just looking at the QueueMonitor code suggests it could happen.... so it's taken care of. The ordering of checks is not ideal... that needs to be looked at.
#	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	tdb	1.4	## -- mental note, think about ordering checks for optimal speed ;)
89			# take a look to see if we have a shutdown packet...
90			if(defined($xmlhash{"packet.attributes.shutdown"}) && $xmlhash{"packet.attributes.shutdown"} eq "true") {
91			my($hash) = $xmlhash{"packet.attributes.hashCode"};
92			my($cmd) = "rm -f $hash\_.rrd $hash.png $hash.def";
93			print `$cmd`;
94			print "$cmd\n";
95			next;
96			}
97	tdb	1.1	if($xmlhash{"packet.attributes.type"} eq "queueStat") {
98			my($hash) = $xmlhash{"packet.attributes.hashCode"};
99			my($date) = $xmlhash{"packet.attributes.date"};
100			my($name) = $xmlhash{"packet.attributes.name"};
101			my($total) = $xmlhash{"packet.queue.attributes.total"};
102			my($i) = 0;
103			while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
104			if( ! -f "$hash\_$i.rrd" ) {
105			print "making new database for $hash\_$i\n";
106			&makerrd($hash, $i, $date, $name);
107			}
108			my($size) = $xmlhash{"packet.queue.attributes.queue$i"};
109	tdb	1.2	my($cmd);
110	tdb	1.3	# see if the queue has been removed
111	tdb	1.2	if($size eq "[deleted]") {
112	tdb	1.3	$cmd = "rm -f $hash\_$i.rrd";
113			# are there any other rrd's left? if not, cleanup!
114	tdb	1.2	my($rrdcount) = `ls \| grep $hash\_\\*.rrd \| wc -l`;
115			if($rrdcount == 0) {
116	tdb	1.3	$cmd = $cmd . " && rm -f $hash.def $hash*.png";
117	tdb	1.2	}
118			}
119			else {
120			$cmd = "rrdtool update $hash\_$i.rrd $date:$size:$total";
121			}
122	tdb	1.1	print `$cmd`;
123			print "$cmd\n";
124			++$i;
125			}
126			}
127			else {
128			print "SKIPPED: valid xml, but not a queueStat packet";
129			}
130			}
131
132			exit 0;
133
134			sub makerrd() {
135			my($name, $queuenum, $start, $comment) = @_;
136			$start = $start - 15;
137			my($init) = "rrdtool create $name\_$queuenum.rrd --start $start --step 15";
138			my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U";
139			# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples
140			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";
141			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";
142			my($cmd) = "$init $ds $rra1 $rra2";
143			print `$cmd`;
144			print "$cmd\n";
145			print `echo "$comment" > $name.def`;
146			}