ViewVC Help

View File | Revision Log | Show Annotations | Revision Graph | Root Listing

root/i-scream/projects/cms/source/reports/rrdgraphing/watch.pl

Comparing projects/cms/source/reports/rrdgraphing/watch.pl (file contents):
Revision 1.2 by tdb, Sat May 18 18:15:59 2002 UTC vs.
Revision 1.8 by tdb, Sun Aug 1 10:40:32 2004 UTC

#	Line 2 | Line 2
2
3		#
4		# i-scream central monitoring system
5	+	# http://www.i-scream.org
6		# Copyright (C) 2000-2002 i-scream
7		#
8		# This program is free software; you can redistribute it and/or
#	Line 21 | Line 22
22
23		# -----------------------------------------------------------
24		# i-scream graph generation scripts
25	<	# http://www.i-scream.org.uk
25	>	# http://www.i-scream.org
26		#
27		# Generates rrd databases for i-scream data by connecting to
28		# the i-scream server and collecting data.
#	Line 30 | Line 31
31		# $Id$
32		#------------------------------------------------------------
33
34	<	## TODO
35	<	# ought to think about cleaning up when we restart?
36	<	#  -- old queue data etc
34	>	BEGIN {
35	>	push (@INC, "/usr/local/packages/rrdtool/lib/perl5/site_perl/5.8.2/sun4-solaris");
36	>	}
37
38	+	my($version) = '$Id$';
39	+
40		$| = 1;
41
42		use strict;
43	<	use iscream::XMLParser;
43	>	use Getopt::Std;
44		use IO::Socket;
45	+	use iscream::XMLParser;
46		use RRDs;
47
48	<	# Base directory for images
49	<	# (a directory will be constructed for each host under this)
50	<	my($imgdir) = "/home/pkg/iscream/public_html/graphs";
48	>	# define variables that will be read from the config
49	>	# nb. keep this insync with the config file!
50	>	use vars qw{
51	>	$imgdir $rrddir
52	>	$maxrrdage $maximgage $deleterrds $deleteimgs
53	>	$hex_slash $hex_underscore
54	>	$rrdstep $retry_wait
55	>	$verbose $quiet
56	>	};
57
58	<	# Location of RRD databases
59	<	my($rrddir) = "/u1/i-scream/databases";
58	>	# default locate of the config file
59	>	my($configfile) = "rrdgraphing.conf";
60
61	<	# for reference:
62	<	# ch -> hex: $hex = sprintf("%02x", ord($ch));
63	<	# hex -> ch: $ch = chr(hex($hex));
61	>	# check for command line arguments
62	>	my(%opts);
63	>	my($ret) = getopts('hvqVc:', \%opts);
64
65	<	# / converted to a decimal then hex'd
66	<	my($hex_slash) = "_2f";
57	<	# _ converted to a decimal then hex'd
58	<	my($hex_underscore) = "_5f";
65	>	# if invalid argument given, $ret will not be 1
66	>	&usage() if $ret != 1;
67
68	<	# step interval in the rrd databases
61	<	my($rrdstep) = 15;
68	>	# first process the arguments which might mean we exit now
69
70	<	# time to wait (in seconds) before retrying a connection
71	<	my($retry_wait) = 10;
70	>	# -h is usage
71	>	if($opts{h}) {
72	>	&usage();
73	>	}
74	>	# -V is version
75	>	if($opts{V}) {
76	>	print "watch.pl version: $version\n";
77	>	exit(1);
78	>	}
79
80	+	# Then try getting the config
81	+
82	+	# -c specifies the config file location
83	+	if($opts{c}) {
84	+	$configfile = $opts{c};
85	+	}
86	+	# suck in the config
87	+	&log("reading config from $configfile\n");
88	+	do $configfile;
89	+
90	+	# Then any options we might want to override the config with
91	+
92	+	# -v is verbose
93	+	if($opts{v}) {
94	+	$verbose = $opts{v};
95	+	}
96	+	# -q is verbose
97	+	if($opts{q}) {
98	+	$quiet = $opts{q};
99	+	# if we're meant to be quiet, we can hardly be verbose!
100	+	#    $verbose = 0;
101	+	}
102	+
103	+	# Finally check for required arguments
104	+
105	+	# check we still have two arguments left
106		if (@ARGV != 2) {
107	<	die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
107	>	&usage();
108		}
109
110		# user supplied client interface server and port
111		my($addr) = $ARGV[0];
112		my($cport) = $ARGV[1];
113
114	+
115	+	# Main program loop
116		while(1) {
117
118	<	print "Connecting control channel to port $cport on $addr...\n";
118	>	&log("Connecting control channel to port $cport on $addr...\n");
119
120		# attempt to connect the control channel
121		my($csock) = new IO::Socket::INET(
#	Line 84 | Line 126 | while(1) {
126
127		# if socket isn't defined connection failed
128		if (!defined $csock) {
129	<	print STDERR "ERROR: Could not connect control channel to $addr:$cport.\n";
130	<	print STDERR "Please check that there is an i-scream server at this address.\n";
129	>	&error("ERROR: Could not connect control channel to $addr:$cport.\n");
130	>	&error("Please check that there is an i-scream server at this address.\n");
131		&wait_then_retry();
132		next;
133		}
#	Line 95 | Line 137 | while(1) {
137		# client interface should send it's protocol ID
138		# we know about "PROTOCOL 1.1", and will only accept the same
139		$response = <$csock>;
140	+	&log("CLI sent: $response");
141		if ($response && $response ne "PROTOCOL 1.1\n") {
142	<	print STDERR "The i-scream server sent an unexpected protocol ID: $response\n";
142	>	&error("The i-scream server sent an unexpected protocol ID: $response\n");
143		close($csock);
144		&wait_then_retry();
145		next;
#	Line 104 | Line 147 | while(1) {
147
148		# send our identifier to the client interface
149		print $csock "rrdgraphing\n";
150	+	&log("we sent: rrdgraphing\n");
151		$response = <$csock>;
152	+	&log("CLI sent: $response");
153		if ($response && $response ne "OK\n") {
154	<	print STDERR "Received unexpected response: $response\n";
154	>	&error("Received unexpected response: $response\n");
155		close($csock);
156		&wait_then_retry();
157		next;
#	Line 114 | Line 159 | while(1) {
159
160		# tell the client interface we'd like to start the data channel
161		print $csock "STARTDATA\n";
162	<
162	>	&log("we sent: STARTDATA\n");
163	>
164		# the response should be the socket to connect the data channel to
165		$response = <$csock>;
166	+	&log("CLI sent: $response");
167		chomp $response;
168
169		my($dport) = $response;
170	<	print "Connecting data channel to port $dport on $addr...\n";
170	>	&log("Connecting data channel to port $dport on $addr...\n");
171
172		# attempt to connect the data channel
173		my($dsock) = new IO::Socket::INET(
#	Line 131 | Line 178 | while(1) {
178
179		# if socket isn't defined connection failed
180		if (!defined $dsock) {
181	<	print STDERR "ERROR: Could not connect data channel to $addr:$dport.\n";
182	<	print STDERR "Failure in communications.\n";
181	>	&error("ERROR: Could not connect data channel to $addr:$dport.\n");
182	>	&error("Failure in communications.\n");
183		close($csock);
184		&wait_then_retry();
185		next;
#	Line 159 | Line 206 | exit 0;
206		# wait for a while before retrying
207		#
208		sub wait_then_retry() {
209	<	print STDERR "Will retry connection to i-scream server in $retry_wait seconds.\n\n";
209	>	&error("Will retry connection to i-scream server in $retry_wait seconds.\n\n");
210		sleep $retry_wait;
211		}
212
#	Line 186 | Line 233 | sub processdata() {
233		# attempt to parse the data
234		my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
235		if($err) {
236	<	print STDERR "Skipped, XML did not parse: $xml";
236	>	&error("Skipped, XML did not parse: $xml");
237		next;
238		}
239
#	Line 199 | Line 246 | sub processdata() {
246		if(! -d "$rrddir/$machine") {
247		# not sure on this umask, but it seems to work?
248		mkdir "$rrddir/$machine", 0777;
249	+	&log("created directory $rrddir/$machine\n");
250		}
251
252		my(@data);
#	Line 215 | Line 263 | sub processdata() {
263		# mem
264		@data = ( "packet.memory.free:free:GAUGE",
265		"packet.memory.total:total:GAUGE",
266	+	"packet.memory.cache:cache:GAUGE",
267		);
268		&updaterrd($machine, "mem", $date, $rrdstep, \%xmlhash, @data);
269
#	Line 244 | Line 293 | sub processdata() {
293		@data = ( "packet.users.count:count:GAUGE",
294		);
295		&updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
296	<
296	>
297	>	# paging
298	>	@data = ( "packet.pages.pageins:pageins:GAUGE",
299	>	"packet.pages.pageouts:pageouts:GAUGE",
300	>	);
301	>	&updaterrd($machine, "paging", $date, $rrdstep, \%xmlhash, @data);
302	>
303		# disk
304		my($i) = 0;
305		while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
306		my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
307		$mount =~ s/_/$hex_underscore/g;
308		$mount =~ s/\//$hex_slash/g;
309	<	@data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
309	>	@data = ( "packet.disk.p$i.attributes.total:total:GAUGE",
310		"packet.disk.p$i.attributes.used:used:GAUGE",
311	+	"packet.disk.p$i.attributes.totalinodes:totalinodes:GAUGE",
312	+	"packet.disk.p$i.attributes.freeinodes:freeinodes:GAUGE",
313		);
314		&updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
315		++$i;
316		}
317	+
318	+	# diskio
319	+	$i = 0;
320	+	while(defined $xmlhash{"packet.diskio.p$i.attributes.name"}) {
321	+	my($name) = $xmlhash{"packet.diskio.p$i.attributes.name"};
322	+	@data = ( "packet.diskio.p$i.attributes.rbytes:rbytes:GAUGE",
323	+	"packet.diskio.p$i.attributes.wbytes:wbytes:GAUGE",
324	+	);
325	+	&updaterrd($machine, "diskio-$name", $date, $rrdstep, \%xmlhash, @data);
326	+	++$i
327	+	}
328	+
329	+	# net
330	+	$i = 0;
331	+	while(defined $xmlhash{"packet.net.p$i.attributes.name"}) {
332	+	my($name) = $xmlhash{"packet.net.p$i.attributes.name"};
333	+	@data = ( "packet.net.p$i.attributes.rx:rx:GAUGE",
334	+	"packet.net.p$i.attributes.tx:tx:GAUGE",
335	+	);
336	+	&updaterrd($machine, "net-$name", $date, $rrdstep, \%xmlhash, @data);
337	+	++$i
338	+	}
339	+
340	+	# mailq
341	+	$i = 0;
342	+	while(defined $xmlhash{"packet.mailq.p$i.attributes.name"}) {
343	+	my($name) = $xmlhash{"packet.mailq.p$i.attributes.name"};
344	+	$name =~ s/\s+//g;
345	+	@data = ( "packet.mailq.p$i.attributes.size:size:GAUGE",
346	+	);
347	+	&updaterrd($machine, "mailq-$name", $date, $rrdstep, \%xmlhash, @data);
348	+	++$i
349	+	}
350		}
351
352		# queue statistics packet
#	Line 267 | Line 357 | sub processdata() {
357		if(! -d "$rrddir/$machine") {
358		# not sure on this umask, but it seems to work?
359		mkdir "$rrddir/$machine", 0777;
360	+	&log("created directory $rrddir/$machine\n");
361		}
362		my($hash) = $xmlhash{"packet.attributes.hashCode"};
363		my($date) = $xmlhash{"packet.attributes.date"};
#	Line 274 | Line 365 | sub processdata() {
365		# take a look to see if we have a shutdown packet...
366		if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
367		unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
368	+	&log("deleted $rrddir/$machine/$hash\_*.rrd $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
369		next;
370		}
371		# look through to see how many internal queues we have
#	Line 283 | Line 375 | sub processdata() {
375		if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
376		# delete the queues rrd
377		unlink "$rrddir/$machine/$hash\_$i.rrd";
378	+	&log("deleted $rrddir/$machine/$hash\_$i.rrd\n");
379		# are there any other rrd's left on this queue? if not, cleanup.
380		# get a list of any that may be still there..
381		opendir(DIR, "$rrddir/$machine");
#	Line 293 | Line 386 | sub processdata() {
386		if($rrdcount == 0) {
387		# clean up the def file and any images
388		unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
389	+	&log("deleted $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
390		}
391		++$i;
392		next;
#	Line 303 | Line 397 | sub processdata() {
397		open(DEF, ">$rrddir/$machine/$hash.def");
398		print DEF $name;
399		close DEF;
400	+	&log("created $rrddir/$machine/$hash.def\n");
401		}
402		my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
403		"packet.queue.attributes.total:total:COUNTER",
#	Line 312 | Line 407 | sub processdata() {
407		}
408		}
409		else {
410	<	#print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
410	>	#&error("SKIPPED: valid xml, but not a data or statistics packet\n");
411		}
412		}
413
414		# we'll now return from this sub and reconnect
415	<	print STDERR "Data channel socket gave no data, bailing out...\n";
415	>	&error("Data channel socket gave no data, bailing out...\n");
416		}
417
418		#
#	Line 349 | Line 444 | sub updaterrd() {
444		}
445		}
446		# call the &makerrd to actually create the rrd
447	<	print "making new rrd for $rrddir/$machine/$type.rrd\n";
447	>	&log("making new rrd for $rrddir/$machine/$type.rrd\n");
448		&makerrd($machine, $type, $date, $step, @createdata);
449		}
450		# get the details out of the data we've been given
#	Line 366 | Line 461 | sub updaterrd() {
461		}
462		# perform the update
463		RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
464	+	&log("updating $rrddir/$machine/$type.rrd\n");
465		my($err) = RRDs::error;
466	<	print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
466	>	&error("Error updating $rrddir/$machine/$type.rrd: $err\n") if $err;
467		}
468
469		#
#	Line 390 | Line 486 | sub makerrd() {
486		if(! -d "$rrddir/$machine") {
487		# not sure on this umask, but it seems to work?
488		mkdir "$rrddir/$machine", 0777;
489	+	&log("created directory $rrddir/$machine\n");
490		}
491		my(@rrdcmd);
492		# we'll want to add our first data item at $start,
#	Line 423 | Line 520 | sub makerrd() {
520		);
521		RRDs::create (@rrdcmd);
522		my($err) = RRDs::error;
523	<	print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
523	>	&error("Error creating rrd for $rrddir/$machine/$type: $err\n") if $err;
524	>	}
525	>
526	>	# prints out usage information then exits
527	>	sub usage() {
528	>	print "Usage: watch.pl [options] i-scream_client_interface port\n";
529	>	print "Options\n";
530	>	print "  -c config        Specifies the configuration file\n";
531	>	print "                    default: rrdgraphing.conf\n";
532	>	print "  -v               Be verbose about what's happening\n";
533	>	print "  -q               Be quiet, even supress errors\n";
534	>	print "  -V               Print version number\n";
535	>	print "  -h               Prints this help page\n";
536	>	exit(1);
537	>	}
538	>
539	>	# prints a log message if verbose is turned on
540	>	sub log() {
541	>	my($msg) = @_;
542	>	print $msg if $verbose;
543	>	}
544	>
545	>	# prints an error message unless quiet is turned on
546	>	sub error() {
547	>	my($msg) = @_;
548	>	print STDERR $msg unless $quiet;
549		}

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines