ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/reports/rrdgraphing/watch.pl
Revision: 1.6
Committed: Mon Mar 10 11:34:43 2003 UTC (21 years, 7 months ago) by tdb
Content type: text/plain
Branch: MAIN
Changes since 1.5: +28 -5 lines
Log Message:
Update the graphing stuff to work with the new ihost data.

File Contents

# Content
1 #!/usr/bin/perl -w
2
3 #
4 # i-scream central monitoring system
5 # http://www.i-scream.org.uk
6 # Copyright (C) 2000-2002 i-scream
7 #
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License
10 # as published by the Free Software Foundation; either version 2
11 # of the License, or (at your option) any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21 #
22
23 # -----------------------------------------------------------
24 # i-scream graph generation scripts
25 # http://www.i-scream.org.uk
26 #
27 # Generates rrd databases for i-scream data by connecting to
28 # the i-scream server and collecting data.
29 #
30 # $Author: tdb $
31 # $Id: watch.pl,v 1.5 2002/10/21 13:02:58 tdb Exp $
32 #------------------------------------------------------------
33
34 my($version) = '$Id: watch.pl,v 1.5 2002/10/21 13:02:58 tdb Exp $';
35
36 $| = 1;
37
38 use strict;
39 use Getopt::Std;
40 use IO::Socket;
41 use iscream::XMLParser;
42 use RRDs;
43
44 # define variables that will be read from the config
45 # nb. keep this insync with the config file!
46 use vars qw{
47 $imgdir $rrddir
48 $maxrrdage $maximgage $deleterrds $deleteimgs
49 $hex_slash $hex_underscore
50 $rrdstep $retry_wait
51 $verbose $quiet
52 };
53
54 # default locate of the config file
55 my($configfile) = "rrdgraphing.conf";
56
57 # check for command line arguments
58 my(%opts);
59 my($ret) = getopts('hvqVc:', \%opts);
60
61 # if invalid argument given, $ret will not be 1
62 &usage() if $ret != 1;
63
64 # first process the arguments which might mean we exit now
65
66 # -h is usage
67 if($opts{h}) {
68 &usage();
69 }
70 # -V is version
71 if($opts{V}) {
72 print "watch.pl version: $version\n";
73 exit(1);
74 }
75
76 # Then try getting the config
77
78 # -c specifies the config file location
79 if($opts{c}) {
80 $configfile = $opts{c};
81 }
82 # suck in the config
83 &log("reading config from $configfile\n");
84 do $configfile;
85
86 # Then any options we might want to override the config with
87
88 # -v is verbose
89 if($opts{v}) {
90 $verbose = $opts{v};
91 }
92 # -q is verbose
93 if($opts{q}) {
94 $quiet = $opts{q};
95 # if we're meant to be quiet, we can hardly be verbose!
96 # $verbose = 0;
97 }
98
99 # Finally check for required arguments
100
101 # check we still have two arguments left
102 if (@ARGV != 2) {
103 &usage();
104 }
105
106 # user supplied client interface server and port
107 my($addr) = $ARGV[0];
108 my($cport) = $ARGV[1];
109
110
111 # Main program loop
112 while(1) {
113
114 &log("Connecting control channel to port $cport on $addr...\n");
115
116 # attempt to connect the control channel
117 my($csock) = new IO::Socket::INET(
118 PeerAddr => $addr,
119 PeerPort => $cport,
120 Proto => 'tcp'
121 );
122
123 # if socket isn't defined connection failed
124 if (!defined $csock) {
125 &error("ERROR: Could not connect control channel to $addr:$cport.\n");
126 &error("Please check that there is an i-scream server at this address.\n");
127 &wait_then_retry();
128 next;
129 }
130
131 my($response);
132
133 # client interface should send it's protocol ID
134 # we know about "PROTOCOL 1.1", and will only accept the same
135 $response = <$csock>;
136 &log("CLI sent: $response");
137 if ($response && $response ne "PROTOCOL 1.1\n") {
138 &error("The i-scream server sent an unexpected protocol ID: $response\n");
139 close($csock);
140 &wait_then_retry();
141 next;
142 }
143
144 # send our identifier to the client interface
145 print $csock "rrdgraphing\n";
146 &log("we sent: rrdgraphing\n");
147 $response = <$csock>;
148 &log("CLI sent: $response");
149 if ($response && $response ne "OK\n") {
150 &error("Received unexpected response: $response\n");
151 close($csock);
152 &wait_then_retry();
153 next;
154 }
155
156 # tell the client interface we'd like to start the data channel
157 print $csock "STARTDATA\n";
158 &log("we sent: STARTDATA\n");
159
160 # the response should be the socket to connect the data channel to
161 $response = <$csock>;
162 &log("CLI sent: $response");
163 chomp $response;
164
165 my($dport) = $response;
166 &log("Connecting data channel to port $dport on $addr...\n");
167
168 # attempt to connect the data channel
169 my($dsock) = new IO::Socket::INET(
170 PeerAddr => $addr,
171 PeerPort => $dport,
172 Proto => 'tcp'
173 ) or die "arse?";
174
175 # if socket isn't defined connection failed
176 if (!defined $dsock) {
177 &error("ERROR: Could not connect data channel to $addr:$dport.\n");
178 &error("Failure in communications.\n");
179 close($csock);
180 &wait_then_retry();
181 next;
182 }
183
184 # the data channel should now be sending us data!
185
186 # call sub to process data being received over the data channel
187 &processdata($dsock);
188
189 # data processing has stopped, close sockets
190 close($csock);
191 close($dsock);
192
193 # wait before retrying
194 &wait_then_retry();
195 }
196
197 # we'll never reach here... unless 1 becomes false for some reason ;)
198 exit 0;
199
200
201 #
202 # wait for a while before retrying
203 #
204 sub wait_then_retry() {
205 &error("Will retry connection to i-scream server in $retry_wait seconds.\n\n");
206 sleep $retry_wait;
207 }
208
209 #
210 # Given the socket of the data channel will process all
211 # the incoming XML data, creating and updating the appropriate
212 # database files.
213 #
214 # $dsock = socket connected to the data channel
215 #
216 sub processdata() {
217 # the socket connected to the data channel
218 my($dsock) = @_;
219 # save us recreating this variable each time we loop
220 my($xml);
221
222 while(1) {
223 # read data
224 $xml = <$dsock>;
225
226 # something odd has happened
227 last if not defined $xml;
228
229 # attempt to parse the data
230 my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
231 if($err) {
232 &error("Skipped, XML did not parse: $xml");
233 next;
234 }
235
236 # standard data packet
237 if($xmlhash{"packet.attributes.type"} eq "data") {
238 my($machine) = $xmlhash{"packet.attributes.machine_name"};
239 my($date) = $xmlhash{"packet.attributes.date"};
240
241 # make directory for machine
242 if(! -d "$rrddir/$machine") {
243 # not sure on this umask, but it seems to work?
244 mkdir "$rrddir/$machine", 0777;
245 &log("created directory $rrddir/$machine\n");
246 }
247
248 my(@data);
249
250 # cpu
251 @data = ( "packet.cpu.idle:idle:GAUGE",
252 "packet.cpu.user:user:GAUGE",
253 "packet.cpu.kernel:kernel:GAUGE",
254 "packet.cpu.swap:swap:GAUGE",
255 "packet.cpu.iowait:iowait:GAUGE",
256 );
257 &updaterrd($machine, "cpu", $date, $rrdstep, \%xmlhash, @data);
258
259 # mem
260 @data = ( "packet.memory.free:free:GAUGE",
261 "packet.memory.total:total:GAUGE",
262 );
263 &updaterrd($machine, "mem", $date, $rrdstep, \%xmlhash, @data);
264
265 # load
266 @data = ( "packet.load.load1:load1:GAUGE",
267 "packet.load.load5:load5:GAUGE",
268 "packet.load.load15:load15:GAUGE",
269 );
270 &updaterrd($machine, "load", $date, $rrdstep, \%xmlhash, @data);
271
272 # processes
273 @data = ( "packet.processes.cpu:cpu:GAUGE",
274 "packet.processes.sleeping:sleeping:GAUGE",
275 "packet.processes.stopped:stopped:GAUGE",
276 "packet.processes.total:total:GAUGE",
277 "packet.processes.zombie:zombie:GAUGE",
278 );
279 &updaterrd($machine, "proc", $date, $rrdstep, \%xmlhash, @data);
280
281 # swap
282 @data = ( "packet.swap.free:free:GAUGE",
283 "packet.swap.total:total:GAUGE",
284 );
285 &updaterrd($machine, "swap", $date, $rrdstep, \%xmlhash, @data);
286
287 # users
288 @data = ( "packet.users.count:count:GAUGE",
289 );
290 &updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
291
292 # paging
293 @data = ( "packet.pages.pageins:pageins:GAUGE",
294 "packet.pages.pageouts:pageouts:GAUGE",
295 );
296 &updaterrd($machine, "paging", $date, $rrdstep, \%xmlhash, @data);
297
298 # disk
299 my($i) = 0;
300 while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
301 my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
302 $mount =~ s/_/$hex_underscore/g;
303 $mount =~ s/\//$hex_slash/g;
304 @data = ( "packet.disk.p$i.attributes.total:total:GAUGE",
305 "packet.disk.p$i.attributes.used:used:GAUGE",
306 "packet.disk.p$i.attributes.totalinodes:totalinodes:GAUGE",
307 "packet.disk.p$i.attributes.freeinodes:freeinodes:GAUGE",
308 );
309 &updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
310 ++$i;
311 }
312
313 # diskio
314 $i = 0;
315 while(defined $xmlhash{"packet.diskio.p$i.attributes.name"}) {
316 my($name) = $xmlhash{"packet.diskio.p$i.attributes.name"};
317 @data = ( "packet.diskio.p$i.attributes.rbytes:rbytes:GAUGE",
318 "packet.diskio.p$i.attributes.wbytes:wbytes:GAUGE",
319 );
320 &updaterrd($machine, "diskio-$name", $date, $rrdstep, \%xmlhash, @data);
321 ++$i
322 }
323
324 # net
325 $i = 0;
326 while(defined $xmlhash{"packet.net.p$i.attributes.name"}) {
327 my($name) = $xmlhash{"packet.net.p$i.attributes.name"};
328 @data = ( "packet.net.p$i.attributes.rx:rx:GAUGE",
329 "packet.net.p$i.attributes.tx:tx:GAUGE",
330 );
331 &updaterrd($machine, "net-$name", $date, $rrdstep, \%xmlhash,
332 @data);
333 ++$i
334 }
335 }
336
337 # queue statistics packet
338 elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
339 # psuedo machine for internal server stuff
340 my($machine) = "i-scream-server";
341 # make directory
342 if(! -d "$rrddir/$machine") {
343 # not sure on this umask, but it seems to work?
344 mkdir "$rrddir/$machine", 0777;
345 &log("created directory $rrddir/$machine\n");
346 }
347 my($hash) = $xmlhash{"packet.attributes.hashCode"};
348 my($date) = $xmlhash{"packet.attributes.date"};
349 my($name) = $xmlhash{"packet.attributes.name"};
350 # take a look to see if we have a shutdown packet...
351 if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
352 unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
353 &log("deleted $rrddir/$machine/$hash\_*.rrd $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
354 next;
355 }
356 # look through to see how many internal queues we have
357 my($i) = 0;
358 while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
359 # see if the queue has been removed
360 if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
361 # delete the queues rrd
362 unlink "$rrddir/$machine/$hash\_$i.rrd";
363 &log("deleted $rrddir/$machine/$hash\_$i.rrd\n");
364 # are there any other rrd's left on this queue? if not, cleanup.
365 # get a list of any that may be still there..
366 opendir(DIR, "$rrddir/$machine");
367 my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
368 closedir DIR;
369 # count them (+1 because an empty array is size -1)
370 my($rrdcount) = $#rrdcountfiles + 1;
371 if($rrdcount == 0) {
372 # clean up the def file and any images
373 unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
374 &log("deleted $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
375 }
376 ++$i;
377 next;
378 }
379 # the &updaterrd will also do this check, but we want
380 # to write our def file out first
381 if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
382 open(DEF, ">$rrddir/$machine/$hash.def");
383 print DEF $name;
384 close DEF;
385 &log("created $rrddir/$machine/$hash.def\n");
386 }
387 my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
388 "packet.queue.attributes.total:total:COUNTER",
389 );
390 &updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
391 ++$i;
392 }
393 }
394 else {
395 #&error("SKIPPED: valid xml, but not a data or statistics packet\n");
396 }
397 }
398
399 # we'll now return from this sub and reconnect
400 &error("Data channel socket gave no data, bailing out...\n");
401 }
402
403 #
404 # sub to update an rrd file
405 #
406 # $machine = name of the machine
407 # (eg. kernow.ukc.ac.uk)
408 # $type = the type of graph for the machine
409 # (eg. cpu)
410 # $date = the date of the item we want to add
411 # (in seconds since the epoch)
412 # $step = the interval at which the database steps
413 # used when we create a new rrd
414 # $xmlref = reference to the xml data packet
415 # @data = array containing data items to add
416 # (eg. "packet.cpu.user:user:GAUGE")
417 #
418 sub updaterrd() {
419 my($machine, $type, $date, $step, $xmlref, @data) = @_;
420 # get hold of the xmlhash we have a reference to
421 my(%xmlhash) = %$xmlref;
422 # check if we need to create a new rrd
423 if( ! -f "$rrddir/$machine/$type.rrd") {
424 my(@createdata);
425 # pull the details out of the data we've been given
426 foreach my $dataitem (@data) {
427 if($dataitem =~ /^\S+:(\S+):(\S+)$/) {
428 push @createdata, "$1:$2";
429 }
430 }
431 # call the &makerrd to actually create the rrd
432 &log("making new rrd for $rrddir/$machine/$type.rrd\n");
433 &makerrd($machine, $type, $date, $step, @createdata);
434 }
435 # get the details out of the data we've been given
436 my($updateparams) = "$date";
437 foreach my $dataitem (@data) {
438 if($dataitem =~ /^(\S+):\S+:\S+$/) {
439 # pull the values straight out of the xmlhash
440 my($value) = $xmlhash{$1};
441 # if it's undefined we'll set it to 0
442 # this probably shouldn't happen, but it'd be best to handle it "nicely" :)
443 $value = "0" if not defined $value;
444 $updateparams .= ":$value";
445 }
446 }
447 # perform the update
448 RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
449 &log("updating $rrddir/$machine/$type.rrd\n");
450 my($err) = RRDs::error;
451 &error("Error updating $rrddir/$machine/$type.rrd: $err\n") if $err;
452 }
453
454 #
455 # sub to create a new rrd file
456 #
457 # $machine = name of the machine
458 # (eg. kernow.ukc.ac.uk)
459 # $type = the type of graph for the machine
460 # (eg. cpu)
461 # $start = the date of the first item we want to add
462 # (in seconds since the epoch)
463 # $step = the interval at which the database steps
464 # @data = the data items we want to put in the rrd
465 # in the form: $dsname:dstype
466 # (eg. "size:GAUGE")
467 #
468 sub makerrd() {
469 my($machine, $type, $start, $step, @data) = @_;
470 # check if directory exists for rrd
471 if(! -d "$rrddir/$machine") {
472 # not sure on this umask, but it seems to work?
473 mkdir "$rrddir/$machine", 0777;
474 &log("created directory $rrddir/$machine\n");
475 }
476 my(@rrdcmd);
477 # we'll want to add our first data item at $start,
478 # so we start our rrd $step before that.
479 $start -= $step;
480 push @rrdcmd, "$rrddir/$machine/$type.rrd";
481 push @rrdcmd, "--start=$start";
482 push @rrdcmd, "--step=$step";
483 foreach my $dataitem (@data) {
484 # dataitem should be: "dsname:dstype"
485 if($dataitem =~ /^(\S+):(\S+)$/) {
486 push @rrdcmd, "DS:$1:$2:600:U:U";
487 }
488 }
489 push @rrdcmd, (
490 # 3h in 15s samples
491 "RRA:AVERAGE:0.5:1:720",
492 "RRA:MAX:0.5:1:720",
493 # 1d in 2m samples
494 "RRA:AVERAGE:0.5:8:720",
495 "RRA:MAX:0.5:8:720",
496 # 1w in 15m samples
497 "RRA:AVERAGE:0.5:60:672",
498 "RRA:MAX:0.5:60:672",
499 # 1m in 1hr samples
500 "RRA:AVERAGE:0.5:240:744",
501 "RRA:MAX:0.5:240:744",
502 # 1y in 12hr samples
503 "RRA:AVERAGE:0.5:2880:730",
504 "RRA:MAX:0.5:2880:730",
505 );
506 RRDs::create (@rrdcmd);
507 my($err) = RRDs::error;
508 &error("Error creating rrd for $rrddir/$machine/$type: $err\n") if $err;
509 }
510
511 # prints out usage information then exits
512 sub usage() {
513 print "Usage: watch.pl [options] i-scream_client_interface port\n";
514 print "Options\n";
515 print " -c config Specifies the configuration file\n";
516 print " default: rrdgraphing.conf\n";
517 print " -v Be verbose about what's happening\n";
518 print " -q Be quiet, even supress errors\n";
519 print " -V Print version number\n";
520 print " -h Prints this help page\n";
521 exit(1);
522 }
523
524 # prints a log message if verbose is turned on
525 sub log() {
526 my($msg) = @_;
527 print $msg if $verbose;
528 }
529
530 # prints an error message unless quiet is turned on
531 sub error() {
532 my($msg) = @_;
533 print STDERR $msg unless $quiet;
534 }