reports/rrdgraphing/watch.pl

#!/usr/bin/perl -w

# 
# i-scream central monitoring system
# http://www.i-scream.org
# Copyright (C) 2000-2002 i-scream
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#

# -----------------------------------------------------------
# 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.8 2004/08/01 10:40:32 tdb Exp $
#------------------------------------------------------------

my($version) = '$Id: watch.pl,v 1.8 2004/08/01 10:40:32 tdb Exp $';

$| = 1;

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

# define variables that will be read from the config
# nb. keep this insync with the config file!
use vars qw{
    $imgdir $rrddir
    $maxrrdage $maximgage $deleterrds $deleteimgs
    $hex_slash $hex_underscore $hex_space $hex_colon $hex_bslash
    $rrdstep $retry_wait
    $verbose $quiet
};

# default locate of the config file
my($configfile) = "rrdgraphing.conf";

# check for command line arguments
my(%opts);
my($ret) = getopts('hvqVc:', \%opts);

# if invalid argument given, $ret will not be 1
&usage() if $ret != 1;

# first process the arguments which might mean we exit now

# -h is usage
if($opts{h}) {
    &usage();
}
# -V is version
if($opts{V}) {
    print "watch.pl version: $version\n";
    exit(1);
}

# Then try getting the config

# -c specifies the config file location
if($opts{c}) {
    $configfile = $opts{c};
}
# suck in the config
&log("reading config from $configfile\n");
do $configfile;

# Then any options we might want to override the config with

# -v is verbose
if($opts{v}) {
    $verbose = $opts{v};
}
# -q is verbose
if($opts{q}) {
    $quiet = $opts{q};
    # if we're meant to be quiet, we can hardly be verbose!
#    $verbose = 0;
}

# Finally check for required arguments

# check we still have two arguments left
if (@ARGV != 2) {
    &usage();
}

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


# Main program loop
while(1) {
    
    &log("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) {
        &error("ERROR: Could not connect control channel to $addr:$cport.\n");
        &error("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>;
    &log("CLI sent: $response");
    if ($response && $response ne "PROTOCOL 1.1\n") {
        &error("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";
    &log("we sent: rrdgraphing\n");
    $response = <$csock>;
    &log("CLI sent: $response");
    if ($response && $response ne "OK\n") {
        &error("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";
    &log("we sent: STARTDATA\n");

    # the response should be the socket to connect the data channel to
    $response = <$csock>;
    &log("CLI sent: $response");
    chomp $response;
    
    my($dport) = $response;
    &log("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) {
        &error("ERROR: Could not connect data channel to $addr:$dport.\n");
        &error("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() {
    &error("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) {
            &error("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;
                &log("created directory $rrddir/$machine\n");
            }
            
            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);
                   
            # uptime
            @data = ( "packet.os.uptime:uptime:GAUGE" );
            &updaterrd($machine, "uptime", $date, $rrdstep, \%xmlhash, @data);
                   
            # mem
            @data = ( "packet.memory.free:free:GAUGE",
                      "packet.memory.total:total:GAUGE",
                      "packet.memory.cache:cache: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);

            # paging
            @data = ( "packet.pages.pageins:pageins:GAUGE",
                      "packet.pages.pageouts:pageouts:GAUGE",
                     );
            &updaterrd($machine, "paging", $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;
                $mount =~ s/\\/$hex_bslash/g;
                $mount =~ s/ /$hex_space/g;
                $mount =~ s/:/$hex_colon/g;
                @data = ( "packet.disk.p$i.attributes.total:total:GAUGE",
                          "packet.disk.p$i.attributes.used:used:GAUGE",
                          "packet.disk.p$i.attributes.totalinodes:totalinodes:GAUGE",
                          "packet.disk.p$i.attributes.freeinodes:freeinodes:GAUGE",
                         );
                &updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
                ++$i;
            }

            # diskio
            $i = 0;
            while(defined $xmlhash{"packet.diskio.p$i.attributes.name"}) {
                my($name) = $xmlhash{"packet.diskio.p$i.attributes.name"};
                $name =~ s/_/$hex_underscore/g;
                $name =~ s/\//$hex_slash/g;
                $name =~ s/\\/$hex_bslash/g;
                $name =~ s/ /$hex_space/g;
                $name =~ s/:/$hex_colon/g;
                @data = ( "packet.diskio.p$i.attributes.rbytes:rbytes:GAUGE",
                          "packet.diskio.p$i.attributes.wbytes:wbytes:GAUGE",
                         );
                &updaterrd($machine, "diskio-$name", $date, $rrdstep, \%xmlhash, @data);
                ++$i
            }

            # net
            $i = 0;
            while(defined $xmlhash{"packet.net.p$i.attributes.name"}) {
                my($name) = $xmlhash{"packet.net.p$i.attributes.name"};
                $name =~ s/_/$hex_underscore/g;
                $name =~ s/\//$hex_slash/g;
                $name =~ s/\\/$hex_bslash/g;
                $name =~ s/ /$hex_space/g;
                $name =~ s/:/$hex_colon/g;
                @data = ( "packet.net.p$i.attributes.rx:rx:GAUGE",
                          "packet.net.p$i.attributes.tx:tx:GAUGE",
                         );
                &updaterrd($machine, "net-$name", $date, $rrdstep, \%xmlhash, @data);
                ++$i
            }

            # mailq
            $i = 0;
            while(defined $xmlhash{"packet.mailq.p$i.attributes.name"}) {
                my($name) = $xmlhash{"packet.mailq.p$i.attributes.name"};
                $name =~ s/\s+//g;
                @data = ( "packet.mailq.p$i.attributes.size:size:GAUGE",
                         );
                &updaterrd($machine, "mailq-$name", $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;
                &log("created directory $rrddir/$machine\n");
            }
            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>;
                &log("deleted $rrddir/$machine/$hash\_*.rrd $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
                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";
                    &log("deleted $rrddir/$machine/$hash\_$i.rrd\n");
                    # 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>;
                        &log("deleted $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
                    }
                    ++$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;
                    &log("created $rrddir/$machine/$hash.def\n");
                }
                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 {
            #&error("SKIPPED: valid xml, but not a data or statistics packet\n");
        }
    }
    
    # we'll now return from this sub and reconnect
    &error("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
        &log("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);
    &log("updating $rrddir/$machine/$type.rrd\n");
    my($err) = RRDs::error;
    &error("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;
        &log("created directory $rrddir/$machine\n");
    }
    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;
    &error("Error creating rrd for $rrddir/$machine/$type: $err\n") if $err;
}

# prints out usage information then exits
sub usage() {
    print "Usage: watch.pl [options] i-scream_client_interface port\n";
    print "Options\n";
    print "  -c config        Specifies the configuration file\n";
    print "                    default: rrdgraphing.conf\n";
    print "  -v               Be verbose about what's happening\n";
    print "  -q               Be quiet, even supress errors\n";
    print "  -V               Print version number\n";
    print "  -h               Prints this help page\n";
    exit(1);
}

# prints a log message if verbose is turned on
sub log() {
    my($msg) = @_;
    print $msg if $verbose;
}

# prints an error message unless quiet is turned on
sub error() {
    my($msg) = @_;
    print STDERR $msg unless $quiet;
}
Revision:	1.9
Committed:	Thu Feb 10 17:35:58 2005 UTC (19 years, 8 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
Changes since 1.8:	+23 -10 lines
Log Message:	Commit various fixes from skel (Daniel Piddock): CMS Server: - DiskMonitor was overflowing due to using an int variable for the inode count. Upped to a long. - Updated URL to iscream cms javadoc RRD graphing: - added uptime logging and graph creation - diskio - Cope with modern linux device paths (eg "ide/host0/bus0/target0/lun0/disc") by replacing / with hex - diskio - Cope with windows device paths (eg "0 C: D:") by replacing : and space with hex - disk - Cope with windows mount points (eg C:\) by replacing : and \ with hex - net - Cope with windows network "device names". Basically the whole network card as it appears in Device Manager, not "Local Area Connection" - Include total processes (for winhost) Also modified the PHP code to catch up. Patch slightly modified from that submitted, but only minor alterations. Thanks skel!
#	Content
1	#!/usr/bin/perl -w
2
3	#
4	# i-scream central monitoring system
5	# http://www.i-scream.org
6	# Copyright (C) 2000-2002 i-scream
7	#
8	# This program is free software; you can redistribute it and/or
9	# modify it under the terms of the GNU General Public License
10	# as published by the Free Software Foundation; either version 2
11	# of the License, or (at your option) any later version.
12	#
13	# This program is distributed in the hope that it will be useful,
14	# but WITHOUT ANY WARRANTY; without even the implied warranty of
15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16	# GNU General Public License for more details.
17	#
18	# You should have received a copy of the GNU General Public License
19	# along with this program; if not, write to the Free Software
20	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21	#
22
23	# -----------------------------------------------------------
24	# i-scream graph generation scripts
25	# http://www.i-scream.org
26	#
27	# Generates rrd databases for i-scream data by connecting to
28	# the i-scream server and collecting data.
29	#
30	# $Author: tdb $
31	# $Id: watch.pl,v 1.8 2004/08/01 10:40:32 tdb Exp $
32	#------------------------------------------------------------
33
34	my($version) = '$Id: watch.pl,v 1.8 2004/08/01 10:40:32 tdb Exp $';
35
36	$\| = 1;
37
38	use strict;
39	use Getopt::Std;
40	use IO::Socket;
41	use iscream::XMLParser;
42	use RRDs;
43
44	# define variables that will be read from the config
45	# nb. keep this insync with the config file!
46	use vars qw{
47	$imgdir $rrddir
48	$maxrrdage $maximgage $deleterrds $deleteimgs
49	$hex_slash $hex_underscore $hex_space $hex_colon $hex_bslash
50	$rrdstep $retry_wait
51	$verbose $quiet
52	};
53
54	# default locate of the config file
55	my($configfile) = "rrdgraphing.conf";
56
57	# check for command line arguments
58	my(%opts);
59	my($ret) = getopts('hvqVc:', \%opts);
60
61	# if invalid argument given, $ret will not be 1
62	&usage() if $ret != 1;
63
64	# first process the arguments which might mean we exit now
65
66	# -h is usage
67	if($opts{h}) {
68	&usage();
69	}
70	# -V is version
71	if($opts{V}) {
72	print "watch.pl version: $version\n";
73	exit(1);
74	}
75
76	# Then try getting the config
77
78	# -c specifies the config file location
79	if($opts{c}) {
80	$configfile = $opts{c};
81	}
82	# suck in the config
83	&log("reading config from $configfile\n");
84	do $configfile;
85
86	# Then any options we might want to override the config with
87
88	# -v is verbose
89	if($opts{v}) {
90	$verbose = $opts{v};
91	}
92	# -q is verbose
93	if($opts{q}) {
94	$quiet = $opts{q};
95	# if we're meant to be quiet, we can hardly be verbose!
96	# $verbose = 0;
97	}
98
99	# Finally check for required arguments
100
101	# check we still have two arguments left
102	if (@ARGV != 2) {
103	&usage();
104	}
105
106	# user supplied client interface server and port
107	my($addr) = $ARGV[0];
108	my($cport) = $ARGV[1];
109
110
111	# Main program loop
112	while(1) {
113
114	&log("Connecting control channel to port $cport on $addr...\n");
115
116	# attempt to connect the control channel
117	my($csock) = new IO::Socket::INET(
118	PeerAddr => $addr,
119	PeerPort => $cport,
120	Proto => 'tcp'
121	);
122
123	# if socket isn't defined connection failed
124	if (!defined $csock) {
125	&error("ERROR: Could not connect control channel to $addr:$cport.\n");
126	&error("Please check that there is an i-scream server at this address.\n");
127	&wait_then_retry();
128	next;
129	}
130
131	my($response);
132
133	# client interface should send it's protocol ID
134	# we know about "PROTOCOL 1.1", and will only accept the same
135	$response = <$csock>;
136	&log("CLI sent: $response");
137	if ($response && $response ne "PROTOCOL 1.1\n") {
138	&error("The i-scream server sent an unexpected protocol ID: $response\n");
139	close($csock);
140	&wait_then_retry();
141	next;
142	}
143
144	# send our identifier to the client interface
145	print $csock "rrdgraphing\n";
146	&log("we sent: rrdgraphing\n");
147	$response = <$csock>;
148	&log("CLI sent: $response");
149	if ($response && $response ne "OK\n") {
150	&error("Received unexpected response: $response\n");
151	close($csock);
152	&wait_then_retry();
153	next;
154	}
155
156	# tell the client interface we'd like to start the data channel
157	print $csock "STARTDATA\n";
158	&log("we sent: STARTDATA\n");
159
160	# the response should be the socket to connect the data channel to
161	$response = <$csock>;
162	&log("CLI sent: $response");
163	chomp $response;
164
165	my($dport) = $response;
166	&log("Connecting data channel to port $dport on $addr...\n");
167
168	# attempt to connect the data channel
169	my($dsock) = new IO::Socket::INET(
170	PeerAddr => $addr,
171	PeerPort => $dport,
172	Proto => 'tcp'
173	) or die "arse?";
174
175	# if socket isn't defined connection failed
176	if (!defined $dsock) {
177	&error("ERROR: Could not connect data channel to $addr:$dport.\n");
178	&error("Failure in communications.\n");
179	close($csock);
180	&wait_then_retry();
181	next;
182	}
183
184	# the data channel should now be sending us data!
185
186	# call sub to process data being received over the data channel
187	&processdata($dsock);
188
189	# data processing has stopped, close sockets
190	close($csock);
191	close($dsock);
192
193	# wait before retrying
194	&wait_then_retry();
195	}
196
197	# we'll never reach here... unless 1 becomes false for some reason ;)
198	exit 0;
199
200
201	#
202	# wait for a while before retrying
203	#
204	sub wait_then_retry() {
205	&error("Will retry connection to i-scream server in $retry_wait seconds.\n\n");
206	sleep $retry_wait;
207	}
208
209	#
210	# Given the socket of the data channel will process all
211	# the incoming XML data, creating and updating the appropriate
212	# database files.
213	#
214	# $dsock = socket connected to the data channel
215	#
216	sub processdata() {
217	# the socket connected to the data channel
218	my($dsock) = @_;
219	# save us recreating this variable each time we loop
220	my($xml);
221
222	while(1) {
223	# read data
224	$xml = <$dsock>;
225
226	# something odd has happened
227	last if not defined $xml;
228
229	# attempt to parse the data
230	my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
231	if($err) {
232	&error("Skipped, XML did not parse: $xml");
233	next;
234	}
235
236	# standard data packet
237	if($xmlhash{"packet.attributes.type"} eq "data") {
238	my($machine) = $xmlhash{"packet.attributes.machine_name"};
239	my($date) = $xmlhash{"packet.attributes.date"};
240
241	# make directory for machine
242	if(! -d "$rrddir/$machine") {
243	# not sure on this umask, but it seems to work?
244	mkdir "$rrddir/$machine", 0777;
245	&log("created directory $rrddir/$machine\n");
246	}
247
248	my(@data);
249
250	# cpu
251	@data = ( "packet.cpu.idle:idle:GAUGE",
252	"packet.cpu.user:user:GAUGE",
253	"packet.cpu.kernel:kernel:GAUGE",
254	"packet.cpu.swap:swap:GAUGE",
255	"packet.cpu.iowait:iowait:GAUGE",
256	);
257	&updaterrd($machine, "cpu", $date, $rrdstep, \%xmlhash, @data);
258
259	# uptime
260	@data = ( "packet.os.uptime:uptime:GAUGE" );
261	&updaterrd($machine, "uptime", $date, $rrdstep, \%xmlhash, @data);
262
263	# mem
264	@data = ( "packet.memory.free:free:GAUGE",
265	"packet.memory.total:total:GAUGE",
266	"packet.memory.cache:cache:GAUGE",
267	);
268	&updaterrd($machine, "mem", $date, $rrdstep, \%xmlhash, @data);
269
270	# load
271	@data = ( "packet.load.load1:load1:GAUGE",
272	"packet.load.load5:load5:GAUGE",
273	"packet.load.load15:load15:GAUGE",
274	);
275	&updaterrd($machine, "load", $date, $rrdstep, \%xmlhash, @data);
276
277	# processes
278	@data = ( "packet.processes.cpu:cpu:GAUGE",
279	"packet.processes.sleeping:sleeping:GAUGE",
280	"packet.processes.stopped:stopped:GAUGE",
281	"packet.processes.total:total:GAUGE",
282	"packet.processes.zombie:zombie:GAUGE",
283	);
284	&updaterrd($machine, "proc", $date, $rrdstep, \%xmlhash, @data);
285
286	# swap
287	@data = ( "packet.swap.free:free:GAUGE",
288	"packet.swap.total:total:GAUGE",
289	);
290	&updaterrd($machine, "swap", $date, $rrdstep, \%xmlhash, @data);
291
292	# users
293	@data = ( "packet.users.count:count:GAUGE",
294	);
295	&updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
296
297	# paging
298	@data = ( "packet.pages.pageins:pageins:GAUGE",
299	"packet.pages.pageouts:pageouts:GAUGE",
300	);
301	&updaterrd($machine, "paging", $date, $rrdstep, \%xmlhash, @data);
302
303	# disk
304	my($i) = 0;
305	while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
306	my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
307	$mount =~ s/_/$hex_underscore/g;
308	$mount =~ s/\//$hex_slash/g;
309	$mount =~ s/\\/$hex_bslash/g;
310	$mount =~ s/ /$hex_space/g;
311	$mount =~ s/:/$hex_colon/g;
312	@data = ( "packet.disk.p$i.attributes.total:total:GAUGE",
313	"packet.disk.p$i.attributes.used:used:GAUGE",
314	"packet.disk.p$i.attributes.totalinodes:totalinodes:GAUGE",
315	"packet.disk.p$i.attributes.freeinodes:freeinodes:GAUGE",
316	);
317	&updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
318	++$i;
319	}
320
321	# diskio
322	$i = 0;
323	while(defined $xmlhash{"packet.diskio.p$i.attributes.name"}) {
324	my($name) = $xmlhash{"packet.diskio.p$i.attributes.name"};
325	$name =~ s/_/$hex_underscore/g;
326	$name =~ s/\//$hex_slash/g;
327	$name =~ s/\\/$hex_bslash/g;
328	$name =~ s/ /$hex_space/g;
329	$name =~ s/:/$hex_colon/g;
330	@data = ( "packet.diskio.p$i.attributes.rbytes:rbytes:GAUGE",
331	"packet.diskio.p$i.attributes.wbytes:wbytes:GAUGE",
332	);
333	&updaterrd($machine, "diskio-$name", $date, $rrdstep, \%xmlhash, @data);
334	++$i
335	}
336
337	# net
338	$i = 0;
339	while(defined $xmlhash{"packet.net.p$i.attributes.name"}) {
340	my($name) = $xmlhash{"packet.net.p$i.attributes.name"};
341	$name =~ s/_/$hex_underscore/g;
342	$name =~ s/\//$hex_slash/g;
343	$name =~ s/\\/$hex_bslash/g;
344	$name =~ s/ /$hex_space/g;
345	$name =~ s/:/$hex_colon/g;
346	@data = ( "packet.net.p$i.attributes.rx:rx:GAUGE",
347	"packet.net.p$i.attributes.tx:tx:GAUGE",
348	);
349	&updaterrd($machine, "net-$name", $date, $rrdstep, \%xmlhash, @data);
350	++$i
351	}
352
353	# mailq
354	$i = 0;
355	while(defined $xmlhash{"packet.mailq.p$i.attributes.name"}) {
356	my($name) = $xmlhash{"packet.mailq.p$i.attributes.name"};
357	$name =~ s/\s+//g;
358	@data = ( "packet.mailq.p$i.attributes.size:size:GAUGE",
359	);
360	&updaterrd($machine, "mailq-$name", $date, $rrdstep, \%xmlhash, @data);
361	++$i
362	}
363	}
364
365	# queue statistics packet
366	elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
367	# psuedo machine for internal server stuff
368	my($machine) = "i-scream-server";
369	# make directory
370	if(! -d "$rrddir/$machine") {
371	# not sure on this umask, but it seems to work?
372	mkdir "$rrddir/$machine", 0777;
373	&log("created directory $rrddir/$machine\n");
374	}
375	my($hash) = $xmlhash{"packet.attributes.hashCode"};
376	my($date) = $xmlhash{"packet.attributes.date"};
377	my($name) = $xmlhash{"packet.attributes.name"};
378	# take a look to see if we have a shutdown packet...
379	if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
380	unlink <$rrddir/$machine/$hash\_.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash.png>;
381	&log("deleted $rrddir/$machine/$hash\_.rrd $rrddir/$machine/$hash.def $imgdir/$machine/$hash.png\n");
382	next;
383	}
384	# look through to see how many internal queues we have
385	my($i) = 0;
386	while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
387	# see if the queue has been removed
388	if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
389	# delete the queues rrd
390	unlink "$rrddir/$machine/$hash\_$i.rrd";
391	&log("deleted $rrddir/$machine/$hash\_$i.rrd\n");
392	# are there any other rrd's left on this queue? if not, cleanup.
393	# get a list of any that may be still there..
394	opendir(DIR, "$rrddir/$machine");
395	my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
396	closedir DIR;
397	# count them (+1 because an empty array is size -1)
398	my($rrdcount) = $#rrdcountfiles + 1;
399	if($rrdcount == 0) {
400	# clean up the def file and any images
401	unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
402	&log("deleted $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
403	}
404	++$i;
405	next;
406	}
407	# the &updaterrd will also do this check, but we want
408	# to write our def file out first
409	if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
410	open(DEF, ">$rrddir/$machine/$hash.def");
411	print DEF $name;
412	close DEF;
413	&log("created $rrddir/$machine/$hash.def\n");
414	}
415	my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
416	"packet.queue.attributes.total:total:COUNTER",
417	);
418	&updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
419	++$i;
420	}
421	}
422	else {
423	#&error("SKIPPED: valid xml, but not a data or statistics packet\n");
424	}
425	}
426
427	# we'll now return from this sub and reconnect
428	&error("Data channel socket gave no data, bailing out...\n");
429	}
430
431	#
432	# sub to update an rrd file
433	#
434	# $machine = name of the machine
435	# (eg. kernow.ukc.ac.uk)
436	# $type = the type of graph for the machine
437	# (eg. cpu)
438	# $date = the date of the item we want to add
439	# (in seconds since the epoch)
440	# $step = the interval at which the database steps
441	# used when we create a new rrd
442	# $xmlref = reference to the xml data packet
443	# @data = array containing data items to add
444	# (eg. "packet.cpu.user:user:GAUGE")
445	#
446	sub updaterrd() {
447	my($machine, $type, $date, $step, $xmlref, @data) = @_;
448	# get hold of the xmlhash we have a reference to
449	my(%xmlhash) = %$xmlref;
450	# check if we need to create a new rrd
451	if( ! -f "$rrddir/$machine/$type.rrd") {
452	my(@createdata);
453	# pull the details out of the data we've been given
454	foreach my $dataitem (@data) {
455	if($dataitem =~ /^\S+:(\S+):(\S+)$/) {
456	push @createdata, "$1:$2";
457	}
458	}
459	# call the &makerrd to actually create the rrd
460	&log("making new rrd for $rrddir/$machine/$type.rrd\n");
461	&makerrd($machine, $type, $date, $step, @createdata);
462	}
463	# get the details out of the data we've been given
464	my($updateparams) = "$date";
465	foreach my $dataitem (@data) {
466	if($dataitem =~ /^(\S+):\S+:\S+$/) {
467	# pull the values straight out of the xmlhash
468	my($value) = $xmlhash{$1};
469	# if it's undefined we'll set it to 0
470	# this probably shouldn't happen, but it'd be best to handle it "nicely" :)
471	$value = "0" if not defined $value;
472	$updateparams .= ":$value";
473	}
474	}
475	# perform the update
476	RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
477	&log("updating $rrddir/$machine/$type.rrd\n");
478	my($err) = RRDs::error;
479	&error("Error updating $rrddir/$machine/$type.rrd: $err\n") if $err;
480	}
481
482	#
483	# sub to create a new rrd file
484	#
485	# $machine = name of the machine
486	# (eg. kernow.ukc.ac.uk)
487	# $type = the type of graph for the machine
488	# (eg. cpu)
489	# $start = the date of the first item we want to add
490	# (in seconds since the epoch)
491	# $step = the interval at which the database steps
492	# @data = the data items we want to put in the rrd
493	# in the form: $dsname:dstype
494	# (eg. "size:GAUGE")
495	#
496	sub makerrd() {
497	my($machine, $type, $start, $step, @data) = @_;
498	# check if directory exists for rrd
499	if(! -d "$rrddir/$machine") {
500	# not sure on this umask, but it seems to work?
501	mkdir "$rrddir/$machine", 0777;
502	&log("created directory $rrddir/$machine\n");
503	}
504	my(@rrdcmd);
505	# we'll want to add our first data item at $start,
506	# so we start our rrd $step before that.
507	$start -= $step;
508	push @rrdcmd, "$rrddir/$machine/$type.rrd";
509	push @rrdcmd, "--start=$start";
510	push @rrdcmd, "--step=$step";
511	foreach my $dataitem (@data) {
512	# dataitem should be: "dsname:dstype"
513	if($dataitem =~ /^(\S+):(\S+)$/) {
514	push @rrdcmd, "DS:$1:$2:600:U:U";
515	}
516	}
517	push @rrdcmd, (
518	# 3h in 15s samples
519	"RRA:AVERAGE:0.5:1:720",
520	"RRA:MAX:0.5:1:720",
521	# 1d in 2m samples
522	"RRA:AVERAGE:0.5:8:720",
523	"RRA:MAX:0.5:8:720",
524	# 1w in 15m samples
525	"RRA:AVERAGE:0.5:60:672",
526	"RRA:MAX:0.5:60:672",
527	# 1m in 1hr samples
528	"RRA:AVERAGE:0.5:240:744",
529	"RRA:MAX:0.5:240:744",
530	# 1y in 12hr samples
531	"RRA:AVERAGE:0.5:2880:730",
532	"RRA:MAX:0.5:2880:730",
533	);
534	RRDs::create (@rrdcmd);
535	my($err) = RRDs::error;
536	&error("Error creating rrd for $rrddir/$machine/$type: $err\n") if $err;
537	}
538
539	# prints out usage information then exits
540	sub usage() {
541	print "Usage: watch.pl [options] i-scream_client_interface port\n";
542	print "Options\n";
543	print " -c config Specifies the configuration file\n";
544	print " default: rrdgraphing.conf\n";
545	print " -v Be verbose about what's happening\n";
546	print " -q Be quiet, even supress errors\n";
547	print " -V Print version number\n";
548	print " -h Prints this help page\n";
549	exit(1);
550	}
551
552	# prints a log message if verbose is turned on
553	sub log() {
554	my($msg) = @_;
555	print $msg if $verbose;
556	}
557
558	# prints an error message unless quiet is turned on
559	sub error() {
560	my($msg) = @_;
561	print STDERR $msg unless $quiet;
562	}