reports/graphing/graph.pl

#!/usr/bin/perl -w

# -----------------------------------------------------------
# i-scream graph generation script
# http://www.i-scream.org.uk
#
# Generates graphs from rrd databases for i-scream data.
#
# $Author$
# $Id$
#------------------------------------------------------------

## TODO
# possibly make more configurable?
#  -- allow configurable periods of graphs
#  -- comments, types, etc
#  -- move all to external config file

$| = 1;
use strict;
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";

# / converted to a decimal then hex'd
my($hex_slash) = "_2f";
# _ converted to a decimal then hex'd
my($hex_underscore) = "_5f";
        
# Read the contents of the base directory
# and pull out the list of subdirectories (except . and .. :)
opendir(DIR, $rrddir);
my(@rrddirlist) = grep { -d "$rrddir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
closedir DIR;

# look through each directoty, as they might
# contain rrds for a particular machine
foreach my $machine (@rrddirlist) {
    # Read the contents of the directory
    opendir(DIR, "$rrddir/$machine");
    my(@rrdlist) = grep { /\.rrd$/ && -f "$rrddir/$machine/$_" } readdir(DIR);
    closedir DIR;
    
    # See what rrd we have, and generate the graphs accordingly
    foreach my $rrd (@rrdlist) {
        chomp $rrd;
        if($rrd =~ /^(cpu)\.rrd$/) {
            my(@data);
            push @data, "LINE2:$1:idle#00FF00:idle cpu";
            push @data, "LINE2:$1:user#0000FF:user cpu";
            push @data, "LINE2:$1:kernel#00FFFF:kernel cpu";
            push @data, "LINE2:$1:swap#FF00FF:swap cpu";
            push @data, "LINE2:$1:iowait#FF0000:iowait cpu";
            &makegraph($machine, $1, "CPU Usage for $machine", \@data);
        }
        if($rrd =~ /^(mem)\.rrd$/) {
            my(@data);
            push @data, "LINE2:$1:free#00FF00:free memory";
            push @data, "LINE2:$1:total#0000FF:total memory";
            &makegraph($machine, $1, "Memory Usage for $machine", \@data);
        }
        if($rrd =~ /^(load)\.rrd$/) {
            my(@data);
            push @data, "LINE2:$1:load1#00FF00:1 minute load average";
            push @data, "LINE2:$1:load5#0000FF:5 minute load average";
            push @data, "LINE2:$1:load15#FF0000:15 minute load average";
            &makegraph($machine, $1, "Loads for $machine", \@data);
        }
        if($rrd =~ /^(proc)\.rrd$/) {
            my(@data);
            push @data, "LINE2:$1:cpu#00FF00:cpu processes";
            push @data, "LINE2:$1:sleeping#0000FF:sleeping processes";
            push @data, "LINE2:$1:stopped#00FFFF:stopped processes";
            push @data, "LINE2:$1:total#FF00FF:total processes";
            push @data, "LINE2:$1:zombie#FF0000:zombie processes";
            &makegraph($machine, $1, "Processes on $machine", \@data);
        }
        if($rrd =~ /^(swap)\.rrd$/) {
            my(@data);
            push @data, "LINE2:$1:free#00FF00:free swap";
            push @data, "LINE2:$1:total#0000FF:total swap";
            &makegraph($machine, $1, "Swap Usage for $machine", \@data);
        }
        if($rrd =~ /^(users)\.rrd$/) {
            my(@data);
            push @data, "LINE2:$1:count#00FF00:user count";
            &makegraph($machine, $1, "User Count for $machine", \@data);
        }
        if($rrd =~ /^(disk)-(\S+).rrd$/) {
            my(@data);
            push @data, "LINE2:$1-$2:kbytes#0000FF:total size";
            push @data, "LINE2:$1-$2:used#00FF00:used";
            my($type) = $1;
            my($name) = $2;
            my($nicename) = $2;
            $nicename =~ s/$hex_slash/\//g;
            $nicename =~ s/$hex_underscore/_/g;
            &makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", \@data);
        }
        # probably a queue with a name like this :)
        if($rrd =~ /^(\d+)_0\.rrd$/) {
            my(@data);
            my(@rawdata);
            my($baserrd) = $1;
            my($i) = 0;
            while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) {
                push @data, "LINE2:$baserrd\_$i:size" . &get_colour($i) . ":queue$i size ";
                ++$i;
            }
            push @data, "LINE2:$baserrd\_0:total#FF0000:packets/sec - currently";
            push @rawdata, "GPRINT:total:LAST:\"%lf %spackets/sec\"";
            my($comment);
            if(-f "$rrddir/$machine/$baserrd.def") {
                open(DEF, "$rrddir/$machine/$baserrd.def");
                $comment = <DEF>;
                chomp $comment if defined $comment;
            }
            $comment = "unknown queue" if not defined $comment;
            &makegraph($machine, $baserrd, $comment, \@data, \@rawdata);
        }
    }
}

#
# subroutine to make some graphs
#
# $machine   = name of the machine
#              (eg. kernow.ukc.ac.uk)
# $type      = the type of graph for the machine
#              (eg. cpu)
# $title     = the title for the graph
#              (eg. kernow CPU usage)
# $dataref   = a reference to an array containing information for the graph
#              elements of format: "gtype:rrdname:name#colour:comment with spaces"
# $rawcmdref = a reference to an array containing raw rrd commands
#              elements a single command each, no spaces
#
sub makegraph() {
    my($machine, $type, $title, $dataref, $rawcmdref) = @_;
    # pass in these arrays by reference
    my(@data) = @$dataref if defined $dataref;
    my(@rawcmd) = @$rawcmdref if defined $rawcmdref;
    # check if directory exists for images
    if(! -d "$imgdir/$machine") {
        # not sure on this umask, but it seems to work?
        mkdir "$imgdir/$machine", 0777;
    }
    my(@rrdcmd);
    foreach my $dataitem (@data) {
        # dataitem should be: "gtype:rrdname:name#colour:comment with spaces"
        if($dataitem =~ /^(\S+):(\S+):(\S+)#(.{6}):(.*)$/) {
            push @rrdcmd, "DEF:$3=$rrddir/$machine/$2.rrd:$3:MAX";
            push @rrdcmd, "$1:$3#$4:$5";
        }
    }
    push @rrdcmd, "--title=$title";
    push @rrdcmd, "--imgformat=PNG";
    push @rrdcmd, "--lower-limit=0";
    # add any further raw commands
    push @rrdcmd, @rawcmd;
    RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
    my($err_3h) = RRDs::error;
    print STDERR "Error generating 3h graph for $machine\_$type: $err_3h\n" if $err_3h;
    RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
    my($err_1d) = RRDs::error;
    print STDERR "Error generating 1d graph for $machine\_$type: $err_1d\n" if $err_1d;
    RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
    my($err_1w) = RRDs::error;
    print STDERR "Error generating 1w graph for $machine\_$type: $err_1w\n" if $err_1w;
    RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
    my($err_1m) = RRDs::error;
    print STDERR "Error generating 1m graph for $machine\_$type: $err_1m\n" if $err_1m;
    return;
}

# hacky subroutine to return a colour
# could be done much better somehow :/
sub get_colour {
    my($col) = @_;
    if($col == 0) {
        return "#0000FF";
    }
    elsif($col == 1) {
        return "#00FF00";
    }
    elsif($col == 2) {
        return "#FF00FF";
    }
    elsif($col == 3) {
        return "#FFFF00";
    }
    elsif($col == 4) {
        return "#00FFFF";
    }
    else {
        return "#000066";
    }
}
Revision:	1.1
Committed:	Sat Mar 9 19:53:24 2002 UTC (22 years, 8 months ago) by tdb
Content type:	text/plain
Branch:	MAIN
Log Message:	Graphing of most of the i-scream data. This is intended as an alternative to the current MySQL/DBReporter style of daily graph generation. This is split into two sections: watch.pl connects to the i-scream client interface, parses all the data and stores it in rrdtool database files. This is still very incomplete and somewhat messy code :) graph.pl generates graphs from the rrdtool database files created by the previous script. It drops these images into a directory structure for viewing over the web. The php pages provide an easy way to view these graphs during development, but it is expected in the long term to integrate this into the i-scream reports pages. Finally XMLParser.pm is a wrapper to the XML parsing to create i-scream style XMLPacket hashes :)
#	User	Rev	Content
1	tdb	1.1	#!/usr/bin/perl -w
2
3			# -----------------------------------------------------------
4			# i-scream graph generation script
5			# http://www.i-scream.org.uk
6			#
7			# Generates graphs from rrd databases for i-scream data.
8			#
9			# $Author$
10			# $Id$
11			#------------------------------------------------------------
12
13			## TODO
14			# possibly make more configurable?
15			# -- allow configurable periods of graphs
16			# -- comments, types, etc
17			# -- move all to external config file
18
19			$\| = 1;
20			use strict;
21			use RRDs;
22
23			# Base directory for images
24			# (a directory will be constructed for each host under this)
25			my($imgdir) = "/home/tdb/public_html/rrd";
26
27			# Location of RRD databases
28			my($rrddir) = "/u1/i-scream/rrd";
29
30			# / converted to a decimal then hex'd
31			my($hex_slash) = "_2f";
32			# _ converted to a decimal then hex'd
33			my($hex_underscore) = "_5f";
34
35			# Read the contents of the base directory
36			# and pull out the list of subdirectories (except . and .. :)
37			opendir(DIR, $rrddir);
38			my(@rrddirlist) = grep { -d "$rrddir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
39			closedir DIR;
40
41			# look through each directoty, as they might
42			# contain rrds for a particular machine
43			foreach my $machine (@rrddirlist) {
44			# Read the contents of the directory
45			opendir(DIR, "$rrddir/$machine");
46			my(@rrdlist) = grep { /\.rrd$/ && -f "$rrddir/$machine/$_" } readdir(DIR);
47			closedir DIR;
48
49			# See what rrd we have, and generate the graphs accordingly
50			foreach my $rrd (@rrdlist) {
51			chomp $rrd;
52			if($rrd =~ /^(cpu)\.rrd$/) {
53			my(@data);
54			push @data, "LINE2:$1:idle#00FF00:idle cpu";
55			push @data, "LINE2:$1:user#0000FF:user cpu";
56			push @data, "LINE2:$1:kernel#00FFFF:kernel cpu";
57			push @data, "LINE2:$1:swap#FF00FF:swap cpu";
58			push @data, "LINE2:$1:iowait#FF0000:iowait cpu";
59			&makegraph($machine, $1, "CPU Usage for $machine", \@data);
60			}
61			if($rrd =~ /^(mem)\.rrd$/) {
62			my(@data);
63			push @data, "LINE2:$1:free#00FF00:free memory";
64			push @data, "LINE2:$1:total#0000FF:total memory";
65			&makegraph($machine, $1, "Memory Usage for $machine", \@data);
66			}
67			if($rrd =~ /^(load)\.rrd$/) {
68			my(@data);
69			push @data, "LINE2:$1:load1#00FF00:1 minute load average";
70			push @data, "LINE2:$1:load5#0000FF:5 minute load average";
71			push @data, "LINE2:$1:load15#FF0000:15 minute load average";
72			&makegraph($machine, $1, "Loads for $machine", \@data);
73			}
74			if($rrd =~ /^(proc)\.rrd$/) {
75			my(@data);
76			push @data, "LINE2:$1:cpu#00FF00:cpu processes";
77			push @data, "LINE2:$1:sleeping#0000FF:sleeping processes";
78			push @data, "LINE2:$1:stopped#00FFFF:stopped processes";
79			push @data, "LINE2:$1:total#FF00FF:total processes";
80			push @data, "LINE2:$1:zombie#FF0000:zombie processes";
81			&makegraph($machine, $1, "Processes on $machine", \@data);
82			}
83			if($rrd =~ /^(swap)\.rrd$/) {
84			my(@data);
85			push @data, "LINE2:$1:free#00FF00:free swap";
86			push @data, "LINE2:$1:total#0000FF:total swap";
87			&makegraph($machine, $1, "Swap Usage for $machine", \@data);
88			}
89			if($rrd =~ /^(users)\.rrd$/) {
90			my(@data);
91			push @data, "LINE2:$1:count#00FF00:user count";
92			&makegraph($machine, $1, "User Count for $machine", \@data);
93			}
94			if($rrd =~ /^(disk)-(\S+).rrd$/) {
95			my(@data);
96			push @data, "LINE2:$1-$2:kbytes#0000FF:total size";
97			push @data, "LINE2:$1-$2:used#00FF00:used";
98			my($type) = $1;
99			my($name) = $2;
100			my($nicename) = $2;
101			$nicename =~ s/$hex_slash/\//g;
102			$nicename =~ s/$hex_underscore/_/g;
103			&makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", \@data);
104			}
105			# probably a queue with a name like this :)
106			if($rrd =~ /^(\d+)_0\.rrd$/) {
107			my(@data);
108			my(@rawdata);
109			my($baserrd) = $1;
110			my($i) = 0;
111			while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) {
112			push @data, "LINE2:$baserrd\_$i:size" . &get_colour($i) . ":queue$i size ";
113			++$i;
114			}
115			push @data, "LINE2:$baserrd\_0:total#FF0000:packets/sec - currently";
116			push @rawdata, "GPRINT:total:LAST:\"%lf %spackets/sec\"";
117			my($comment);
118			if(-f "$rrddir/$machine/$baserrd.def") {
119			open(DEF, "$rrddir/$machine/$baserrd.def");
120			$comment = <DEF>;
121			chomp $comment if defined $comment;
122			}
123			$comment = "unknown queue" if not defined $comment;
124			&makegraph($machine, $baserrd, $comment, \@data, \@rawdata);
125			}
126			}
127			}
128
129			#
130			# subroutine to make some graphs
131			#
132			# $machine = name of the machine
133			# (eg. kernow.ukc.ac.uk)
134			# $type = the type of graph for the machine
135			# (eg. cpu)
136			# $title = the title for the graph
137			# (eg. kernow CPU usage)
138			# $dataref = a reference to an array containing information for the graph
139			# elements of format: "gtype:rrdname:name#colour:comment with spaces"
140			# $rawcmdref = a reference to an array containing raw rrd commands
141			# elements a single command each, no spaces
142			#
143			sub makegraph() {
144			my($machine, $type, $title, $dataref, $rawcmdref) = @_;
145			# pass in these arrays by reference
146			my(@data) = @$dataref if defined $dataref;
147			my(@rawcmd) = @$rawcmdref if defined $rawcmdref;
148			# check if directory exists for images
149			if(! -d "$imgdir/$machine") {
150			# not sure on this umask, but it seems to work?
151			mkdir "$imgdir/$machine", 0777;
152			}
153			my(@rrdcmd);
154			foreach my $dataitem (@data) {
155			# dataitem should be: "gtype:rrdname:name#colour:comment with spaces"
156			if($dataitem =~ /^(\S+):(\S+):(\S+)#(.{6}):(.*)$/) {
157			push @rrdcmd, "DEF:$3=$rrddir/$machine/$2.rrd:$3:MAX";
158			push @rrdcmd, "$1:$3#$4:$5";
159			}
160			}
161			push @rrdcmd, "--title=$title";
162			push @rrdcmd, "--imgformat=PNG";
163			push @rrdcmd, "--lower-limit=0";
164			# add any further raw commands
165			push @rrdcmd, @rawcmd;
166			RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
167			my($err_3h) = RRDs::error;
168			print STDERR "Error generating 3h graph for $machine\_$type: $err_3h\n" if $err_3h;
169			RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
170			my($err_1d) = RRDs::error;
171			print STDERR "Error generating 1d graph for $machine\_$type: $err_1d\n" if $err_1d;
172			RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
173			my($err_1w) = RRDs::error;
174			print STDERR "Error generating 1w graph for $machine\_$type: $err_1w\n" if $err_1w;
175			RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
176			my($err_1m) = RRDs::error;
177			print STDERR "Error generating 1m graph for $machine\_$type: $err_1m\n" if $err_1m;
178			return;
179			}
180
181			# hacky subroutine to return a colour
182			# could be done much better somehow :/
183			sub get_colour {
184			my($col) = @_;
185			if($col == 0) {
186			return "#0000FF";
187			}
188			elsif($col == 1) {
189			return "#00FF00";
190			}
191			elsif($col == 2) {
192			return "#FF00FF";
193			}
194			elsif($col == 3) {
195			return "#FFFF00";
196			}
197			elsif($col == 4) {
198			return "#00FFFF";
199			}
200			else {
201			return "#000066";
202			}
203			}