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.1 by tdb, Sat Mar 9 19:53:24 2002 UTC vs.
Revision 1.5 by tdb, Sun Mar 10 15:42:19 2002 UTC

#	Line 1 | Line 1
1		#!/usr/bin/perl -w
2
3	+	# -----------------------------------------------------------
4	+	# i-scream graph generation scripts
5	+	# http://www.i-scream.org.uk
6	+	#
7	+	# Generates rrd databases for i-scream data by connecting to
8	+	# the i-scream server and collecting data.
9	+	#
10	+	# $Author$
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 7 | Line 22 | use iscream::XMLParser;
22		use IO::Socket;
23		use RRDs;
24
25	<	if (@ARGV != 2) {
26	<	die "Usage: ihost.pl [i-scream client interface] [TCP port]\n";
27	<	}
25	>	# Base directory for images
26	>	# (a directory will be constructed for each host under this)
27	>	my($imgdir) = "/home/tdb/public_html/rrd";
28
29	<	my($addr) = $ARGV[0];
30	<	my($cport) = $ARGV[1];
29	>	# Location of RRD databases
30	>	my($rrddir) = "/u1/i-scream/rrd";
31
32	<	#print `rm -f *.rrd *.png`;
32	>	# for reference:
33	>	# ch -> hex: $hex = sprintf("%02x", ord($ch));
34	>	# hex -> ch: $ch = chr(hex($hex));
35
36	<	my($csock) = new IO::Socket::INET(
37	<	PeerAddr => $addr,
38	<	PeerPort => $cport,
39	<	Proto => 'tcp'
23	<	) or die "Cannot connect!";
36	>	# / converted to a decimal then hex'd
37	>	my($hex_slash) = "_2f";
38	>	# _ converted to a decimal then hex'd
39	>	my($hex_underscore) = "_5f";
40
41	<	if (!defined $csock) {
42	<	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	<	}
41	>	# step interval in the rrd databases
42	>	my($rrdstep) = 15;
43
44	<	my($response);
44	>	# time to wait (in seconds) before retrying a connection
45	>	my($retry_wait) = 10;
46
47	<	$response = <$csock>;
48	<	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);
47	>	if (@ARGV != 2) {
48	>	die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
49		}
50
51	<	print $csock "cpugrapher\n";
52	<	$response = <$csock>;
53	<	if ($response && $response ne "OK\n") {
54	<	print "Received unexpected response: $response\n";
51	>	# user supplied client interface server and port
52	>	my($addr) = $ARGV[0];
53	>	my($cport) = $ARGV[1];
54	>
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 "SETHOSTLIST\n";
136	<	#$response = <$csock>;
50	<	#if ($response && $response ne "OK\n") {
51	<	#    print "Received odd response: $response\n";
52	<	#    close($csock);
53	<	#    exit(1);
54	<	#}
135	>	# we'll never reach here... unless 1 becomes false for some reason ;)
136	>	exit 0;
137
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	–	#}
138
139	<	print $csock "STARTDATA\n";
140	<	$response = <$csock>;
141	<
142	<	chop $response;
143	<	print "Asked to connect to port $response on $addr, connecting...\n";
144	<
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);
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	<	while(1) {
148	<	$response = <$dsock>;
149	<	#print "$response\n";
150	<	my($err, %xmlhash) = &iscream::XMLParser::parse($response);
151	<	if($err) {
152	<	print "SKIPPED (bad xml): $response";
153	<	}
154	<	## -- mental note, think about ordering checks for optimal speed ;)
155	<	# take a look to see if we have a shutdown packet...
156	<	if($xmlhash{"packet.attributes.type"} eq "data") {
157	<	my($machine) = $xmlhash{"packet.attributes.machine_name"};
158	<	my($date) = $xmlhash{"packet.attributes.date"};
159	<	# make directory for machine
160	<	if(! -d "$machine") {
161	<	# not sure on this umask, but it seems to work?
162	<	mkdir "$machine", 0777;
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	>	while(1) {
161	>	# read data
162	>	$xml = <$dsock>;
163	>
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	<	# cpu
174	<	my($cpu_idle) = $xmlhash{"packet.cpu.idle"};
175	<	my($cpu_user) = $xmlhash{"packet.cpu.user"};
176	<	my($cpu_kernel) = $xmlhash{"packet.cpu.kernel"};
177	<	my($cpu_swap) = $xmlhash{"packet.cpu.swap"};
178	<	my($cpu_iowait) = $xmlhash{"packet.cpu.iowait"};
179	<	if( ! -f "$machine/cpu.rrd") {
180	<	print "making new rrd for $machine\_cpu\n";
181	<	&makerrd_cpu($machine, $date);
182	<	}
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);
173	>
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	<	#my($avail) = $xmlhash{"packet.disk.p$i.attributes.avail"};
185	<	my($kbytes) = $xmlhash{"packet.disk.p$i.attributes.kbytes"};
186	<	my($used) = $xmlhash{"packet.disk.p$i.attributes.used"};
187	<	#print "$machine\_disk-$name.rrd $date:$kbytes:$used\n";
188	<	RRDs::update ("$machine/disk-$encmount.rrd", "$date:$kbytes:$used");
189	<	my($err_disk) = RRDs::error;
190	<	die "Error_disk: $err_disk\n" if $err_disk;
191	<	++$i;
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, "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	<	elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
245	<	# make directory
246	<	if(! -d "i-scream-server") {
247	<	# not sure on this umask, but it seems to work?
248	<	mkdir "i-scream-server", 0777;
249	<	}
250	<	# take a look to see if we have a shutdown packet...
251	<	if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
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($cmd) = "rm -f i-scream-server/$hash\_*.rrd /home/tdb/public_html/rrd/i-scream-server/$hash*.png i-scream-server/$hash.def";
254	<	print `$cmd`;
255	<	print "$cmd\n";
256	<	next;
257	<	}
258	<	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);
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	<	my($size) = $xmlhash{"packet.queue.attributes.queue$i"};
261	<	my($cmd);
262	<	# see if the queue has been removed
263	<	if($size eq "[deleted]") {
264	<	$cmd = "rm -f i-scream-server/$hash\_$i.rrd";
265	<	# are there any other rrd's left? if not, cleanup!
266	<	my($rrdcount) = `ls i-scream-server | grep $hash\_\\*.rrd | wc -l`;
267	<	if($rrdcount == 0) {
268	<	$cmd = $cmd . " && rm -f i-scream-server/$hash.def /home/tdb/public_html/rrd/i-scream-server/$hash*.png";
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	<	print `$cmd`;
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;
293		}
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;
294		}
295	+	else {
296	+	#print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
297	+	}
298		}
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	–	}
299
300	<	sub makerrd_users() {
301	<	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`;
300	>	# we'll now return from this sub and reconnect
301	>	print STDERR "Data channel socket gave no data, bailing out...\n";
302		}
303
304	<	sub makerrd_disk() {
305	<	my($machine, $start, $mount) = @_;
306	<	$start = $start - 15;
307	<	my($init) = "rrdtool create $machine/disk-$mount.rrd --start $start --step 15";
308	<	my($ds) = "DS:kbytes:GAUGE:600:U:U DS:used:GAUGE:600:U:U";
309	<	#            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
310	<	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";
311	<	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";
312	<	my($cmd) = "$init $ds $rra1 $rra2";
313	<	print `$cmd`;
314	<	print "$cmd\n";
315	<	print `chmod 600 $machine/disk-$mount.rrd`;
304	>	#
305	>	# sub to update an rrd file
306	>	#
307	>	# $machine   = name of the machine
308	>	#              (eg. kernow.ukc.ac.uk)
309	>	# $type      = the type of graph for the machine
310	>	#              (eg. cpu)
311	>	# $date      = the date of the item we want to add
312	>	#              (in seconds since the epoch)
313	>	# $step      = the interval at which the database steps
314	>	#              used when we create a new rrd
315	>	# $xmlref    = reference to the xml data packet
316	>	# @data      = array containing data items to add
317	>	#              (eg. "packet.cpu.user:user:GAUGE")
318	>	#
319	>	sub updaterrd() {
320	>	my($machine, $type, $date, $step, $xmlref, @data) = @_;
321	>	# get hold of the xmlhash we have a reference to
322	>	my(%xmlhash) = %$xmlref;
323	>	# check if we need to create a new rrd
324	>	if( ! -f "$rrddir/$machine/$type.rrd") {
325	>	my(@createdata);
326	>	# pull the details out of the data we've been given
327	>	foreach my $dataitem (@data) {
328	>	if($dataitem =~ /^\S+:(\S+):(\S+)$/) {
329	>	push @createdata, "$1:$2";
330	>	}
331	>	}
332	>	# call the &makerrd to actually create the rrd
333	>	print "making new rrd for $rrddir/$machine/$type.rrd\n";
334	>	&makerrd($machine, $type, $date, $step, @createdata);
335	>	}
336	>	# get the details out of the data we've been given
337	>	my($updateparams) = "$date";
338	>	foreach my $dataitem (@data) {
339	>	if($dataitem =~ /^(\S+):\S+:\S+$/) {
340	>	# pull the values straight out of the xmlhash
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
349	>	RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
350	>	my($err) = RRDs::error;
351	>	print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
352		}
353
354	<	sub makerrd_queue() {
355	<	my($name, $queuenum, $start, $comment) = @_;
356	<	$start = $start - 15;
357	<	my($init) = "rrdtool create i-scream-server/$name\_$queuenum.rrd --start $start --step 15";
358	<	my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U";
359	<	#            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
360	<	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";
361	<	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";
362	<	my($cmd) = "$init $ds $rra1 $rra2";
363	<	print `$cmd`;
364	<	print "$cmd\n";
365	<	print `echo "$comment" > i-scream-server/$name.def`;
366	<	print `chmod 600 i-scream-server/$name\_$queuenum.rrd i-scream-server/$name.def`;
367	<	}
354	>	#
355	>	# sub to create a new rrd file
356	>	#
357	>	# $machine = name of the machine
358	>	#            (eg. kernow.ukc.ac.uk)
359	>	# $type    = the type of graph for the machine
360	>	#            (eg. cpu)
361	>	# $start   = the date of the first item we want to add
362	>	#            (in seconds since the epoch)
363	>	# $step    = the interval at which the database steps
364	>	# @data    = the data items we want to put in the rrd
365	>	#            in the form: $dsname:dstype
366	>	#            (eg. "size:GAUGE")
367	>	#
368	>	sub makerrd() {
369	>	my($machine, $type, $start, $step, @data) = @_;
370	>	# check if directory exists for rrd
371	>	if(! -d "$rrddir/$machine") {
372	>	# not sure on this umask, but it seems to work?
373	>	mkdir "$rrddir/$machine", 0777;
374	>	}
375	>	my(@rrdcmd);
376	>	# we'll want to add our first data item at $start,
377	>	# so we start our rrd $step before that.
378	>	$start -= $step;
379	>	push @rrdcmd, "$rrddir/$machine/$type.rrd";
380	>	push @rrdcmd, "--start=$start";
381	>	push @rrdcmd, "--step=$step";
382	>	foreach my $dataitem (@data) {
383	>	# dataitem should be: "dsname:dstype"
384	>	if($dataitem =~ /^(\S+):(\S+)$/) {
385	>	push @rrdcmd, "DS:$1:$2:600:U:U";
386	>	}
387	>	}
388	>	push @rrdcmd, (
389	>	# 3h in 15s samples
390	>	"RRA:AVERAGE:0.5:1:720",
391	>	"RRA:MAX:0.5:1:720",
392	>	# 1d in 2m samples
393	>	"RRA:AVERAGE:0.5:8:720",
394	>	"RRA:MAX:0.5:8:720",
395	>	# 1w in 15m samples
396	>	"RRA:AVERAGE:0.5:60:672",
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",
401	>	);
402	>	RRDs::create (@rrdcmd);
403	>	my($err) = RRDs::error;
404	>	print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
405	>	}

Diff Legend

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