ViewVC Help

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

root/i-scream/experimental/reports/graphing/watch.pl

Comparing experimental/reports/graphing/watch.pl (file contents):
Revision 1.2 by tdb, Sun Mar 10 00:26:24 2002 UTC vs.
Revision 1.7 by tdb, Sun Aug 1 10:39:49 2004 UTC

#	Line 2 | Line 2
2
3		# -----------------------------------------------------------
4		# i-scream graph generation scripts
5	<	# http://www.i-scream.org.uk
5	>	# http://www.i-scream.org
6		#
7		# Generates rrd databases for i-scream data by connecting to
8		# the i-scream server and collecting data.
#	Line 11 | Line 11
11		# $Id$
12		#------------------------------------------------------------
13
14	+	## TODO
15	+	# ought to think about cleaning up when we restart?
16	+	#  -- old queue data etc
17	+
18		$| = 1;
19
20		use strict;
#	Line 34 | Line 38 | my($hex_slash) = "_2f";
38		# _ converted to a decimal then hex'd
39		my($hex_underscore) = "_5f";
40
41	+	# step interval in the rrd databases
42	+	my($rrdstep) = 15;
43	+
44	+	# time to wait (in seconds) before retrying a connection
45	+	my($retry_wait) = 10;
46	+
47		if (@ARGV != 2) {
48	<	die "Usage: ihost.pl [i-scream client interface] [TCP port]\n";
48	>	die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
49		}
50
51	+	# user supplied client interface server and port
52		my($addr) = $ARGV[0];
53		my($cport) = $ARGV[1];
54
55	<	my($csock) = new IO::Socket::INET(
56	<	PeerAddr => $addr,
57	<	PeerPort => $cport,
58	<	Proto => 'tcp'
59	<	) or die "Cannot connect!";
60	<
61	<	if (!defined $csock) {
62	<	print "ERROR: Could not connect to $addr:$cport.\n";
63	<	print "Please check that there is an i-scream server at this address.\n";
64	<	exit(1);
65	<	}
66	<
67	<	my($response);
68	<
69	<	$response = <$csock>;
70	<	if ($response && $response ne "PROTOCOL 1.1\n") {
71	<	print "The i-scream server sent an unexpected protocol id: $response\n";
55	>	while(1) {
56	>
57	>	print "Connecting control channel to port $cport on $addr...\n";
58	>
59	>	# attempt to connect the control channel
60	>	my($csock) = new IO::Socket::INET(
61	>	PeerAddr => $addr,
62	>	PeerPort => $cport,
63	>	Proto => 'tcp'
64	>	);
65	>
66	>	# if socket isn't defined connection failed
67	>	if (!defined $csock) {
68	>	print STDERR "ERROR: Could not connect control channel to $addr:$cport.\n";
69	>	print STDERR "Please check that there is an i-scream server at this address.\n";
70	>	&wait_then_retry();
71	>	next;
72	>	}
73	>
74	>	my($response);
75	>
76	>	# client interface should send it's protocol ID
77	>	# we know about "PROTOCOL 1.1", and will only accept the same
78	>	$response = <$csock>;
79	>	if ($response && $response ne "PROTOCOL 1.1\n") {
80	>	print STDERR "The i-scream server sent an unexpected protocol ID: $response\n";
81	>	close($csock);
82	>	&wait_then_retry();
83	>	next;
84	>	}
85	>
86	>	# send our identifier to the client interface
87	>	print $csock "rrdgraphing\n";
88	>	$response = <$csock>;
89	>	if ($response && $response ne "OK\n") {
90	>	print STDERR "Received unexpected response: $response\n";
91	>	close($csock);
92	>	&wait_then_retry();
93	>	next;
94	>	}
95	>
96	>	# tell the client interface we'd like to start the data channel
97	>	print $csock "STARTDATA\n";
98	>
99	>	# the response should be the socket to connect the data channel to
100	>	$response = <$csock>;
101	>	chomp $response;
102	>
103	>	my($dport) = $response;
104	>	print "Connecting data channel to port $dport on $addr...\n";
105	>
106	>	# attempt to connect the data channel
107	>	my($dsock) = new IO::Socket::INET(
108	>	PeerAddr => $addr,
109	>	PeerPort => $dport,
110	>	Proto => 'tcp'
111	>	) or die "arse?";
112	>
113	>	# if socket isn't defined connection failed
114	>	if (!defined $dsock) {
115	>	print STDERR "ERROR: Could not connect data channel to $addr:$dport.\n";
116	>	print STDERR "Failure in communications.\n";
117	>	close($csock);
118	>	&wait_then_retry();
119	>	next;
120	>	}
121	>
122	>	# the data channel should now be sending us data!
123	>
124	>	# call sub to process data being received over the data channel
125	>	&processdata($dsock);
126	>
127	>	# data processing has stopped, close sockets
128		close($csock);
129	<	exit(1);
129	>	close($dsock);
130	>
131	>	# wait before retrying
132	>	&wait_then_retry();
133		}
134
135	<	print $csock "cpugrapher\n";
136	<	$response = <$csock>;
67	<	if ($response && $response ne "OK\n") {
68	<	print "Received unexpected response: $response\n";
69	<	close($csock);
70	<	exit(1);
71	<	}
135	>	# we'll never reach here... unless 1 becomes false for some reason ;)
136	>	exit 0;
137
73	–	print $csock "STARTDATA\n";
74	–	$response = <$csock>;
138
139	<	chop $response;
140	<	print "Asked to connect to port $response on $addr, connecting...\n";
141	<
142	<	my($dport) = $response;
143	<
144	<	my($dsock) = new IO::Socket::INET(
82	<	PeerAddr => $addr,
83	<	PeerPort => $dport,
84	<	Proto => 'tcp'
85	<	) or die "Cannot connect!";
86	<
87	<	if (!defined $dsock) {
88	<	print "ERROR: Could not connect to $addr:$dport.\n";
89	<	print "Failure in communications.\n";
90	<	close($csock);
91	<	exit(1);
139	>	#
140	>	# wait for a while before retrying
141	>	#
142	>	sub wait_then_retry() {
143	>	print STDERR "Will retry connection to i-scream server in $retry_wait seconds.\n\n";
144	>	sleep $retry_wait;
145		}
146
147	<	## below here has been "improved"
148	<	## above is still a mess ;)
149	<
150	<	while(1) {
151	<	# read data
152	<	$response = <$dsock>;
147	>	#
148	>	# Given the socket of the data channel will process all
149	>	# the incoming XML data, creating and updating the appropriate
150	>	# database files.
151	>	#
152	>	# $dsock = socket connected to the data channel
153	>	#
154	>	sub processdata() {
155	>	# the socket connected to the data channel
156	>	my($dsock) = @_;
157	>	# save us recreating this variable each time we loop
158	>	my($xml);
159
160	<	# attemp to parse the data
161	<	my($err, %xmlhash) = &iscream::XMLParser::parse($response);
162	<	if($err) {
104	<	print STDERR "Skipped, XML did not parse: $response";
105	<	next;
106	<	}
107	<
108	<	# standard data packet
109	<	if($xmlhash{"packet.attributes.type"} eq "data") {
110	<	my($machine) = $xmlhash{"packet.attributes.machine_name"};
111	<	my($date) = $xmlhash{"packet.attributes.date"};
160	>	while(1) {
161	>	# read data
162	>	$xml = <$dsock>;
163
164	<	# make directory for machine
165	<	if(! -d "$rrddir/$machine") {
166	<	# not sure on this umask, but it seems to work?
167	<	mkdir "$rrddir/$machine", 0777;
164	>	# something odd has happened
165	>	last if not defined $xml;
166	>
167	>	# attempt to parse the data
168	>	my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
169	>	if($err) {
170	>	print STDERR "Skipped, XML did not parse: $xml";
171	>	next;
172		}
173
174	<	my(@data);
175	<
176	<	# cpu
177	<	@data = ( "packet.cpu.idle:idle:GAUGE",
178	<	"packet.cpu.user:user:GAUGE",
179	<	"packet.cpu.kernel:kernel:GAUGE",
180	<	"packet.cpu.swap:swap:GAUGE",
181	<	"packet.cpu.iowait:iowait:GAUGE",
182	<	);
183	<	&updaterrd($machine, "cpu", $date, 15, \%xmlhash, @data);
184	<
185	<	# mem
186	<	@data = ( "packet.memory.free:free:GAUGE",
187	<	"packet.memory.total:total:GAUGE",
188	<	);
189	<	&updaterrd($machine, "mem", $date, 15, \%xmlhash, @data);
190	<
191	<	# load
192	<	@data = ( "packet.load.load1:load1:GAUGE",
138	<	"packet.load.load5:load5:GAUGE",
139	<	"packet.load.load15:load15:GAUGE",
140	<	);
141	<	&updaterrd($machine, "load", $date, 15, \%xmlhash, @data);
142	<
143	<	# processes
144	<	@data = ( "packet.processes.cpu:cpu:GAUGE",
145	<	"packet.processes.sleeping:sleeping:GAUGE",
146	<	"packet.processes.stopped:stopped:GAUGE",
147	<	"packet.processes.total:total:GAUGE",
148	<	"packet.processes.zombie:zombie:GAUGE",
149	<	);
150	<	&updaterrd($machine, "proc", $date, 15, \%xmlhash, @data);
151	<
152	<	# swap
153	<	@data = ( "packet.swap.free:free:GAUGE",
154	<	"packet.swap.total:total:GAUGE",
155	<	);
156	<	&updaterrd($machine, "swap", $date, 15, \%xmlhash, @data);
157	<
158	<	# users
159	<	@data = ( "packet.users.count:count:GAUGE",
160	<	);
161	<	&updaterrd($machine, "users", $date, 15, \%xmlhash, @data);
162	<
163	<	# disk
164	<	my($i) = 0;
165	<	while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
166	<	my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
167	<	$mount =~ s/_/$hex_underscore/g;
168	<	$mount =~ s/\//$hex_slash/g;
169	<	@data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
170	<	"packet.disk.p$i.attributes.used:used:GAUGE",
174	>	# standard data packet
175	>	if($xmlhash{"packet.attributes.type"} eq "data") {
176	>	my($machine) = $xmlhash{"packet.attributes.machine_name"};
177	>	my($date) = $xmlhash{"packet.attributes.date"};
178	>
179	>	# make directory for machine
180	>	if(! -d "$rrddir/$machine") {
181	>	# not sure on this umask, but it seems to work?
182	>	mkdir "$rrddir/$machine", 0777;
183	>	}
184	>
185	>	my(@data);
186	>
187	>	# cpu
188	>	@data = ( "packet.cpu.idle:idle:GAUGE",
189	>	"packet.cpu.user:user:GAUGE",
190	>	"packet.cpu.kernel:kernel:GAUGE",
191	>	"packet.cpu.swap:swap:GAUGE",
192	>	"packet.cpu.iowait:iowait:GAUGE",
193		);
194	<	&updaterrd($machine, "disk-$mount", $date, 15, \%xmlhash, @data);
195	<	++$i;
194	>	&updaterrd($machine, "cpu", $date, $rrdstep, \%xmlhash, @data);
195	>
196	>	# mem
197	>	@data = ( "packet.memory.free:free:GAUGE",
198	>	"packet.memory.total:total:GAUGE",
199	>	);
200	>	&updaterrd($machine, "mem", $date, $rrdstep, \%xmlhash, @data);
201	>
202	>	# load
203	>	@data = ( "packet.load.load1:load1:GAUGE",
204	>	"packet.load.load5:load5:GAUGE",
205	>	"packet.load.load15:load15:GAUGE",
206	>	);
207	>	&updaterrd($machine, "load", $date, $rrdstep, \%xmlhash, @data);
208	>
209	>	# processes
210	>	@data = ( "packet.processes.cpu:cpu:GAUGE",
211	>	"packet.processes.sleeping:sleeping:GAUGE",
212	>	"packet.processes.stopped:stopped:GAUGE",
213	>	"packet.processes.total:total:GAUGE",
214	>	"packet.processes.zombie:zombie:GAUGE",
215	>	);
216	>	&updaterrd($machine, "proc", $date, $rrdstep, \%xmlhash, @data);
217	>
218	>	# swap
219	>	@data = ( "packet.swap.free:free:GAUGE",
220	>	"packet.swap.total:total:GAUGE",
221	>	);
222	>	&updaterrd($machine, "swap", $date, $rrdstep, \%xmlhash, @data);
223	>
224	>	# users
225	>	@data = ( "packet.users.count:count:GAUGE",
226	>	);
227	>	&updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
228	>
229	>	# disk
230	>	my($i) = 0;
231	>	while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
232	>	my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
233	>	$mount =~ s/_/$hex_underscore/g;
234	>	$mount =~ s/\//$hex_slash/g;
235	>	@data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
236	>	"packet.disk.p$i.attributes.used:used:GAUGE",
237	>	);
238	>	&updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
239	>	++$i;
240	>	}
241		}
242	<	}
243	<
244	<	# queue statistics packet
245	<	elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
246	<	# psuedo machine for internal server stuff
247	<	my($machine) = "i-scream-server";
248	<	# make directory
249	<	if(! -d "$rrddir/$machine") {
250	<	# not sure on this umask, but it seems to work?
251	<	mkdir "$rrddir/$machine", 0777;
252	<	}
253	<	my($hash) = $xmlhash{"packet.attributes.hashCode"};
254	<	my($date) = $xmlhash{"packet.attributes.date"};
255	<	my($name) = $xmlhash{"packet.attributes.name"};
256	<	# take a look to see if we have a shutdown packet...
257	<	if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
258	<	unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
259	<	next;
260	<	}
261	<	# look through to see how many internal queues we have
262	<	my($i) = 0;
263	<	while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
264	<	# see if the queue has been removed
265	<	if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
266	<	# delete the queues rrd
267	<	unlink "$rrddir/$machine/$hash\_$i.rrd";
268	<	# are there any other rrd's left on this queue? if not, cleanup.
269	<	# get a list of any that may be still there..
270	<	opendir(DIR, "$rrddir/$machine");
271	<	my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
272	<	closedir DIR;
273	<	# count them (+1 because an empty array is size -1)
274	<	my($rrdcount) = $#rrdcountfiles + 1;
275	<	if($rrdcount == 0) {
276	<	# clean up the def file and any images
277	<	unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
242	>
243	>	# queue statistics packet
244	>	elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
245	>	# psuedo machine for internal server stuff
246	>	my($machine) = "i-scream-server";
247	>	# make directory
248	>	if(! -d "$rrddir/$machine") {
249	>	# not sure on this umask, but it seems to work?
250	>	mkdir "$rrddir/$machine", 0777;
251	>	}
252	>	my($hash) = $xmlhash{"packet.attributes.hashCode"};
253	>	my($date) = $xmlhash{"packet.attributes.date"};
254	>	my($name) = $xmlhash{"packet.attributes.name"};
255	>	# take a look to see if we have a shutdown packet...
256	>	if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
257	>	unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
258	>	next;
259	>	}
260	>	# look through to see how many internal queues we have
261	>	my($i) = 0;
262	>	while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
263	>	# see if the queue has been removed
264	>	if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
265	>	# delete the queues rrd
266	>	unlink "$rrddir/$machine/$hash\_$i.rrd";
267	>	# are there any other rrd's left on this queue? if not, cleanup.
268	>	# get a list of any that may be still there..
269	>	opendir(DIR, "$rrddir/$machine");
270	>	my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
271	>	closedir DIR;
272	>	# count them (+1 because an empty array is size -1)
273	>	my($rrdcount) = $#rrdcountfiles + 1;
274	>	if($rrdcount == 0) {
275	>	# clean up the def file and any images
276	>	unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
277	>	}
278	>	++$i;
279	>	next;
280		}
281	+	# the &updaterrd will also do this check, but we want
282	+	# to write our def file out first
283	+	if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
284	+	open(DEF, ">$rrddir/$machine/$hash.def");
285	+	print DEF $name;
286	+	close DEF;
287	+	}
288	+	my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
289	+	"packet.queue.attributes.total:total:COUNTER",
290	+	);
291	+	&updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
292		++$i;
213	–	next;
293		}
215	–	# the &updaterrd will also do this check, but we want
216	–	# to write our def file out first
217	–	if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
218	–	open(DEF, ">$rrddir/$machine/$hash.def");
219	–	print DEF $name;
220	–	close DEF;
221	–	}
222	–	my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
223	–	"packet.queue.attributes.total:total:GAUGE",
224	–	);
225	–	&updaterrd($machine, "$hash\_$i", $date, 15, \%xmlhash, @data);
226	–	++$i;
294		}
295	+	else {
296	+	#print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
297	+	}
298		}
299	<	else {
300	<	#print "SKIPPED: valid xml, but not a data or statistics packet\n";
301	<	}
299	>
300	>	# we'll now return from this sub and reconnect
301	>	print STDERR "Data channel socket gave no data, bailing out...\n";
302		}
303
234	–	# we'll never reach here... unless 1 becomes false for some reason ;)
235	–	exit 0;
236	–
237	–
304		#
305		# sub to update an rrd file
306		#
#	Line 272 | Line 338 | sub updaterrd() {
338		foreach my $dataitem (@data) {
339		if($dataitem =~ /^(\S+):\S+:\S+$/) {
340		# pull the values straight out of the xmlhash
341	<	$updateparams .= ":$xmlhash{$1}";
341	>	my($value) = $xmlhash{$1};
342	>	# if it's undefined we'll set it to 0
343	>	# this probably shouldn't happen, but it'd be best to handle it "nicely" :)
344	>	$value = "0" if not defined $value;
345	>	$updateparams .= ":$value";
346		}
347		}
348		# perform the update
#	Line 327 | Line 397 | sub makerrd() {
397		"RRA:MAX:0.5:60:672",
398		# 1m in 1hr samples
399		"RRA:AVERAGE:0.5:240:744",
400	<	"RRA:MAX:0.5:60:744",
400	>	"RRA:MAX:0.5:240:744",
401	>	# 1y in 12hr samples
402	>	"RRA:AVERAGE:0.5:2880:730",
403	>	"RRA:MAX:0.5:2880:730",
404		);
405		RRDs::create (@rrdcmd);
406		my($err) = RRDs::error;

Diff Legend

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