reports/graphing/watch.pl

#!/usr/bin/perl -w

# -----------------------------------------------------------
# i-scream graph generation scripts
# http://www.i-scream.org.uk
#
# Generates rrd databases for i-scream data by connecting to
# the i-scream server and collecting data.
#
# $Author$
# $Id$
#------------------------------------------------------------

## TODO
# ought to think about cleaning up when we restart?
#  -- old queue data etc

$| = 1;

use strict;
use iscream::XMLParser;
use IO::Socket;
use RRDs;

# Base directory for images
# (a directory will be constructed for each host under this)
my($imgdir) = "/home/tdb/public_html/rrd";

# Location of RRD databases
my($rrddir) = "/u1/i-scream/rrd";

# for reference:
# ch -> hex: $hex = sprintf("%02x", ord($ch));
# hex -> ch: $ch = chr(hex($hex));

# / converted to a decimal then hex'd
my($hex_slash) = "_2f";
# _ converted to a decimal then hex'd
my($hex_underscore) = "_5f";

# step interval in the rrd databases
my($rrdstep) = 15;

# time to wait (in seconds) before retrying a connection
my($retry_wait) = 10;

if (@ARGV != 2) {
    die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
}

# user supplied client interface server and port
my($addr) = $ARGV[0];
my($cport) = $ARGV[1];

while(1) {
    
    print "Connecting control channel to port $cport on $addr...\n";
    
    # attempt to connect the control channel
    my($csock) = new IO::Socket::INET(
        PeerAddr => $addr,
        PeerPort => $cport,
        Proto => 'tcp'
        );
    
    # if socket isn't defined connection failed
    if (!defined $csock) {
        print STDERR "ERROR: Could not connect control channel to $addr:$cport.\n";
        print STDERR "Please check that there is an i-scream server at this address.\n";
        &wait_then_retry();
        next;
    }
    
    my($response);
    
    # client interface should send it's protocol ID
    # we know about "PROTOCOL 1.1", and will only accept the same
    $response = <$csock>;
    if ($response && $response ne "PROTOCOL 1.1\n") {
        print STDERR "The i-scream server sent an unexpected protocol ID: $response\n";
        close($csock);
        &wait_then_retry();
        next;
    }
    
    # send our identifier to the client interface
    print $csock "rrdgraphing\n";
    $response = <$csock>;
    if ($response && $response ne "OK\n") {
        print STDERR "Received unexpected response: $response\n";
        close($csock);
        &wait_then_retry();
        next;
    }
    
    # tell the client interface we'd like to start the data channel
    print $csock "STARTDATA\n";
    
    # the response should be the socket to connect the data channel to
    $response = <$csock>;
    chomp $response;
    
    my($dport) = $response;
    print "Connecting data channel to port $dport on $addr...\n";
    
    # attempt to connect the data channel
    my($dsock) = new IO::Socket::INET(
        PeerAddr => $addr,
        PeerPort => $dport,
        Proto => 'tcp'
        ) or die "arse?";
    
    # if socket isn't defined connection failed
    if (!defined $dsock) {
        print STDERR "ERROR: Could not connect data channel to $addr:$dport.\n";
        print STDERR "Failure in communications.\n";
        close($csock);
        &wait_then_retry();
        next;
    }
    
    # the data channel should now be sending us data!
    
    # call sub to process data being received over the data channel
    &processdata($dsock);
    
    # data processing has stopped, close sockets
    close($csock);
    close($dsock);
    
    # wait before retrying
    &wait_then_retry();
}

# we'll never reach here... unless 1 becomes false for some reason ;)
exit 0;


#
# wait for a while before retrying
#
sub wait_then_retry() {
    print STDERR "Will retry connection to i-scream server in $retry_wait seconds.\n\n";
    sleep $retry_wait;
}

#
# Given the socket of the data channel will process all
# the incoming XML data, creating and updating the appropriate
# database files.
#
# $dsock = socket connected to the data channel
#
sub processdata() {
    # the socket connected to the data channel
    my($dsock) = @_;
    # save us recreating this variable each time we loop
    my($xml);
    
    while(1) {
        # read data
        $xml = <$dsock>;
        
        # something odd has happened
        last if not defined $xml;
        
        # attempt to parse the data
        my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
        if($err) {
            print STDERR "Skipped, XML did not parse: $xml";
            next;
        }
        
        # standard data packet
        if($xmlhash{"packet.attributes.type"} eq "data") {
            my($machine) = $xmlhash{"packet.attributes.machine_name"};
            my($date) = $xmlhash{"packet.attributes.date"};
            
            # make directory for machine
            if(! -d "$rrddir/$machine") {
                # not sure on this umask, but it seems to work?
                mkdir "$rrddir/$machine", 0777;
            }
            
            my(@data);
            
            # cpu
            @data = ( "packet.cpu.idle:idle:GAUGE",
                      "packet.cpu.user:user:GAUGE",
                      "packet.cpu.kernel:kernel:GAUGE",
                      "packet.cpu.swap:swap:GAUGE",
                      "packet.cpu.iowait:iowait:GAUGE",
                     );
            &updaterrd($machine, "cpu", $date, $rrdstep, \%xmlhash, @data);
                   
            # mem
            @data = ( "packet.memory.free:free:GAUGE",
                      "packet.memory.total:total:GAUGE",
                     );
            &updaterrd($machine, "mem", $date, $rrdstep, \%xmlhash, @data);
                    
            # load
            @data = ( "packet.load.load1:load1:GAUGE",
                      "packet.load.load5:load5:GAUGE",
                      "packet.load.load15:load15:GAUGE",
                     );
            &updaterrd($machine, "load", $date, $rrdstep, \%xmlhash, @data);
            
            # processes
            @data = ( "packet.processes.cpu:cpu:GAUGE",
                      "packet.processes.sleeping:sleeping:GAUGE",
                      "packet.processes.stopped:stopped:GAUGE",
                      "packet.processes.total:total:GAUGE",
                      "packet.processes.zombie:zombie:GAUGE",
                     );
            &updaterrd($machine, "proc", $date, $rrdstep, \%xmlhash, @data);
            
            # swap
            @data = ( "packet.swap.free:free:GAUGE",
                      "packet.swap.total:total:GAUGE",
                     );
            &updaterrd($machine, "swap", $date, $rrdstep, \%xmlhash, @data);
            
            # users
            @data = ( "packet.users.count:count:GAUGE",
                     );
            &updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
            
            # disk
            my($i) = 0;
            while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
                my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
                $mount =~ s/_/$hex_underscore/g;
                $mount =~ s/\//$hex_slash/g;
                @data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
                          "packet.disk.p$i.attributes.used:used:GAUGE",
                         );
                &updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
                ++$i;
            }
        }
        
        # queue statistics packet
        elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
            # psuedo machine for internal server stuff
            my($machine) = "i-scream-server";
            # make directory
            if(! -d "$rrddir/$machine") {
                # not sure on this umask, but it seems to work?
                mkdir "$rrddir/$machine", 0777;
            }
            my($hash) = $xmlhash{"packet.attributes.hashCode"};
            my($date) = $xmlhash{"packet.attributes.date"};
            my($name) = $xmlhash{"packet.attributes.name"};
            # take a look to see if we have a shutdown packet...
            if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
                unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
                next;
            }
            # look through to see how many internal queues we have
            my($i) = 0;
            while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
                # see if the queue has been removed
                if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
                    # delete the queues rrd
                    unlink "$rrddir/$machine/$hash\_$i.rrd";
                    # are there any other rrd's left on this queue? if not, cleanup.
                    # get a list of any that may be still there..
                    opendir(DIR, "$rrddir/$machine");
                    my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
                    closedir DIR;
                    # count them (+1 because an empty array is size -1)
                    my($rrdcount) = $#rrdcountfiles + 1;
                    if($rrdcount == 0) {
                        # clean up the def file and any images
                        unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
                    }
                    ++$i;
                    next;
                }
                # the &updaterrd will also do this check, but we want
                # to write our def file out first
                if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
                    open(DEF, ">$rrddir/$machine/$hash.def");
                    print DEF $name;
                    close DEF;
                }
                my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
                              "packet.queue.attributes.total:total:GAUGE",
                             );
                &updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
                ++$i;
            }
        }
        else {
            #print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
        }
    }
    
    # we'll now return from this sub and reconnect
    print STDERR "Data channel socket gave no data, bailing out...\n";
}

#
# sub to update an rrd file
#
# $machine   = name of the machine
#              (eg. kernow.ukc.ac.uk)
# $type      = the type of graph for the machine
#              (eg. cpu)
# $date      = the date of the item we want to add
#              (in seconds since the epoch)
# $step      = the interval at which the database steps
#              used when we create a new rrd
# $xmlref    = reference to the xml data packet
# @data      = array containing data items to add
#              (eg. "packet.cpu.user:user:GAUGE")
#
sub updaterrd() {
    my($machine, $type, $date, $step, $xmlref, @data) = @_;
    # get hold of the xmlhash we have a reference to
    my(%xmlhash) = %$xmlref;
    # check if we need to create a new rrd
    if( ! -f "$rrddir/$machine/$type.rrd") {
        my(@createdata);
        # pull the details out of the data we've been given
        foreach my $dataitem (@data) {
            if($dataitem =~ /^\S+:(\S+):(\S+)$/) {
                push @createdata, "$1:$2";
            }
        }
        # call the &makerrd to actually create the rrd
        print "making new rrd for $rrddir/$machine/$type.rrd\n";
        &makerrd($machine, $type, $date, $step, @createdata);
    }
    # get the details out of the data we've been given
    my($updateparams) = "$date";
    foreach my $dataitem (@data) {
        if($dataitem =~ /^(\S+):\S+:\S+$/) {
            # pull the values straight out of the xmlhash
            $updateparams .= ":$xmlhash{$1}";
        }
    }
    # perform the update
    RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
    my($err) = RRDs::error;
    print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
}

#
# sub to create a new rrd file
#
# $machine = name of the machine
#            (eg. kernow.ukc.ac.uk)
# $type    = the type of graph for the machine
#            (eg. cpu)
# $start   = the date of the first item we want to add
#            (in seconds since the epoch)
# $step    = the interval at which the database steps
# @data    = the data items we want to put in the rrd
#            in the form: $dsname:dstype
#            (eg. "size:GAUGE")
#
sub makerrd() {
    my($machine, $type, $start, $step, @data) = @_;
    # check if directory exists for rrd
    if(! -d "$rrddir/$machine") {
        # not sure on this umask, but it seems to work?
        mkdir "$rrddir/$machine", 0777;
    }
    my(@rrdcmd);
    # we'll want to add our first data item at $start,
    # so we start our rrd $step before that.
    $start -= $step;
    push @rrdcmd, "$rrddir/$machine/$type.rrd";
    push @rrdcmd, "--start=$start";
    push @rrdcmd, "--step=$step";
    foreach my $dataitem (@data) {
        # dataitem should be: "dsname:dstype"
        if($dataitem =~ /^(\S+):(\S+)$/) {
            push @rrdcmd, "DS:$1:$2:600:U:U";
        }
    }
    push @rrdcmd, (
        # 3h in 15s samples
        "RRA:AVERAGE:0.5:1:720",
        "RRA:MAX:0.5:1:720",
        # 1d in 2m samples
        "RRA:AVERAGE:0.5:8:720",
        "RRA:MAX:0.5:8:720",
        # 1w in 15m samples
        "RRA:AVERAGE:0.5:60:672",
        "RRA:MAX:0.5:60:672",
        # 1m in 1hr samples
        "RRA:AVERAGE:0.5:240:744",
        "RRA:MAX:0.5:60:744",
    );
    RRDs::create (@rrdcmd);
    my($err) = RRDs::error;
    print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
}
Revision:	1.3
Committed:	Sun Mar 10 01:43:15 2002 UTC (22 years, 7 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+241 -175 lines
Log Message:	I was going to leave this till later, but I've done it anyway. This is now pretty much complete. Still a few things to consider, like cleaning up on a restart, but it's pretty much finished now.
#	Content
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;
21	use iscream::XMLParser;
22	use IO::Socket;
23	use RRDs;
24
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	# Location of RRD databases
30	my($rrddir) = "/u1/i-scream/rrd";
31
32	# for reference:
33	# ch -> hex: $hex = sprintf("%02x", ord($ch));
34	# hex -> ch: $ch = chr(hex($hex));
35
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	# 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: 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	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	close($dsock);
130
131	# wait before retrying
132	&wait_then_retry();
133	}
134
135	# we'll never reach here... unless 1 becomes false for some reason ;)
136	exit 0;
137
138
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	#
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
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, "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	# 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:GAUGE",
290	);
291	&updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
292	++$i;
293	}
294	}
295	else {
296	#print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
297	}
298	}
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
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	$updateparams .= ":$xmlhash{$1}";
342	}
343	}
344	# perform the update
345	RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
346	my($err) = RRDs::error;
347	print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
348	}
349
350	#
351	# sub to create a new rrd file
352	#
353	# $machine = name of the machine
354	# (eg. kernow.ukc.ac.uk)
355	# $type = the type of graph for the machine
356	# (eg. cpu)
357	# $start = the date of the first item we want to add
358	# (in seconds since the epoch)
359	# $step = the interval at which the database steps
360	# @data = the data items we want to put in the rrd
361	# in the form: $dsname:dstype
362	# (eg. "size:GAUGE")
363	#
364	sub makerrd() {
365	my($machine, $type, $start, $step, @data) = @_;
366	# check if directory exists for rrd
367	if(! -d "$rrddir/$machine") {
368	# not sure on this umask, but it seems to work?
369	mkdir "$rrddir/$machine", 0777;
370	}
371	my(@rrdcmd);
372	# we'll want to add our first data item at $start,
373	# so we start our rrd $step before that.
374	$start -= $step;
375	push @rrdcmd, "$rrddir/$machine/$type.rrd";
376	push @rrdcmd, "--start=$start";
377	push @rrdcmd, "--step=$step";
378	foreach my $dataitem (@data) {
379	# dataitem should be: "dsname:dstype"
380	if($dataitem =~ /^(\S+):(\S+)$/) {
381	push @rrdcmd, "DS:$1:$2:600:U:U";
382	}
383	}
384	push @rrdcmd, (
385	# 3h in 15s samples
386	"RRA:AVERAGE:0.5:1:720",
387	"RRA:MAX:0.5:1:720",
388	# 1d in 2m samples
389	"RRA:AVERAGE:0.5:8:720",
390	"RRA:MAX:0.5:8:720",
391	# 1w in 15m samples
392	"RRA:AVERAGE:0.5:60:672",
393	"RRA:MAX:0.5:60:672",
394	# 1m in 1hr samples
395	"RRA:AVERAGE:0.5:240:744",
396	"RRA:MAX:0.5:60:744",
397	);
398	RRDs::create (@rrdcmd);
399	my($err) = RRDs::error;
400	print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
401	}