| 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 | } |