| 1 |
#!/usr/bin/perl -w |
| 2 |
|
| 3 |
$| = 1; |
| 4 |
|
| 5 |
use strict; |
| 6 |
use iscream::XMLParser; |
| 7 |
use IO::Socket; |
| 8 |
use RRDs; |
| 9 |
|
| 10 |
if (@ARGV != 2) { |
| 11 |
die "Usage: ihost.pl [i-scream client interface] [TCP port]\n"; |
| 12 |
} |
| 13 |
|
| 14 |
my($addr) = $ARGV[0]; |
| 15 |
my($cport) = $ARGV[1]; |
| 16 |
|
| 17 |
#print `rm -f *.rrd *.png`; |
| 18 |
|
| 19 |
my($csock) = new IO::Socket::INET( |
| 20 |
PeerAddr => $addr, |
| 21 |
PeerPort => $cport, |
| 22 |
Proto => 'tcp' |
| 23 |
) or die "Cannot connect!"; |
| 24 |
|
| 25 |
if (!defined $csock) { |
| 26 |
print "ERROR: Could not connect to $addr:$cport.\n"; |
| 27 |
print "Please check that there is an i-scream server at this address.\n"; |
| 28 |
exit(1); |
| 29 |
} |
| 30 |
|
| 31 |
my($response); |
| 32 |
|
| 33 |
$response = <$csock>; |
| 34 |
if ($response && $response ne "PROTOCOL 1.1\n") { |
| 35 |
print "The i-scream server sent an unexpected protocol id: $response\n"; |
| 36 |
close($csock); |
| 37 |
exit(1); |
| 38 |
} |
| 39 |
|
| 40 |
print $csock "cpugrapher\n"; |
| 41 |
$response = <$csock>; |
| 42 |
if ($response && $response ne "OK\n") { |
| 43 |
print "Received unexpected response: $response\n"; |
| 44 |
close($csock); |
| 45 |
exit(1); |
| 46 |
} |
| 47 |
|
| 48 |
#print $csock "SETHOSTLIST\n"; |
| 49 |
#$response = <$csock>; |
| 50 |
#if ($response && $response ne "OK\n") { |
| 51 |
# print "Received odd response: $response\n"; |
| 52 |
# close($csock); |
| 53 |
# exit(1); |
| 54 |
#} |
| 55 |
|
| 56 |
#print $csock "myrtle.ukc.ac.uk\n"; |
| 57 |
#$response = <$csock>; |
| 58 |
#if ($response && $response ne "OK\n") { |
| 59 |
# print "Received odd response: $response\n"; |
| 60 |
# close($csock); |
| 61 |
# exit(1); |
| 62 |
#} |
| 63 |
|
| 64 |
print $csock "STARTDATA\n"; |
| 65 |
$response = <$csock>; |
| 66 |
|
| 67 |
chop $response; |
| 68 |
print "Asked to connect to port $response on $addr, connecting...\n"; |
| 69 |
|
| 70 |
my($dport) = $response; |
| 71 |
|
| 72 |
my($dsock) = new IO::Socket::INET( |
| 73 |
PeerAddr => $addr, |
| 74 |
PeerPort => $dport, |
| 75 |
Proto => 'tcp' |
| 76 |
) or die "Cannot connect!"; |
| 77 |
|
| 78 |
if (!defined $dsock) { |
| 79 |
print "ERROR: Could not connect to $addr:$dport.\n"; |
| 80 |
print "Failure in communications.\n"; |
| 81 |
close($csock); |
| 82 |
exit(1); |
| 83 |
} |
| 84 |
|
| 85 |
while(1) { |
| 86 |
$response = <$dsock>; |
| 87 |
#print "$response\n"; |
| 88 |
my($err, %xmlhash) = &iscream::XMLParser::parse($response); |
| 89 |
if($err) { |
| 90 |
print "SKIPPED (bad xml): $response"; |
| 91 |
} |
| 92 |
## -- mental note, think about ordering checks for optimal speed ;) |
| 93 |
# take a look to see if we have a shutdown packet... |
| 94 |
if($xmlhash{"packet.attributes.type"} eq "data") { |
| 95 |
my($machine) = $xmlhash{"packet.attributes.machine_name"}; |
| 96 |
my($date) = $xmlhash{"packet.attributes.date"}; |
| 97 |
# make directory for machine |
| 98 |
if(! -d "$machine") { |
| 99 |
# not sure on this umask, but it seems to work? |
| 100 |
mkdir "$machine", 0777; |
| 101 |
} |
| 102 |
# cpu |
| 103 |
my($cpu_idle) = $xmlhash{"packet.cpu.idle"}; |
| 104 |
my($cpu_user) = $xmlhash{"packet.cpu.user"}; |
| 105 |
my($cpu_kernel) = $xmlhash{"packet.cpu.kernel"}; |
| 106 |
my($cpu_swap) = $xmlhash{"packet.cpu.swap"}; |
| 107 |
my($cpu_iowait) = $xmlhash{"packet.cpu.iowait"}; |
| 108 |
if( ! -f "$machine/cpu.rrd") { |
| 109 |
print "making new rrd for $machine\_cpu\n"; |
| 110 |
&makerrd_cpu($machine, $date); |
| 111 |
} |
| 112 |
#my($cmd) = "rrdtool update $machine\_cpu.rrd $date:$cpu_idle:$cpu_user:$cpu_kernel:$cpu_swap:$cpu_iowait"; |
| 113 |
RRDs::update ("$machine/cpu.rrd", "$date:$cpu_idle:$cpu_user:$cpu_kernel:$cpu_swap:$cpu_iowait"); |
| 114 |
#print "done $machine\n"; |
| 115 |
my($err_cpu) = RRDs::error; |
| 116 |
die "Error_cpu: $err_cpu\n" if $err_cpu; |
| 117 |
#print "$cmd\n"; |
| 118 |
#print `$cmd`; |
| 119 |
# mem |
| 120 |
my($mem_free) = $xmlhash{"packet.memory.free"}; |
| 121 |
my($mem_total) = $xmlhash{"packet.memory.total"}; |
| 122 |
if( ! -f "$machine/mem.rrd") { |
| 123 |
print "making new rrd for $machine\_mem\n"; |
| 124 |
&makerrd_mem($machine, $date); |
| 125 |
} |
| 126 |
RRDs::update ("$machine/mem.rrd", "$date:$mem_free:$mem_total"); |
| 127 |
my($err_mem) = RRDs::error; |
| 128 |
die "Error_mem: $err_mem\n" if $err_mem; |
| 129 |
# load |
| 130 |
my($load_1) = $xmlhash{"packet.load.load1"}; |
| 131 |
my($load_5) = $xmlhash{"packet.load.load5"}; |
| 132 |
my($load_15) = $xmlhash{"packet.load.load15"}; |
| 133 |
if( ! -f "$machine/load.rrd") { |
| 134 |
print "making new rrd for $machine\_load\n"; |
| 135 |
&makerrd_load($machine, $date); |
| 136 |
} |
| 137 |
RRDs::update ("$machine/load.rrd", "$date:$load_1:$load_5:$load_15"); |
| 138 |
my($err_load) = RRDs::error; |
| 139 |
die "Error_load: $err_load\n" if $err_load; |
| 140 |
# processes |
| 141 |
my($proc_cpu) = $xmlhash{"packet.processes.cpu"}; |
| 142 |
my($proc_sleeping) = $xmlhash{"packet.processes.sleeping"}; |
| 143 |
my($proc_stopped) = $xmlhash{"packet.processes.stopped"}; |
| 144 |
my($proc_total) = $xmlhash{"packet.processes.total"}; |
| 145 |
my($proc_zombie) = $xmlhash{"packet.processes.zombie"}; |
| 146 |
if( ! -f "$machine/proc.rrd") { |
| 147 |
print "making new rrd for $machine\_proc\n"; |
| 148 |
&makerrd_proc($machine, $date); |
| 149 |
} |
| 150 |
RRDs::update ("$machine/proc.rrd", "$date:$proc_cpu:$proc_sleeping:$proc_stopped:$proc_total:$proc_zombie"); |
| 151 |
my($err_proc) = RRDs::error; |
| 152 |
die "Error_proc: $err_proc\n" if $err_proc; |
| 153 |
# swap |
| 154 |
my($swap_free) = $xmlhash{"packet.swap.free"}; |
| 155 |
my($swap_total) = $xmlhash{"packet.swap.total"}; |
| 156 |
if( ! -f "$machine/swap.rrd") { |
| 157 |
print "making new rrd for $machine\_swap\n"; |
| 158 |
&makerrd_swap($machine, $date); |
| 159 |
} |
| 160 |
RRDs::update ("$machine/swap.rrd", "$date:$swap_free:$swap_total"); |
| 161 |
my($err_swap) = RRDs::error; |
| 162 |
die "Error_swap: $err_swap\n" if $err_swap; |
| 163 |
# users |
| 164 |
my($users_count) = $xmlhash{"packet.users.count"}; |
| 165 |
if( ! -f "$machine/users.rrd") { |
| 166 |
print "making new rrd for $machine\_users\n"; |
| 167 |
&makerrd_users($machine, $date); |
| 168 |
} |
| 169 |
RRDs::update ("$machine/users.rrd", "$date:$users_count"); |
| 170 |
my($err_users) = RRDs::error; |
| 171 |
die "Error_users: $err_users\n" if $err_users; |
| 172 |
# disk |
| 173 |
# some definitions |
| 174 |
# ch -> hex: $hex = sprintf("%02x", ord($ch)); |
| 175 |
# hex -> ch: $ch = chr(hex($hex)); |
| 176 |
# / converted to a decimal then hex'd |
| 177 |
my($hex_slash) = "_2f"; |
| 178 |
# _ converted to a decimal then hex'd |
| 179 |
my($hex_underscore) = "_5f"; |
| 180 |
my($i) = 0; |
| 181 |
while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) { |
| 182 |
#my($name) = $xmlhash{"packet.disk.p$i.attributes.name"}; |
| 183 |
my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"}; |
| 184 |
#print "$response\n"; |
| 185 |
#print "$i: $machine $name\n"; |
| 186 |
#$mount =~ s/-/--/g; |
| 187 |
my($encmount) = $mount; |
| 188 |
$encmount =~ s/_/$hex_underscore/g; |
| 189 |
$encmount =~ s/\//$hex_slash/g; |
| 190 |
if( ! -f "$machine/disk-$encmount.rrd" ) { |
| 191 |
print "making new database for $machine\_disk-$encmount\n"; |
| 192 |
&makerrd_disk($machine, $date, $encmount); |
| 193 |
} |
| 194 |
#my($avail) = $xmlhash{"packet.disk.p$i.attributes.avail"}; |
| 195 |
my($kbytes) = $xmlhash{"packet.disk.p$i.attributes.kbytes"}; |
| 196 |
my($used) = $xmlhash{"packet.disk.p$i.attributes.used"}; |
| 197 |
#print "$machine\_disk-$name.rrd $date:$kbytes:$used\n"; |
| 198 |
RRDs::update ("$machine/disk-$encmount.rrd", "$date:$kbytes:$used"); |
| 199 |
my($err_disk) = RRDs::error; |
| 200 |
die "Error_disk: $err_disk\n" if $err_disk; |
| 201 |
++$i; |
| 202 |
} |
| 203 |
|
| 204 |
} |
| 205 |
elsif($xmlhash{"packet.attributes.type"} eq "queueStat") { |
| 206 |
# make directory |
| 207 |
if(! -d "i-scream-server") { |
| 208 |
# not sure on this umask, but it seems to work? |
| 209 |
mkdir "i-scream-server", 0777; |
| 210 |
} |
| 211 |
# take a look to see if we have a shutdown packet... |
| 212 |
if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") { |
| 213 |
my($hash) = $xmlhash{"packet.attributes.hashCode"}; |
| 214 |
my($cmd) = "rm -f i-scream-server/$hash\_*.rrd /home/tdb/public_html/rrd/i-scream-server/$hash*.png i-scream-server/$hash.def"; |
| 215 |
print `$cmd`; |
| 216 |
print "$cmd\n"; |
| 217 |
next; |
| 218 |
} |
| 219 |
my($hash) = $xmlhash{"packet.attributes.hashCode"}; |
| 220 |
my($date) = $xmlhash{"packet.attributes.date"}; |
| 221 |
my($name) = $xmlhash{"packet.attributes.name"}; |
| 222 |
my($total) = $xmlhash{"packet.queue.attributes.total"}; |
| 223 |
my($i) = 0; |
| 224 |
while(defined $xmlhash{"packet.queue.attributes.queue$i"}) { |
| 225 |
if( ! -f "i-scream-server/$hash\_$i.rrd" ) { |
| 226 |
print "making new database for $hash\_$i\n"; |
| 227 |
&makerrd_queue($hash, $i, $date, $name); |
| 228 |
} |
| 229 |
my($size) = $xmlhash{"packet.queue.attributes.queue$i"}; |
| 230 |
my($cmd); |
| 231 |
# see if the queue has been removed |
| 232 |
if($size eq "[deleted]") { |
| 233 |
$cmd = "rm -f i-scream-server/$hash\_$i.rrd"; |
| 234 |
# are there any other rrd's left? if not, cleanup! |
| 235 |
my($rrdcount) = `ls i-scream-server | grep $hash\_\\*.rrd | wc -l`; |
| 236 |
if($rrdcount == 0) { |
| 237 |
$cmd = $cmd . " && rm -f i-scream-server/$hash.def /home/tdb/public_html/rrd/i-scream-server/$hash*.png"; |
| 238 |
} |
| 239 |
print `$cmd`; |
| 240 |
} |
| 241 |
else { |
| 242 |
RRDs::update ("i-scream-server/$hash\_$i.rrd", "$date:$size:$total"); |
| 243 |
my($err_disk) = RRDs::error; |
| 244 |
die "Error_disk: $err_disk\n" if $err_disk; |
| 245 |
} |
| 246 |
++$i; |
| 247 |
} |
| 248 |
} |
| 249 |
else { |
| 250 |
#print "SKIPPED: valid xml, but not a data packet\n"; |
| 251 |
} |
| 252 |
} |
| 253 |
|
| 254 |
exit 0; |
| 255 |
|
| 256 |
sub makerrd_cpu() { |
| 257 |
my($machine, $start) = @_; |
| 258 |
$start = $start - 15; |
| 259 |
my($init) = "rrdtool create $machine/cpu.rrd --start $start --step 15"; |
| 260 |
my($ds1) = "DS:idle:GAUGE:600:U:U DS:user:GAUGE:600:U:U"; |
| 261 |
my($ds2) = "DS:kernel:GAUGE:600:U:U DS:swap:GAUGE:600:U:U DS:iowait:GAUGE:600:U:U"; |
| 262 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 263 |
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"; |
| 264 |
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"; |
| 265 |
my($cmd) = "$init $ds1 $ds2 $rra1 $rra2"; |
| 266 |
print `$cmd`; |
| 267 |
print "$cmd\n"; |
| 268 |
print `chmod 600 $machine/cpu.rrd`; |
| 269 |
} |
| 270 |
|
| 271 |
sub makerrd_mem() { |
| 272 |
my($machine, $start) = @_; |
| 273 |
$start = $start - 15; |
| 274 |
my($init) = "rrdtool create $machine/mem.rrd --start $start --step 15"; |
| 275 |
my($ds) = "DS:free:GAUGE:600:U:U DS:total:GAUGE:600:U:U"; |
| 276 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 277 |
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"; |
| 278 |
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"; |
| 279 |
my($cmd) = "$init $ds $rra1 $rra2"; |
| 280 |
print `$cmd`; |
| 281 |
print "$cmd\n"; |
| 282 |
print `chmod 600 $machine/mem.rrd`; |
| 283 |
} |
| 284 |
|
| 285 |
sub makerrd_load() { |
| 286 |
my($machine, $start) = @_; |
| 287 |
$start = $start - 15; |
| 288 |
my($init) = "rrdtool create $machine/load.rrd --start $start --step 15"; |
| 289 |
my($ds) = "DS:load1:GAUGE:600:U:U DS:load5:GAUGE:600:U:U DS:load15:GAUGE:600:U:U"; |
| 290 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 291 |
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"; |
| 292 |
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"; |
| 293 |
my($cmd) = "$init $ds $rra1 $rra2"; |
| 294 |
print `$cmd`; |
| 295 |
print "$cmd\n"; |
| 296 |
print `chmod 600 $machine/load.rrd`; |
| 297 |
} |
| 298 |
|
| 299 |
sub makerrd_proc() { |
| 300 |
my($machine, $start) = @_; |
| 301 |
$start = $start - 15; |
| 302 |
my($init) = "rrdtool create $machine/proc.rrd --start $start --step 15"; |
| 303 |
my($ds1) = "DS:cpu:GAUGE:600:U:U DS:sleeping:GAUGE:600:U:U"; |
| 304 |
my($ds2) = "DS:stopped:GAUGE:600:U:U DS:total:GAUGE:600:U:U DS:zombie:GAUGE:600:U:U"; |
| 305 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 306 |
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"; |
| 307 |
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"; |
| 308 |
my($cmd) = "$init $ds1 $ds2 $rra1 $rra2"; |
| 309 |
print `$cmd`; |
| 310 |
print "$cmd\n"; |
| 311 |
print `chmod 600 $machine/proc.rrd`; |
| 312 |
} |
| 313 |
|
| 314 |
sub makerrd_swap() { |
| 315 |
my($machine, $start) = @_; |
| 316 |
$start = $start - 15; |
| 317 |
my($init) = "rrdtool create $machine/swap.rrd --start $start --step 15"; |
| 318 |
my($ds) = "DS:free:GAUGE:600:U:U DS:total:GAUGE:600:U:U"; |
| 319 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 320 |
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"; |
| 321 |
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"; |
| 322 |
my($cmd) = "$init $ds $rra1 $rra2"; |
| 323 |
print `$cmd`; |
| 324 |
print "$cmd\n"; |
| 325 |
print `chmod 600 $machine/swap.rrd`; |
| 326 |
} |
| 327 |
|
| 328 |
sub makerrd_users() { |
| 329 |
my($machine, $start) = @_; |
| 330 |
$start = $start - 15; |
| 331 |
my($init) = "rrdtool create $machine/users.rrd --start $start --step 15"; |
| 332 |
my($ds) = "DS:count:GAUGE:600:U:U"; |
| 333 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 334 |
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"; |
| 335 |
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"; |
| 336 |
my($cmd) = "$init $ds $rra1 $rra2"; |
| 337 |
print `$cmd`; |
| 338 |
print "$cmd\n"; |
| 339 |
print `chmod 600 $machine/users.rrd`; |
| 340 |
} |
| 341 |
|
| 342 |
sub makerrd_disk() { |
| 343 |
my($machine, $start, $mount) = @_; |
| 344 |
$start = $start - 15; |
| 345 |
my($init) = "rrdtool create $machine/disk-$mount.rrd --start $start --step 15"; |
| 346 |
my($ds) = "DS:kbytes:GAUGE:600:U:U DS:used:GAUGE:600:U:U"; |
| 347 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 348 |
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"; |
| 349 |
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"; |
| 350 |
my($cmd) = "$init $ds $rra1 $rra2"; |
| 351 |
print `$cmd`; |
| 352 |
print "$cmd\n"; |
| 353 |
print `chmod 600 $machine/disk-$mount.rrd`; |
| 354 |
} |
| 355 |
|
| 356 |
sub makerrd_queue() { |
| 357 |
my($name, $queuenum, $start, $comment) = @_; |
| 358 |
$start = $start - 15; |
| 359 |
my($init) = "rrdtool create i-scream-server/$name\_$queuenum.rrd --start $start --step 15"; |
| 360 |
my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U"; |
| 361 |
# 3h in 15s samples 1d in 2m samples 1w in 15m samples 1m in 1hr samples |
| 362 |
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"; |
| 363 |
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"; |
| 364 |
my($cmd) = "$init $ds $rra1 $rra2"; |
| 365 |
print `$cmd`; |
| 366 |
print "$cmd\n"; |
| 367 |
print `echo "$comment" > i-scream-server/$name.def`; |
| 368 |
print `chmod 600 i-scream-server/$name\_$queuenum.rrd i-scream-server/$name.def`; |
| 369 |
} |
