ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/reports/graphing/graph.pl
Revision: 1.5
Committed: Mon Mar 11 00:25:35 2002 UTC (22 years, 2 months ago) by tdb
Content type: text/plain
Branch: MAIN
Changes since 1.4: +23 -11 lines
Log Message:
Fixed the limits of the graphs a bit better (I hope). Also made some tweaks
to the colours and layout of the graphs. They're now "blue" which fits with
the i-scream look-n-feel... but do they look ok?

File Contents

# 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 tdb 1.4 # $Author: tdb $
10     # $Id: graph.pl,v 1.3 2002/03/10 03:19:57 tdb Exp $
11 tdb 1.1 #------------------------------------------------------------
12    
13     ## TODO
14 tdb 1.4 # allow specification of lower/upper graph bounds
15     # -- then replace mem/swap/disk "total" line ;)
16 tdb 1.5 # fix mem/swap issues
17     # -- should be graphing "in use", not "free"
18 tdb 1.1 # possibly make more configurable?
19     # -- allow configurable periods of graphs
20     # -- comments, types, etc
21     # -- move all to external config file
22    
23     $| = 1;
24     use strict;
25     use RRDs;
26    
27     # Base directory for images
28     # (a directory will be constructed for each host under this)
29     my($imgdir) = "/home/tdb/public_html/rrd";
30    
31     # Location of RRD databases
32     my($rrddir) = "/u1/i-scream/rrd";
33    
34     # / converted to a decimal then hex'd
35     my($hex_slash) = "_2f";
36     # _ converted to a decimal then hex'd
37     my($hex_underscore) = "_5f";
38    
39     # Read the contents of the base directory
40     # and pull out the list of subdirectories (except . and .. :)
41     opendir(DIR, $rrddir);
42     my(@rrddirlist) = grep { -d "$rrddir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
43     closedir DIR;
44    
45     # look through each directoty, as they might
46     # contain rrds for a particular machine
47     foreach my $machine (@rrddirlist) {
48     # Read the contents of the directory
49     opendir(DIR, "$rrddir/$machine");
50     my(@rrdlist) = grep { /\.rrd$/ && -f "$rrddir/$machine/$_" } readdir(DIR);
51     closedir DIR;
52    
53     # See what rrd we have, and generate the graphs accordingly
54     foreach my $rrd (@rrdlist) {
55     chomp $rrd;
56     if($rrd =~ /^(cpu)\.rrd$/) {
57     my(@data);
58 tdb 1.5 my(@rawdata);
59 tdb 1.3 push @data, "LINE2:$1:idle:idle#00FF00:idle cpu";
60     push @data, "LINE2:$1:user:user#0000FF:user cpu";
61     push @data, "LINE2:$1:kernel:kernel#00FFFF:kernel cpu";
62     push @data, "LINE2:$1:swap:swap#FF00FF:swap cpu";
63     push @data, "LINE2:$1:iowait:iowait#FF0000:iowait cpu";
64 tdb 1.5 push @rawdata, "--upper-limit=100";
65     &makegraph($machine, $1, "CPU Usage for $machine", \@data, \@rawdata);
66 tdb 1.1 }
67     if($rrd =~ /^(mem)\.rrd$/) {
68     my(@data);
69 tdb 1.5 my(@rawdata);
70     push @data, "AREA:$1:free:free#CCCCFF:free memory";
71 tdb 1.3 push @data, "LINE2:$1:total:total#0000FF:total memory";
72 tdb 1.5 push @rawdata, "--base=1024";
73     &makegraph($machine, $1, "Memory Usage for $machine", \@data, \@rawdata);
74 tdb 1.1 }
75     if($rrd =~ /^(load)\.rrd$/) {
76     my(@data);
77 tdb 1.5 push @data, "LINE2:$1:load1:load1#CCCCFF:1 minute load average";
78     push @data, "LINE2:$1:load5:load5#7777FF:5 minute load average";
79     push @data, "LINE2:$1:load15:load15#0000FF:15 minute load average";
80 tdb 1.1 &makegraph($machine, $1, "Loads for $machine", \@data);
81     }
82     if($rrd =~ /^(proc)\.rrd$/) {
83     my(@data);
84 tdb 1.3 push @data, "LINE2:$1:cpu:cpu#00FF00:cpu processes";
85     push @data, "LINE2:$1:sleeping:sleeping#0000FF:sleeping processes";
86     push @data, "LINE2:$1:stopped:stopped#00FFFF:stopped processes";
87     push @data, "LINE2:$1:total:total#FF00FF:total processes";
88     push @data, "LINE2:$1:zombie:zombie#FF0000:zombie processes";
89 tdb 1.1 &makegraph($machine, $1, "Processes on $machine", \@data);
90     }
91     if($rrd =~ /^(swap)\.rrd$/) {
92     my(@data);
93 tdb 1.5 my(@rawdata);
94     push @data, "AREA:$1:free:free#CCCCFF:free swap";
95 tdb 1.3 push @data, "LINE2:$1:total:total#0000FF:total swap";
96 tdb 1.5 push @rawdata, "--base=1024";
97     &makegraph($machine, $1, "Swap Usage for $machine", \@data, \@rawdata);
98 tdb 1.1 }
99     if($rrd =~ /^(users)\.rrd$/) {
100     my(@data);
101 tdb 1.5 push @data, "AREA:$1:count:count#CCCCFF:user count";
102 tdb 1.1 &makegraph($machine, $1, "User Count for $machine", \@data);
103     }
104     if($rrd =~ /^(disk)-(\S+).rrd$/) {
105     my(@data);
106 tdb 1.5 my(@rawdata);
107 tdb 1.3 push @data, "LINE2:$1-$2:kbytes:kbytes#0000FF:total size";
108 tdb 1.5 push @data, "AREA:$1-$2:used:used#CCCCFF:used";
109     push @rawdata, "--base=1024";
110 tdb 1.1 my($type) = $1;
111     my($name) = $2;
112     my($nicename) = $2;
113     $nicename =~ s/$hex_slash/\//g;
114     $nicename =~ s/$hex_underscore/_/g;
115 tdb 1.5 &makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", \@data, \@rawdata);
116 tdb 1.1 }
117     # probably a queue with a name like this :)
118     if($rrd =~ /^(\d+)_0\.rrd$/) {
119     my(@data);
120     my(@rawdata);
121     my($baserrd) = $1;
122     my($i) = 0;
123     while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) {
124 tdb 1.3 push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":queue$i size ";
125 tdb 1.1 ++$i;
126     }
127 tdb 1.3 push @data, "LINE2:$baserrd\_0:total:total#FF0000:packets/sec - currently";
128 tdb 1.2 push @rawdata, "GPRINT:total:LAST:%lf %spackets/sec";
129 tdb 1.1 my($comment);
130     if(-f "$rrddir/$machine/$baserrd.def") {
131     open(DEF, "$rrddir/$machine/$baserrd.def");
132     $comment = <DEF>;
133     chomp $comment if defined $comment;
134     }
135     $comment = "unknown queue" if not defined $comment;
136     &makegraph($machine, $baserrd, $comment, \@data, \@rawdata);
137     }
138     }
139     }
140    
141     #
142     # subroutine to make some graphs
143     #
144     # $machine = name of the machine
145     # (eg. kernow.ukc.ac.uk)
146     # $type = the type of graph for the machine
147     # (eg. cpu)
148     # $title = the title for the graph
149     # (eg. kernow CPU usage)
150     # $dataref = a reference to an array containing information for the graph
151 tdb 1.3 # elements of format: "gtype:rrdname:dsname:name#colour:comment with spaces"
152 tdb 1.1 # $rawcmdref = a reference to an array containing raw rrd commands
153     # elements a single command each, no spaces
154     #
155 tdb 1.2
156 tdb 1.1 sub makegraph() {
157     my($machine, $type, $title, $dataref, $rawcmdref) = @_;
158     # pass in these arrays by reference
159     my(@data) = @$dataref if defined $dataref;
160     my(@rawcmd) = @$rawcmdref if defined $rawcmdref;
161     # check if directory exists for images
162     if(! -d "$imgdir/$machine") {
163     # not sure on this umask, but it seems to work?
164     mkdir "$imgdir/$machine", 0777;
165     }
166     my(@rrdcmd);
167     foreach my $dataitem (@data) {
168 tdb 1.3 # dataitem should be: "gtype:rrdname:dsname:name#colour:comment with spaces"
169     if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(.*)$/) {
170     push @rrdcmd, "DEF:$4=$rrddir/$machine/$2.rrd:$3:MAX";
171     push @rrdcmd, "$1:$4#$5:$6";
172 tdb 1.1 }
173     }
174     push @rrdcmd, "--title=$title";
175     push @rrdcmd, "--imgformat=PNG";
176     push @rrdcmd, "--lower-limit=0";
177 tdb 1.5 # not entirely convinced this is good...
178     push @rrdcmd, "--alt-autoscale-max";
179 tdb 1.1 # add any further raw commands
180     push @rrdcmd, @rawcmd;
181     RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
182     my($err_3h) = RRDs::error;
183 tdb 1.2 print STDERR "Error generating 3h graph for $machine/$type: $err_3h\n" if $err_3h;
184 tdb 1.1 RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
185     my($err_1d) = RRDs::error;
186 tdb 1.2 print STDERR "Error generating 1d graph for $machine/$type: $err_1d\n" if $err_1d;
187 tdb 1.1 RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
188     my($err_1w) = RRDs::error;
189 tdb 1.2 print STDERR "Error generating 1w graph for $machine/$type: $err_1w\n" if $err_1w;
190 tdb 1.1 RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
191     my($err_1m) = RRDs::error;
192 tdb 1.2 print STDERR "Error generating 1m graph for $machine/$type: $err_1m\n" if $err_1m;
193 tdb 1.1 return;
194     }
195    
196     # hacky subroutine to return a colour
197     # could be done much better somehow :/
198     sub get_colour {
199     my($col) = @_;
200     if($col == 0) {
201     return "#0000FF";
202     }
203     elsif($col == 1) {
204     return "#00FF00";
205     }
206     elsif($col == 2) {
207     return "#FF00FF";
208     }
209     elsif($col == 3) {
210     return "#FFFF00";
211     }
212     elsif($col == 4) {
213     return "#00FFFF";
214     }
215     else {
216     return "#000066";
217     }
218     }