ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/reports/queuegraphing/watch.pl
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.

File Contents

# Content
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 my($cmd);
104 # see if the queue has been removed
105 if($size eq "[deleted]") {
106 $cmd = "rm -f $hash\_$i.rrd";
107 # are there any other rrd's left? if not, cleanup!
108 my($rrdcount) = `ls | grep $hash\_\\*.rrd | wc -l`;
109 if($rrdcount == 0) {
110 $cmd = $cmd . " && rm -f $hash.def $hash*.png";
111 }
112 }
113 else {
114 $cmd = "rrdtool update $hash\_$i.rrd $date:$size:$total";
115 }
116 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 }