ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/reports/graphing/graph.pl
Revision: 1.2
Committed: Sun Mar 10 03:07:08 2002 UTC (22 years, 2 months ago) by tdb
Content type: text/plain
Branch: MAIN
Changes since 1.1: +7 -6 lines
Log Message:
Minor bug fixes.

File Contents

# Content
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$i" . &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
144 sub makegraph() {
145 my($machine, $type, $title, $dataref, $rawcmdref) = @_;
146 # pass in these arrays by reference
147 my(@data) = @$dataref if defined $dataref;
148 my(@rawcmd) = @$rawcmdref if defined $rawcmdref;
149 # check if directory exists for images
150 if(! -d "$imgdir/$machine") {
151 # not sure on this umask, but it seems to work?
152 mkdir "$imgdir/$machine", 0777;
153 }
154 my(@rrdcmd);
155 foreach my $dataitem (@data) {
156 # dataitem should be: "gtype:rrdname:name#colour:comment with spaces"
157 if($dataitem =~ /^(\S+):(\S+):(\S+)#(.{6}):(.*)$/) {
158 push @rrdcmd, "DEF:$3=$rrddir/$machine/$2.rrd:$3:MAX";
159 push @rrdcmd, "$1:$3#$4:$5";
160 }
161 }
162 push @rrdcmd, "--title=$title";
163 push @rrdcmd, "--imgformat=PNG";
164 push @rrdcmd, "--lower-limit=0";
165 # add any further raw commands
166 push @rrdcmd, @rawcmd;
167 RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
168 my($err_3h) = RRDs::error;
169 print STDERR "Error generating 3h graph for $machine/$type: $err_3h\n" if $err_3h;
170 RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
171 my($err_1d) = RRDs::error;
172 print STDERR "Error generating 1d graph for $machine/$type: $err_1d\n" if $err_1d;
173 RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
174 my($err_1w) = RRDs::error;
175 print STDERR "Error generating 1w graph for $machine/$type: $err_1w\n" if $err_1w;
176 RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
177 my($err_1m) = RRDs::error;
178 print STDERR "Error generating 1m graph for $machine/$type: $err_1m\n" if $err_1m;
179 return;
180 }
181
182 # hacky subroutine to return a colour
183 # could be done much better somehow :/
184 sub get_colour {
185 my($col) = @_;
186 if($col == 0) {
187 return "#0000FF";
188 }
189 elsif($col == 1) {
190 return "#00FF00";
191 }
192 elsif($col == 2) {
193 return "#FF00FF";
194 }
195 elsif($col == 3) {
196 return "#FFFF00";
197 }
198 elsif($col == 4) {
199 return "#00FFFF";
200 }
201 else {
202 return "#000066";
203 }
204 }