reports/graphing/watch.pl

#!/usr/bin/perl -w

# -----------------------------------------------------------
# i-scream graph generation scripts
# http://www.i-scream.org
#
# Generates rrd databases for i-scream data by connecting to
# the i-scream server and collecting data.
#
# $Author: tdb $
# $Id: watch.pl,v 1.6 2002/03/13 20:50:48 tdb Exp $
#------------------------------------------------------------

## 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:COUNTER",
                             );
                &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
            my($value) = $xmlhash{$1};
            # if it's undefined we'll set it to 0
            # this probably shouldn't happen, but it'd be best to handle it "nicely" :)
            $value = "0" if not defined $value;
            $updateparams .= ":$value";
        }
    }
    # 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:240:744",
        # 1y in 12hr samples
        "RRA:AVERAGE:0.5:2880:730",
        "RRA:MAX:0.5:2880:730",
    );
    RRDs::create (@rrdcmd);
    my($err) = RRDs::error;
    print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
}
Revision:	1.7
Committed:	Sun Aug 1 10:39:49 2004 UTC (19 years, 9 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.6:	+2 -2 lines
Log Message:	Catch a lot of old URL's and update them. Also remove a couple of old files that aren't used.
#	User	Rev	Content
1	tdb	1.1	#!/usr/bin/perl -w
2
3	tdb	1.2	# -----------------------------------------------------------
4			# i-scream graph generation scripts
5	tdb	1.7	# http://www.i-scream.org
6	tdb	1.2	#
7			# Generates rrd databases for i-scream data by connecting to
8			# the i-scream server and collecting data.
9			#
10	tdb	1.5	# $Author: tdb $
11	tdb	1.7	# $Id: watch.pl,v 1.6 2002/03/13 20:50:48 tdb Exp $
12	tdb	1.2	#------------------------------------------------------------
13
14	tdb	1.3	## TODO
15			# ought to think about cleaning up when we restart?
16			# -- old queue data etc
17
18	tdb	1.1	$\| = 1;
19
20			use strict;
21			use iscream::XMLParser;
22			use IO::Socket;
23			use RRDs;
24
25	tdb	1.2	# 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	tdb	1.3	# 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	tdb	1.1	if (@ARGV != 2) {
48	tdb	1.3	die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
49	tdb	1.1	}
50
51	tdb	1.3	# user supplied client interface server and port
52	tdb	1.1	my($addr) = $ARGV[0];
53			my($cport) = $ARGV[1];
54
55	tdb	1.3	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	tdb	1.1	close($csock);
129	tdb	1.3	close($dsock);
130
131			# wait before retrying
132			&wait_then_retry();
133	tdb	1.1	}
134
135	tdb	1.3	# we'll never reach here... unless 1 becomes false for some reason ;)
136			exit 0;
137	tdb	1.1
138
139	tdb	1.3	#
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	tdb	1.1	}
146
147	tdb	1.3	#
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	tdb	1.2
160	tdb	1.3	while(1) {
161			# read data
162			$xml = <$dsock>;
163
164			# something odd has happened
165			last if not defined $xml;
166	tdb	1.2
167	tdb	1.3	# 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	tdb	1.1	}
173	tdb	1.2
174	tdb	1.3	# 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	tdb	1.2	);
227	tdb	1.3	&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	tdb	1.1	}
242	tdb	1.3
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	tdb	1.1	}
288	tdb	1.3	my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
289	tdb	1.4	"packet.queue.attributes.total:total:COUNTER",
290	tdb	1.3	);
291			&updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
292	tdb	1.2	++$i;
293	tdb	1.1	}
294	tdb	1.3	}
295			else {
296			#print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
297	tdb	1.1	}
298			}
299	tdb	1.3
300			# we'll now return from this sub and reconnect
301			print STDERR "Data channel socket gave no data, bailing out...\n";
302	tdb	1.1	}
303
304	tdb	1.2	#
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	tdb	1.5	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	tdb	1.2	}
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			#
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	tdb	1.6	"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	tdb	1.2	);
405			RRDs::create (@rrdcmd);
406			my($err) = RRDs::error;
407			print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
408	tdb	1.1	}