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.1 by tdb, Mon Mar 18 13:24:31 2002 UTC vs.
Revision 1.4 by tdb, Tue May 21 16:47:16 2002 UTC

#	Line 1 | Line 1
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
#	Line 11 | Line 31
31		# $Id$
32		#------------------------------------------------------------
33
34	<	## TODO
15	<	# ought to think about cleaning up when we restart?
16	<	#  -- old queue data etc
34	>	my($version) = '$Id$';
35
36		$| = 1;
37
38		use strict;
39	<	use iscream::XMLParser;
39	>	use Getopt::Std;
40		use IO::Socket;
41	+	use iscream::XMLParser;
42		use RRDs;
43
44	<	# Base directory for images
45	<	# (a directory will be constructed for each host under this)
46	<	my($imgdir) = "/home/pkg/iscream/public_html/graphs";
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	<	# Location of RRD databases
55	<	my($rrddir) = "/u1/i-scream/databases";
54	>	# default locate of the config file
55	>	my($configfile) = "rrdgraphing.conf";
56
57	<	# for reference:
58	<	# ch -> hex: $hex = sprintf("%02x", ord($ch));
59	<	# hex -> ch: $ch = chr(hex($hex));
57	>	# check for command line arguments
58	>	my(%opts);
59	>	my($ret) = getopts('hvqVc:', \%opts);
60
61	<	# / converted to a decimal then hex'd
62	<	my($hex_slash) = "_2f";
38	<	# _ converted to a decimal then hex'd
39	<	my($hex_underscore) = "_5f";
61	>	# if invalid argument given, $ret will not be 1
62	>	&usage() if $ret != 1;
63
64	<	# step interval in the rrd databases
42	<	my($rrdstep) = 15;
64	>	# first process the arguments which might mean we exit now
65
66	<	# time to wait (in seconds) before retrying a connection
67	<	my($retry_wait) = 10;
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	<	die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
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	<	print "Connecting control channel to port $cport on $addr...\n";
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(
#	Line 65 | Line 122 | while(1) {
122
123		# if socket isn't defined connection failed
124		if (!defined $csock) {
125	<	print STDERR "ERROR: Could not connect control channel to $addr:$cport.\n";
126	<	print STDERR "Please check that there is an i-scream server at this address.\n";
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		}
#	Line 76 | Line 133 | while(1) {
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	<	print STDERR "The i-scream server sent an unexpected protocol ID: $response\n";
138	>	&error("The i-scream server sent an unexpected protocol ID: $response\n");
139		close($csock);
140		&wait_then_retry();
141		next;
#	Line 85 | Line 143 | while(1) {
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	<	print STDERR "Received unexpected response: $response\n";
150	>	&error("Received unexpected response: $response\n");
151		close($csock);
152		&wait_then_retry();
153		next;
#	Line 95 | Line 155 | while(1) {
155
156		# tell the client interface we'd like to start the data channel
157		print $csock "STARTDATA\n";
158	<
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	<	print "Connecting data channel to port $dport on $addr...\n";
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(
#	Line 112 | Line 174 | while(1) {
174
175		# if socket isn't defined connection failed
176		if (!defined $dsock) {
177	<	print STDERR "ERROR: Could not connect data channel to $addr:$dport.\n";
178	<	print STDERR "Failure in communications.\n";
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;
#	Line 140 | Line 202 | exit 0;
202		# wait for a while before retrying
203		#
204		sub wait_then_retry() {
205	<	print STDERR "Will retry connection to i-scream server in $retry_wait seconds.\n\n";
205	>	&error("Will retry connection to i-scream server in $retry_wait seconds.\n\n");
206		sleep $retry_wait;
207		}
208
#	Line 167 | Line 229 | sub processdata() {
229		# attempt to parse the data
230		my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
231		if($err) {
232	<	print STDERR "Skipped, XML did not parse: $xml";
232	>	&error("Skipped, XML did not parse: $xml");
233		next;
234		}
235
#	Line 180 | Line 242 | sub processdata() {
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);
#	Line 248 | Line 311 | sub processdata() {
311		if(! -d "$rrddir/$machine") {
312		# not sure on this umask, but it seems to work?
313		mkdir "$rrddir/$machine", 0777;
314	+	&log("created directory $rrddir/$machine\n");
315		}
316		my($hash) = $xmlhash{"packet.attributes.hashCode"};
317		my($date) = $xmlhash{"packet.attributes.date"};
#	Line 255 | Line 319 | sub processdata() {
319		# take a look to see if we have a shutdown packet...
320		if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
321		unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
322	+	&log("deleted $rrddir/$machine/$hash\_*.rrd $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
323		next;
324		}
325		# look through to see how many internal queues we have
#	Line 264 | Line 329 | sub processdata() {
329		if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
330		# delete the queues rrd
331		unlink "$rrddir/$machine/$hash\_$i.rrd";
332	+	&log("deleted $rrddir/$machine/$hash\_$i.rrd\n");
333		# are there any other rrd's left on this queue? if not, cleanup.
334		# get a list of any that may be still there..
335		opendir(DIR, "$rrddir/$machine");
#	Line 274 | Line 340 | sub processdata() {
340		if($rrdcount == 0) {
341		# clean up the def file and any images
342		unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
343	+	&log("deleted $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
344		}
345		++$i;
346		next;
#	Line 284 | Line 351 | sub processdata() {
351		open(DEF, ">$rrddir/$machine/$hash.def");
352		print DEF $name;
353		close DEF;
354	+	&log("created $rrddir/$machine/$hash.def\n");
355		}
356		my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
357		"packet.queue.attributes.total:total:COUNTER",
#	Line 293 | Line 361 | sub processdata() {
361		}
362		}
363		else {
364	<	#print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
364	>	#&error("SKIPPED: valid xml, but not a data or statistics packet\n");
365		}
366		}
367
368		# we'll now return from this sub and reconnect
369	<	print STDERR "Data channel socket gave no data, bailing out...\n";
369	>	&error("Data channel socket gave no data, bailing out...\n");
370		}
371
372		#
#	Line 330 | Line 398 | sub updaterrd() {
398		}
399		}
400		# call the &makerrd to actually create the rrd
401	<	print "making new rrd for $rrddir/$machine/$type.rrd\n";
401	>	&log("making new rrd for $rrddir/$machine/$type.rrd\n");
402		&makerrd($machine, $type, $date, $step, @createdata);
403		}
404		# get the details out of the data we've been given
#	Line 347 | Line 415 | sub updaterrd() {
415		}
416		# perform the update
417		RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
418	+	&log("updating $rrddir/$machine/$type.rrd\n");
419		my($err) = RRDs::error;
420	<	print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
420	>	&error("Error updating $rrddir/$machine/$type.rrd: $err\n") if $err;
421		}
422
423		#
#	Line 371 | Line 440 | sub makerrd() {
440		if(! -d "$rrddir/$machine") {
441		# not sure on this umask, but it seems to work?
442		mkdir "$rrddir/$machine", 0777;
443	+	&log("created directory $rrddir/$machine\n");
444		}
445		my(@rrdcmd);
446		# we'll want to add our first data item at $start,
#	Line 404 | Line 474 | sub makerrd() {
474		);
475		RRDs::create (@rrdcmd);
476		my($err) = RRDs::error;
477	<	print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
477	>	&error("Error creating rrd for $rrddir/$machine/$type: $err\n") if $err;
478	>	}
479	>
480	>	# prints out usage information then exits
481	>	sub usage() {
482	>	print "Usage: watch.pl [options] i-scream_client_interface port\n";
483	>	print "Options\n";
484	>	print "  -c config        Specifies the configuration file\n";
485	>	print "                    default: rrdgraphing.conf\n";
486	>	print "  -v               Be verbose about what's happening\n";
487	>	print "  -q               Be quiet, even supress errors\n";
488	>	print "  -V               Print version number\n";
489	>	print "  -h               Prints this help page\n";
490	>	exit(1);
491	>	}
492	>
493	>	# prints a log message if verbose is turned on
494	>	sub log() {
495	>	my($msg) = @_;
496	>	print $msg if $verbose;
497	>	}
498	>
499	>	# prints an error message unless quiet is turned on
500	>	sub error() {
501	>	my($msg) = @_;
502	>	print STDERR $msg unless $quiet;
503		}

Diff Legend

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