| 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 script | 
 
 
 
 
 
 | 25 | 
 # http://www.i-scream.org | 
 
 
 
 
 
 | 26 | 
 # | 
 
 
 
 
 
 | 27 | 
 # Generates graphs from rrd databases for i-scream data. | 
 
 
 
 
 
 | 28 | 
 # | 
 
 
 
 
 
 | 29 | 
 # $Author: tdb $ | 
 
 
 
 
 
 | 30 | 
 # $Id: graph.pl,v 1.13 2004/03/04 11:27:30 tdb Exp $ | 
 
 
 
 
 
 | 31 | 
 #------------------------------------------------------------ | 
 
 
 
 
 
 | 32 | 
  | 
 
 
 
 
 
 | 33 | 
 ## TODO | 
 
 
 
 
 
 | 34 | 
 # possibly make more configurable? | 
 
 
 
 
 
 | 35 | 
 #  -- allow configurable periods of graphs | 
 
 
 
 
 
 | 36 | 
 #  -- comments, types, etc | 
 
 
 
 
 
 | 37 | 
  | 
 
 
 
 
 
 | 38 | 
 BEGIN { | 
 
 
 
 
 
 | 39 | 
     push (@INC, "/usr/local/packages/rrdtool/lib/perl5/site_perl/5.8.2/sun4-solaris"); | 
 
 
 
 
 
 | 40 | 
 } | 
 
 
 
 
 
 | 41 | 
  | 
 
 
 
 
 
 | 42 | 
 my($version) = '$Id: graph.pl,v 1.13 2004/03/04 11:27:30 tdb Exp $'; | 
 
 
 
 
 
 | 43 | 
  | 
 
 
 
 
 
 | 44 | 
 $| = 1; | 
 
 
 
 
 
 | 45 | 
  | 
 
 
 
 
 
 | 46 | 
 use strict; | 
 
 
 
 
 
 | 47 | 
 use Getopt::Std; | 
 
 
 
 
 
 | 48 | 
 use RRDs; | 
 
 
 
 
 
 | 49 | 
  | 
 
 
 
 
 
 | 50 | 
 # define variables that will be read from the config | 
 
 
 
 
 
 | 51 | 
 # nb. keep this insync with the config file! | 
 
 
 
 
 
 | 52 | 
 use vars qw{  | 
 
 
 
 
 
 | 53 | 
     $imgdir $rrddir                      | 
 
 
 
 
 
 | 54 | 
     $maxrrdage $maximgage $deleterrds $deleteimgs | 
 
 
 
 
 
 | 55 | 
     $hex_slash $hex_underscore   | 
 
 
 
 
 
 | 56 | 
     $rrdstep $retry_wait | 
 
 
 
 
 
 | 57 | 
     $verbose $quiet | 
 
 
 
 
 
 | 58 | 
 }; | 
 
 
 
 
 
 | 59 | 
  | 
 
 
 
 
 
 | 60 | 
 # default locate of the config file | 
 
 
 
 
 
 | 61 | 
 my($configfile) = "rrdgraphing.conf"; | 
 
 
 
 
 
 | 62 | 
  | 
 
 
 
 
 
 | 63 | 
 # check for command line arguments | 
 
 
 
 
 
 | 64 | 
 my(%opts); | 
 
 
 
 
 
 | 65 | 
 my($ret) = getopts('hvqVc:', \%opts); | 
 
 
 
 
 
 | 66 | 
  | 
 
 
 
 
 
 | 67 | 
 # if invalid argument given, $ret will not be 1 | 
 
 
 
 
 
 | 68 | 
 &usage() if $ret != 1; | 
 
 
 
 
 
 | 69 | 
  | 
 
 
 
 
 
 | 70 | 
 # first process the arguments which might mean we exit now | 
 
 
 
 
 
 | 71 | 
  | 
 
 
 
 
 
 | 72 | 
 # -h is usage | 
 
 
 
 
 
 | 73 | 
 if($opts{h}) { | 
 
 
 
 
 
 | 74 | 
     &usage(); | 
 
 
 
 
 
 | 75 | 
 } | 
 
 
 
 
 
 | 76 | 
 # -V is version | 
 
 
 
 
 
 | 77 | 
 if($opts{V}) { | 
 
 
 
 
 
 | 78 | 
     print "graph.pl version: $version\n"; | 
 
 
 
 
 
 | 79 | 
     exit(1); | 
 
 
 
 
 
 | 80 | 
 } | 
 
 
 
 
 
 | 81 | 
  | 
 
 
 
 
 
 | 82 | 
 # Then try getting the config | 
 
 
 
 
 
 | 83 | 
  | 
 
 
 
 
 
 | 84 | 
 # -c specifies the config file location | 
 
 
 
 
 
 | 85 | 
 if($opts{c}) { | 
 
 
 
 
 
 | 86 | 
     $configfile = $opts{c}; | 
 
 
 
 
 
 | 87 | 
 } | 
 
 
 
 
 
 | 88 | 
 # suck in the config | 
 
 
 
 
 
 | 89 | 
 &log("reading config from $configfile\n"); | 
 
 
 
 
 
 | 90 | 
 do $configfile; | 
 
 
 
 
 
 | 91 | 
  | 
 
 
 
 
 
 | 92 | 
 # Then any options we might want to override the config with | 
 
 
 
 
 
 | 93 | 
  | 
 
 
 
 
 
 | 94 | 
 # -v is verbose | 
 
 
 
 
 
 | 95 | 
 if($opts{v}) { | 
 
 
 
 
 
 | 96 | 
     $verbose = $opts{v}; | 
 
 
 
 
 
 | 97 | 
 } | 
 
 
 
 
 
 | 98 | 
 # -q is verbose | 
 
 
 
 
 
 | 99 | 
 if($opts{q}) { | 
 
 
 
 
 
 | 100 | 
     $quiet = $opts{q}; | 
 
 
 
 
 
 | 101 | 
     # if we're meant to be quiet, we can hardly be verbose! | 
 
 
 
 
 
 | 102 | 
     $verbose = 0; | 
 
 
 
 
 
 | 103 | 
 } | 
 
 
 
 
 
 | 104 | 
  | 
 
 
 
 
 
 | 105 | 
 # Read the contents of the base directory | 
 
 
 
 
 
 | 106 | 
 # and pull out the list of subdirectories (except . and .. :) | 
 
 
 
 
 
 | 107 | 
 opendir(DIR, $rrddir); | 
 
 
 
 
 
 | 108 | 
 my(@rrddirlist) = sort grep { -d "$rrddir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR); | 
 
 
 
 
 
 | 109 | 
 closedir DIR; | 
 
 
 
 
 
 | 110 | 
  | 
 
 
 
 
 
 | 111 | 
 # look through each directory, as they might | 
 
 
 
 
 
 | 112 | 
 # contain rrds for a particular machine | 
 
 
 
 
 
 | 113 | 
 foreach my $machine (@rrddirlist) { | 
 
 
 
 
 
 | 114 | 
     # Read the contents of the directory | 
 
 
 
 
 
 | 115 | 
     opendir(DIR, "$rrddir/$machine"); | 
 
 
 
 
 
 | 116 | 
     my(@rrdlist) = grep { /\.rrd$/ && -f "$rrddir/$machine/$_" } readdir(DIR); | 
 
 
 
 
 
 | 117 | 
     closedir DIR; | 
 
 
 
 
 
 | 118 | 
      | 
 
 
 
 
 
 | 119 | 
     # See what rrd we have, and generate the graphs accordingly | 
 
 
 
 
 
 | 120 | 
     foreach my $rrd (@rrdlist) { | 
 
 
 
 
 
 | 121 | 
         chomp $rrd; | 
 
 
 
 
 
 | 122 | 
         # stat the file | 
 
 
 
 
 
 | 123 | 
         my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, | 
 
 
 
 
 
 | 124 | 
          $ctime,$blksize,$blocks) = stat("$rrddir/$machine/$rrd"); | 
 
 
 
 
 
 | 125 | 
         # check if it's old enough to be deleted | 
 
 
 
 
 
 | 126 | 
         if((time - $mtime) > $maxrrdage) { | 
 
 
 
 
 
 | 127 | 
             # do we delete the rrd, or just ignore it? | 
 
 
 
 
 
 | 128 | 
             if($deleterrds) { | 
 
 
 
 
 
 | 129 | 
                 # if so, delete it | 
 
 
 
 
 
 | 130 | 
                 unlink("$rrddir/$machine/$rrd"); | 
 
 
 
 
 
 | 131 | 
                 &log("deleted old rrd $rrddir/$machine/$rrd\n"); | 
 
 
 
 
 
 | 132 | 
             } | 
 
 
 
 
 
 | 133 | 
             else { | 
 
 
 
 
 
 | 134 | 
                 &log("ignored old rrd $rrddir/$machine/$rrd\n"); | 
 
 
 
 
 
 | 135 | 
             } | 
 
 
 
 
 
 | 136 | 
             # no more processing required for this rrd | 
 
 
 
 
 
 | 137 | 
             next; | 
 
 
 
 
 
 | 138 | 
         } | 
 
 
 
 
 
 | 139 | 
         if($rrd =~ /^(cpu)\.rrd$/) { | 
 
 
 
 
 
 | 140 | 
             my(@data); | 
 
 
 
 
 
 | 141 | 
             my(@rawdata); | 
 
 
 
 
 
 | 142 | 
             push @data, "AREA:$1:swap:swap#FF00FF:OK:swap cpu  "; | 
 
 
 
 
 
 | 143 | 
             push @data, "STACK:$1:iowait:iowait#FF0000:OK:iowait cpu"; | 
 
 
 
 
 
 | 144 | 
             push @data, "STACK:$1:kernel:kernel#00FFFF:OK:kernel cpu"; | 
 
 
 
 
 
 | 145 | 
             push @data, "STACK:$1:user:user#0000FF:OK:user cpu  "; | 
 
 
 
 
 
 | 146 | 
             #push @data, "STACK:$1:idle:idle#00FF00:OK:idle cpu  "; | 
 
 
 
 
 
 | 147 | 
             push @rawdata, "--upper-limit=100"; | 
 
 
 
 
 
 | 148 | 
             &makegraph($machine, $1, "CPU Usage for $machine", "% cpu time", \@data, \@rawdata); | 
 
 
 
 
 
 | 149 | 
         } | 
 
 
 
 
 
 | 150 | 
         if($rrd =~ /^(mem)\.rrd$/) { | 
 
 
 
 
 
 | 151 | 
             my(@data); | 
 
 
 
 
 
 | 152 | 
             my(@rawdata); | 
 
 
 
 
 
 | 153 | 
             # we don't actually want to display free or total memory, | 
 
 
 
 
 
 | 154 | 
             # although we need it to work out peruse... | 
 
 
 
 
 
 | 155 | 
             push @data, "NONE:$1:free:free#CCCCFF:NONE:free memory"; | 
 
 
 
 
 
 | 156 | 
             push @data, "NONE:$1:total:total#0000FF:NONE:total memory\\n"; | 
 
 
 
 
 
 | 157 | 
             push @data, "NONE:$1:cache:cache#0000FF:NONE:cache memory\\n"; | 
 
 
 
 
 
 | 158 | 
             # calculate peruse - note that we only use 'free' if it's less than total | 
 
 
 
 
 
 | 159 | 
             # (this is to avoid negative percentages :) | 
 
 
 
 
 
 | 160 | 
             push @rawdata, "CDEF:peruse=total,free,total,LT,free,0,IF,-,total,/,100,*"; | 
 
 
 
 
 
 | 161 | 
             push @rawdata, "CDEF:percacuse=cache,total,LT,cache,0,IF,total,/,100,*"; | 
 
 
 
 
 
 | 162 | 
             # and add it to the graph | 
 
 
 
 
 
 | 163 | 
             push @rawdata, "AREA:peruse#CCCCFF:% memory in use"; | 
 
 
 
 
 
 | 164 | 
             &addlegend(\@rawdata, "peruse"); | 
 
 
 
 
 
 | 165 | 
             push @rawdata, "LINE2:percacuse#0000FF:% memory cache "; | 
 
 
 
 
 
 | 166 | 
             &addlegend(\@rawdata, "percacuse"); | 
 
 
 
 
 
 | 167 | 
             push @rawdata, "--upper-limit=100"; | 
 
 
 
 
 
 | 168 | 
             push @rawdata, "--base=1024"; | 
 
 
 
 
 
 | 169 | 
             # put the total memory on the graph so we can map percentages to real values | 
 
 
 
 
 
 | 170 | 
             push @rawdata, "GPRINT:total:LAST:Current total memory\\: \%.2lf %sb\\c"; | 
 
 
 
 
 
 | 171 | 
             &makegraph($machine, $1, "Memory Usage for $machine", "% memory in use", \@data, \@rawdata); | 
 
 
 
 
 
 | 172 | 
         } | 
 
 
 
 
 
 | 173 | 
         if($rrd =~ /^(load)\.rrd$/) { | 
 
 
 
 
 
 | 174 | 
             my(@data); | 
 
 
 
 
 
 | 175 | 
             push @data, "LINE2:$1:load1:load1#CCCCFF:OK: 1 min load average"; | 
 
 
 
 
 
 | 176 | 
             push @data, "LINE2:$1:load5:load5#7777FF:OK: 5 min load average"; | 
 
 
 
 
 
 | 177 | 
             push @data, "LINE2:$1:load15:load15#0000FF:OK:15 min load average"; | 
 
 
 
 
 
 | 178 | 
             &makegraph($machine, $1, "Loads for $machine", "load average", \@data); | 
 
 
 
 
 
 | 179 | 
         } | 
 
 
 
 
 
 | 180 | 
         if($rrd =~ /^(proc)\.rrd$/) { | 
 
 
 
 
 
 | 181 | 
             my(@data); | 
 
 
 
 
 
 | 182 | 
             push @data, "AREA:$1:stopped:stopped#00FFFF:OK:stopped processes "; | 
 
 
 
 
 
 | 183 | 
             push @data, "STACK:$1:zombie:zombie#FF0000:OK:zombie processes  "; | 
 
 
 
 
 
 | 184 | 
             push @data, "STACK:$1:cpu:cpu#00FF00:OK:cpu processes     "; | 
 
 
 
 
 
 | 185 | 
             push @data, "STACK:$1:sleeping:sleeping#0000FF:OK:sleeping processes"; | 
 
 
 
 
 
 | 186 | 
             #push @data, "LINE2:$1:total:total#FF00FF:OK:total processes   "; | 
 
 
 
 
 
 | 187 | 
             &makegraph($machine, $1, "Processes on $machine", "no. of processes", \@data); | 
 
 
 
 
 
 | 188 | 
         } | 
 
 
 
 
 
 | 189 | 
         if($rrd =~ /^(swap)\.rrd$/) { | 
 
 
 
 
 
 | 190 | 
             my(@data); | 
 
 
 
 
 
 | 191 | 
             my(@rawdata); | 
 
 
 
 
 
 | 192 | 
             # we don't actually want to display free or total swap, | 
 
 
 
 
 
 | 193 | 
             # although we need it to work out peruse... | 
 
 
 
 
 
 | 194 | 
             push @data, "NONE:$1:free:free#CCCCFF:NONE:free swap"; | 
 
 
 
 
 
 | 195 | 
             push @data, "NONE:$1:total:total#0000FF:NONE:total swap\\n"; | 
 
 
 
 
 
 | 196 | 
             # calculate peruse - note that we only use 'free' if it's less than total | 
 
 
 
 
 
 | 197 | 
             # (this is to avoid negative percentages :) | 
 
 
 
 
 
 | 198 | 
             push @rawdata, "CDEF:peruse=total,free,total,LT,free,0,IF,-,total,/,100,*"; | 
 
 
 
 
 
 | 199 | 
             # and add it to the graph | 
 
 
 
 
 
 | 200 | 
             push @rawdata, "AREA:peruse#CCCCFF:% swap in use"; | 
 
 
 
 
 
 | 201 | 
             push @rawdata, "--upper-limit=100"; | 
 
 
 
 
 
 | 202 | 
             push @rawdata, "--base=1024"; | 
 
 
 
 
 
 | 203 | 
             # add some nice values to the legend | 
 
 
 
 
 
 | 204 | 
             &addlegend(\@rawdata, "peruse"); | 
 
 
 
 
 
 | 205 | 
             # put the total swap on the graph so we can map percentages to real values | 
 
 
 
 
 
 | 206 | 
             push @rawdata, "GPRINT:total:LAST:Current total swap\\: \%.2lf %sb\\c"; | 
 
 
 
 
 
 | 207 | 
             &makegraph($machine, $1, "Swap Usage for $machine", "% swap in use", \@data, \@rawdata); | 
 
 
 
 
 
 | 208 | 
         } | 
 
 
 
 
 
 | 209 | 
         if($rrd =~ /^(users)\.rrd$/) { | 
 
 
 
 
 
 | 210 | 
             my(@data); | 
 
 
 
 
 
 | 211 | 
             push @data, "AREA:$1:count:count#CCCCFF:OK:user count"; | 
 
 
 
 
 
 | 212 | 
             &makegraph($machine, $1, "User Count for $machine", "no. of users", \@data); | 
 
 
 
 
 
 | 213 | 
         } | 
 
 
 
 
 
 | 214 | 
         if($rrd =~ /^(paging)\.rrd$/) { | 
 
 
 
 
 
 | 215 | 
             my(@data); | 
 
 
 
 
 
 | 216 | 
             push @data, "AREA:$1:pageins:pageins#00FF00:OK:pages paged in "; | 
 
 
 
 
 
 | 217 | 
             push @data, "LINE2:$1:pageouts:pageouts#0000FF:OK:pages paged out"; | 
 
 
 
 
 
 | 218 | 
             &makegraph($machine, $1, "Paging on $machine", "pages per second", \@data); | 
 
 
 
 
 
 | 219 | 
         } | 
 
 
 
 
 
 | 220 | 
         if($rrd =~ /^(disk)-(\S+)\.rrd$/) { | 
 
 
 
 
 
 | 221 | 
             my(@data); | 
 
 
 
 
 
 | 222 | 
             my(@rawdata); | 
 
 
 
 
 
 | 223 | 
             # we need this lot for our calculations, but we'll never show them | 
 
 
 
 
 
 | 224 | 
             push @data, "NONE:$1-$2:total:total#0000FF:NONE:total size\\n"; | 
 
 
 
 
 
 | 225 | 
             push @data, "NONE:$1-$2:used:used#CCCCFF:NONE:used space"; | 
 
 
 
 
 
 | 226 | 
             push @data, "NONE:$1-$2:totalinodes:totalinodes#000000:NONE:total inodes"; | 
 
 
 
 
 
 | 227 | 
             push @data, "NONE:$1-$2:freeinodes:freeinodes#000000:NONE:free inodes"; | 
 
 
 
 
 
 | 228 | 
             # calculate peruse, add it to the graph, and add a legend | 
 
 
 
 
 
 | 229 | 
             push @rawdata, "CDEF:peruse=used,total,/,100,*"; | 
 
 
 
 
 
 | 230 | 
             push @rawdata, "AREA:peruse#CCCCFF:% disk used  "; | 
 
 
 
 
 
 | 231 | 
             &addlegend(\@rawdata, "peruse"); | 
 
 
 
 
 
 | 232 | 
             # put the total space on the graph so we can map percentages to real values | 
 
 
 
 
 
 | 233 | 
             push @rawdata, "GPRINT:total:LAST:Current total space\\: \%.2lf %sb\\c"; | 
 
 
 
 
 
 | 234 | 
             # calculate perinodeuse, add it to the graph, and add a legend | 
 
 
 
 
 
 | 235 | 
             push @rawdata, "CDEF:perinodeuse=totalinodes,freeinodes,totalinodes,LT,freeinodes,0,IF,-,totalinodes,/,100,*"; | 
 
 
 
 
 
 | 236 | 
             push @rawdata, "LINE2:perinodeuse#FF4444:% inodes used"; | 
 
 
 
 
 
 | 237 | 
             push @rawdata, "--upper-limit=100"; | 
 
 
 
 
 
 | 238 | 
             push @rawdata, "--base=1024"; | 
 
 
 
 
 
 | 239 | 
             &addlegend(\@rawdata, "perinodeuse"); | 
 
 
 
 
 
 | 240 | 
             # put the total inodes on the graph so we can map percentages to real values | 
 
 
 
 
 
 | 241 | 
             push @rawdata, "GPRINT:totalinodes:LAST:Current total inodes\\: \%.2lf %s\\c"; | 
 
 
 
 
 
 | 242 | 
             # some name tidting | 
 
 
 
 
 
 | 243 | 
             my($type) = $1; | 
 
 
 
 
 
 | 244 | 
             my($name) = $2; | 
 
 
 
 
 
 | 245 | 
             my($nicename) = $2; | 
 
 
 
 
 
 | 246 | 
             $nicename =~ s/$hex_slash/\//g; | 
 
 
 
 
 
 | 247 | 
             $nicename =~ s/$hex_underscore/_/g; | 
 
 
 
 
 
 | 248 | 
             &makegraph($machine, "$type-$name", "Disk Usage for $machine on $nicename", "% usage", \@data, \@rawdata); | 
 
 
 
 
 
 | 249 | 
         } | 
 
 
 
 
 
 | 250 | 
         if($rrd =~ /^(diskio)-(\S+)\.rrd$/) { | 
 
 
 
 
 
 | 251 | 
             my(@data); | 
 
 
 
 
 
 | 252 | 
             my(@rawdata); | 
 
 
 
 
 
 | 253 | 
             push @data, "AREA:$1-$2:rbytes:rbytes#00FF00:OK:read bytes "; | 
 
 
 
 
 
 | 254 | 
             push @data, "LINE2:$1-$2:wbytes:wbytes#0000FF:OK:write bytes"; | 
 
 
 
 
 
 | 255 | 
             push @rawdata, "--base=1024"; | 
 
 
 
 
 
 | 256 | 
             &makegraph($machine, "$1-$2", "Disk IO for $machine on $2", "bytes per second", \@data, \@rawdata); | 
 
 
 
 
 
 | 257 | 
         } | 
 
 
 
 
 
 | 258 | 
         if($rrd =~ /^(net)-(\S+)\.rrd$/) { | 
 
 
 
 
 
 | 259 | 
             my(@data); | 
 
 
 
 
 
 | 260 | 
             my(@rawdata); | 
 
 
 
 
 
 | 261 | 
             push @data, "AREA:$1-$2:rx:rx#00FF00:OK:received bytes  "; | 
 
 
 
 
 
 | 262 | 
             push @data, "LINE2:$1-$2:tx:tx#0000FF:OK:transfered bytes"; | 
 
 
 
 
 
 | 263 | 
             push @rawdata, "--base=1024"; | 
 
 
 
 
 
 | 264 | 
             &makegraph($machine, "$1-$2", "Network IO for $machine on $2", "bytes per second", \@data, \@rawdata); | 
 
 
 
 
 
 | 265 | 
         } | 
 
 
 
 
 
 | 266 | 
         if($rrd =~ /^(mailq)-(\S+)\.rrd$/) { | 
 
 
 
 
 
 | 267 | 
             my(@data); | 
 
 
 
 
 
 | 268 | 
             my(@rawdata); | 
 
 
 
 
 
 | 269 | 
             push @data, "LINE2:$1-$2:size:size#0000FF:OK:messages"; | 
 
 
 
 
 
 | 270 | 
             &makegraph($machine, "$1-$2", "Mail Queue ($2) Size for $machine", "messages in queue", \@data, \@rawdata); | 
 
 
 
 
 
 | 271 | 
         } | 
 
 
 
 
 
 | 272 | 
         # probably a queue with a name like this :) | 
 
 
 
 
 
 | 273 | 
         if($rrd =~ /^(\d+)_0\.rrd$/) { | 
 
 
 
 
 
 | 274 | 
             my(@data); | 
 
 
 
 
 
 | 275 | 
             my(@rawdata); | 
 
 
 
 
 
 | 276 | 
             my($baserrd) = $1; | 
 
 
 
 
 
 | 277 | 
             my($i) = 0; | 
 
 
 
 
 
 | 278 | 
             while( -f "$rrddir/$machine/$baserrd\_$i.rrd" ) { | 
 
 
 
 
 
 | 279 | 
                 push @data, "LINE2:$baserrd\_$i:size:size$i" . &get_colour($i) . ":OK:queue$i size "; | 
 
 
 
 
 
 | 280 | 
                 ++$i; | 
 
 
 
 
 
 | 281 | 
             } | 
 
 
 
 
 
 | 282 | 
             push @data, "LINE2:$baserrd\_0:total:total#FF0000:OK:packets/sec "; | 
 
 
 
 
 
 | 283 | 
             my($comment); | 
 
 
 
 
 
 | 284 | 
             if(-f "$rrddir/$machine/$baserrd.def") { | 
 
 
 
 
 
 | 285 | 
                 open(DEF, "$rrddir/$machine/$baserrd.def"); | 
 
 
 
 
 
 | 286 | 
                 $comment = <DEF>; | 
 
 
 
 
 
 | 287 | 
                 chomp $comment if defined $comment; | 
 
 
 
 
 
 | 288 | 
             } | 
 
 
 
 
 
 | 289 | 
             $comment = "unknown queue" if not defined $comment; | 
 
 
 
 
 
 | 290 | 
             &makegraph($machine, $baserrd, $comment, "", \@data, \@rawdata); | 
 
 
 
 
 
 | 291 | 
         } | 
 
 
 
 
 
 | 292 | 
     } | 
 
 
 
 
 
 | 293 | 
     # have a last check, maybe we can remove the directory now? | 
 
 
 
 
 
 | 294 | 
     # (only if we're deleting stuff) | 
 
 
 
 
 
 | 295 | 
     if($deleterrds) { | 
 
 
 
 
 
 | 296 | 
         # Read the contents of the directory | 
 
 
 
 
 
 | 297 | 
         opendir(DIR, "$rrddir/$machine"); | 
 
 
 
 
 
 | 298 | 
         my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR); | 
 
 
 
 
 
 | 299 | 
         closedir DIR; | 
 
 
 
 
 
 | 300 | 
         if($#dirlist == -1) { | 
 
 
 
 
 
 | 301 | 
             rmdir "$rrddir/$machine"; | 
 
 
 
 
 
 | 302 | 
             &log("deleting empty rrd directory $rrddir/$machine\n"); | 
 
 
 
 
 
 | 303 | 
         } | 
 
 
 
 
 
 | 304 | 
     } | 
 
 
 
 
 
 | 305 | 
 } | 
 
 
 
 
 
 | 306 | 
  | 
 
 
 
 
 
 | 307 | 
 if($deleteimgs) { | 
 
 
 
 
 
 | 308 | 
     # Read the contents of the graphs directory | 
 
 
 
 
 
 | 309 | 
     # and pull out the list of subdirectories (except . and .. :) | 
 
 
 
 
 
 | 310 | 
     opendir(DIR, $imgdir); | 
 
 
 
 
 
 | 311 | 
     my(@imgdirlist) = sort grep { -d "$imgdir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR); | 
 
 
 
 
 
 | 312 | 
     closedir DIR; | 
 
 
 
 
 
 | 313 | 
  | 
 
 
 
 
 
 | 314 | 
     # look through each directoty, as they might | 
 
 
 
 
 
 | 315 | 
     # contain images for a particular machine | 
 
 
 
 
 
 | 316 | 
     foreach my $machine (@imgdirlist) { | 
 
 
 
 
 
 | 317 | 
         # Read the contents of the directory | 
 
 
 
 
 
 | 318 | 
         opendir(DIR, "$imgdir/$machine"); | 
 
 
 
 
 
 | 319 | 
         my(@imglist) = grep { /\.png$/ && -f "$imgdir/$machine/$_" } readdir(DIR); | 
 
 
 
 
 
 | 320 | 
         closedir DIR; | 
 
 
 
 
 
 | 321 | 
  | 
 
 
 
 
 
 | 322 | 
         # See what rrd we have, and generate the graphs accordingly | 
 
 
 
 
 
 | 323 | 
         foreach my $img (@imglist) { | 
 
 
 
 
 
 | 324 | 
             chomp $img; | 
 
 
 
 
 
 | 325 | 
             # stat the img | 
 
 
 
 
 
 | 326 | 
             my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, | 
 
 
 
 
 
 | 327 | 
              $ctime,$blksize,$blocks) = stat("$imgdir/$machine/$img"); | 
 
 
 
 
 
 | 328 | 
             # check if it's old enough to be deleted | 
 
 
 
 
 
 | 329 | 
             if((time - $mtime) > $maximgage) { | 
 
 
 
 
 
 | 330 | 
                 # if so, delete it | 
 
 
 
 
 
 | 331 | 
                 unlink("$imgdir/$machine/$img"); | 
 
 
 
 
 
 | 332 | 
                 &log("deleted old image $imgdir/$machine/$img\n"); | 
 
 
 
 
 
 | 333 | 
             } | 
 
 
 
 
 
 | 334 | 
         } | 
 
 
 
 
 
 | 335 | 
         # have a last check, maybe we can remove the directory now? | 
 
 
 
 
 
 | 336 | 
         # Read the contents of the directory | 
 
 
 
 
 
 | 337 | 
         opendir(DIR, "$imgdir/$machine"); | 
 
 
 
 
 
 | 338 | 
         my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR); | 
 
 
 
 
 
 | 339 | 
         closedir DIR; | 
 
 
 
 
 
 | 340 | 
         if($#dirlist == -1) { | 
 
 
 
 
 
 | 341 | 
             rmdir "$imgdir/$machine"; | 
 
 
 
 
 
 | 342 | 
             &log("deleted empty image directory $imgdir/$machine\n"); | 
 
 
 
 
 
 | 343 | 
         } | 
 
 
 
 
 
 | 344 | 
     } | 
 
 
 
 
 
 | 345 | 
 } | 
 
 
 
 
 
 | 346 | 
  | 
 
 
 
 
 
 | 347 | 
 exit(0); | 
 
 
 
 
 
 | 348 | 
  | 
 
 
 
 
 
 | 349 | 
  | 
 
 
 
 
 
 | 350 | 
 # | 
 
 
 
 
 
 | 351 | 
 # subroutine to make some graphs | 
 
 
 
 
 
 | 352 | 
 # | 
 
 
 
 
 
 | 353 | 
 # $machine   = name of the machine | 
 
 
 
 
 
 | 354 | 
 #              (eg. kernow.ukc.ac.uk) | 
 
 
 
 
 
 | 355 | 
 # $type      = the type of graph for the machine | 
 
 
 
 
 
 | 356 | 
 #              (eg. cpu) | 
 
 
 
 
 
 | 357 | 
 # $title     = the title for the graph | 
 
 
 
 
 
 | 358 | 
 #              (eg. kernow CPU usage) | 
 
 
 
 
 
 | 359 | 
 # $vlabel    = the vertical label to apply to the left side of the graph | 
 
 
 
 
 
 | 360 | 
 #              (eg. kb/s) | 
 
 
 
 
 
 | 361 | 
 # $dataref   = a reference to an array containing information for the graph | 
 
 
 
 
 
 | 362 | 
 #              elements of format: "gtype:rrdname:dsname:name#colour:legend:comment with spaces" | 
 
 
 
 
 
 | 363 | 
 #              (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted) | 
 
 
 
 
 
 | 364 | 
 #              (if legend is "NONE" the latest/average/max/min legend won't be printed) | 
 
 
 
 
 
 | 365 | 
 # $rawcmdref = a reference to an array containing raw rrd commands | 
 
 
 
 
 
 | 366 | 
 #              elements a single command each, no spaces | 
 
 
 
 
 
 | 367 | 
 # | 
 
 
 
 
 
 | 368 | 
  | 
 
 
 
 
 
 | 369 | 
 sub makegraph() { | 
 
 
 
 
 
 | 370 | 
     my($machine, $type, $title, $vlabel, $dataref, $rawcmdref) = @_; | 
 
 
 
 
 
 | 371 | 
     # pass in these arrays by reference | 
 
 
 
 
 
 | 372 | 
     my(@data) = @$dataref if defined $dataref; | 
 
 
 
 
 
 | 373 | 
     my(@rawcmd) = @$rawcmdref if defined $rawcmdref; | 
 
 
 
 
 
 | 374 | 
     # check if directory exists for images | 
 
 
 
 
 
 | 375 | 
     if(! -d "$imgdir/$machine") { | 
 
 
 
 
 
 | 376 | 
         # not sure on this umask, but it seems to work? | 
 
 
 
 
 
 | 377 | 
         mkdir "$imgdir/$machine", 0777; | 
 
 
 
 
 
 | 378 | 
         &log("created directory $imgdir/$machine\n"); | 
 
 
 
 
 
 | 379 | 
     } | 
 
 
 
 
 
 | 380 | 
     my(@rrdcmd); | 
 
 
 
 
 
 | 381 | 
     foreach my $dataitem (@data) { | 
 
 
 
 
 
 | 382 | 
         # dataitem should be: "gtype:rrdname:dsname:name#colour:legend:comment with spaces" | 
 
 
 
 
 
 | 383 | 
         # (if gtype is "NONE" only a DEF of 'name' will be defined, no line will be plotted) | 
 
 
 
 
 
 | 384 | 
         # (if legend is "NONE" the latest/average/max/min legend won't be printed) | 
 
 
 
 
 
 | 385 | 
         if($dataitem =~ /^(\S+):(\S+):(\S+):(\S+)#(.{6}):(\S+):(.*)$/) { | 
 
 
 
 
 
 | 386 | 
             push @rrdcmd, "DEF:$4=$rrddir/$machine/$2.rrd:$3:AVERAGE"; | 
 
 
 
 
 
 | 387 | 
             if($1 ne "NONE") { | 
 
 
 
 
 
 | 388 | 
                 push @rrdcmd, "$1:$4#$5:$7"; | 
 
 
 
 
 
 | 389 | 
                 if($6 ne "NONE") { | 
 
 
 
 
 
 | 390 | 
                     # add some nice values to the legend | 
 
 
 
 
 
 | 391 | 
                     &addlegend(\@rrdcmd, $4); | 
 
 
 
 
 
 | 392 | 
                 } | 
 
 
 
 
 
 | 393 | 
             } | 
 
 
 
 
 
 | 394 | 
         } | 
 
 
 
 
 
 | 395 | 
     } | 
 
 
 
 
 
 | 396 | 
     push @rrdcmd, "--title=$title"; | 
 
 
 
 
 
 | 397 | 
     push @rrdcmd, "--imgformat=PNG"; | 
 
 
 
 
 
 | 398 | 
     push @rrdcmd, "--lower-limit=0"; | 
 
 
 
 
 
 | 399 | 
     push @rrdcmd, "--vertical-label=$vlabel"; | 
 
 
 
 
 
 | 400 | 
     # not entirely convinced this is good... | 
 
 
 
 
 
 | 401 | 
     push @rrdcmd, "--alt-autoscale-max"; | 
 
 
 
 
 
 | 402 | 
     # add any further raw commands | 
 
 
 
 
 
 | 403 | 
     push @rrdcmd, @rawcmd; | 
 
 
 
 
 
 | 404 | 
     RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd); | 
 
 
 
 
 
 | 405 | 
     my($err_3h) = RRDs::error; | 
 
 
 
 
 
 | 406 | 
     &log("created $imgdir/$machine/$type-3h.png\n") unless $err_3h; | 
 
 
 
 
 
 | 407 | 
     &error("Error generating 3h graph for $machine/$type: $err_3h\n") if $err_3h; | 
 
 
 
 
 
 | 408 | 
     RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd); | 
 
 
 
 
 
 | 409 | 
     my($err_1d) = RRDs::error; | 
 
 
 
 
 
 | 410 | 
     &log("created $imgdir/$machine/$type-1d.png\n") unless $err_1d; | 
 
 
 
 
 
 | 411 | 
     &error("Error generating 1d graph for $machine/$type: $err_1d\n") if $err_1d; | 
 
 
 
 
 
 | 412 | 
     RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd); | 
 
 
 
 
 
 | 413 | 
     my($err_1w) = RRDs::error; | 
 
 
 
 
 
 | 414 | 
     &log("created $imgdir/$machine/$type-1w.png\n") unless $err_1w; | 
 
 
 
 
 
 | 415 | 
     &error("Error generating 1w graph for $machine/$type: $err_1w\n") if $err_1w; | 
 
 
 
 
 
 | 416 | 
     RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd); | 
 
 
 
 
 
 | 417 | 
     my($err_1m) = RRDs::error; | 
 
 
 
 
 
 | 418 | 
     &log("created $imgdir/$machine/$type-1m.png\n") unless $err_1m; | 
 
 
 
 
 
 | 419 | 
     &error("Error generating 1m graph for $machine/$type: $err_1m\n") if $err_1m; | 
 
 
 
 
 
 | 420 | 
     RRDs::graph ("$imgdir/$machine/$type-1y.png", "--start=-31536000", @rrdcmd); | 
 
 
 
 
 
 | 421 | 
     my($err_1y) = RRDs::error; | 
 
 
 
 
 
 | 422 | 
     &log("created $imgdir/$machine/$type-1y.png\n") unless $err_1y; | 
 
 
 
 
 
 | 423 | 
     &error("Error generating 1y graph for $machine/$type: $err_1y\n") if $err_1y; | 
 
 
 
 
 
 | 424 | 
     return; | 
 
 
 
 
 
 | 425 | 
 } | 
 
 
 
 
 
 | 426 | 
  | 
 
 
 
 
 
 | 427 | 
 # subroutine to add a legend | 
 
 
 
 
 
 | 428 | 
 # accepts reference to an array and a name | 
 
 
 
 
 
 | 429 | 
 sub addlegend() { | 
 
 
 
 
 
 | 430 | 
     my($dataref, $name) = @_; | 
 
 
 
 
 
 | 431 | 
     push @$dataref, "GPRINT:$name:LAST:Current\\: \%8.2lf %s"; | 
 
 
 
 
 
 | 432 | 
     push @$dataref, "GPRINT:$name:AVERAGE:Average\\: \%8.2lf %s"; | 
 
 
 
 
 
 | 433 | 
     push @$dataref, "GPRINT:$name:MAX:Max\\: \%8.2lf %s\\n"; | 
 
 
 
 
 
 | 434 | 
 } | 
 
 
 
 
 
 | 435 | 
  | 
 
 
 
 
 
 | 436 | 
 # hacky subroutine to return a colour | 
 
 
 
 
 
 | 437 | 
 # could be done much better somehow :/ | 
 
 
 
 
 
 | 438 | 
 sub get_colour { | 
 
 
 
 
 
 | 439 | 
     my($col) = @_; | 
 
 
 
 
 
 | 440 | 
     if($col == 0) { | 
 
 
 
 
 
 | 441 | 
         return "#0000FF"; | 
 
 
 
 
 
 | 442 | 
     } | 
 
 
 
 
 
 | 443 | 
     elsif($col == 1) { | 
 
 
 
 
 
 | 444 | 
         return "#00FF00"; | 
 
 
 
 
 
 | 445 | 
     } | 
 
 
 
 
 
 | 446 | 
     elsif($col == 2) { | 
 
 
 
 
 
 | 447 | 
         return "#FF00FF"; | 
 
 
 
 
 
 | 448 | 
     } | 
 
 
 
 
 
 | 449 | 
     elsif($col == 3) { | 
 
 
 
 
 
 | 450 | 
         return "#FFFF00"; | 
 
 
 
 
 
 | 451 | 
     } | 
 
 
 
 
 
 | 452 | 
     elsif($col == 4) { | 
 
 
 
 
 
 | 453 | 
         return "#00FFFF"; | 
 
 
 
 
 
 | 454 | 
     } | 
 
 
 
 
 
 | 455 | 
     else { | 
 
 
 
 
 
 | 456 | 
         return "#000066"; | 
 
 
 
 
 
 | 457 | 
     } | 
 
 
 
 
 
 | 458 | 
 } | 
 
 
 
 
 
 | 459 | 
  | 
 
 
 
 
 
 | 460 | 
 # prints out usage information then exits | 
 
 
 
 
 
 | 461 | 
 sub usage() { | 
 
 
 
 
 
 | 462 | 
     print "Usage: graph.pl [options]\n"; | 
 
 
 
 
 
 | 463 | 
     print "Options\n"; | 
 
 
 
 
 
 | 464 | 
     print "  -c config        Specifies the configuration file\n"; | 
 
 
 
 
 
 | 465 | 
     print "                    default: rrdgraphing.conf\n"; | 
 
 
 
 
 
 | 466 | 
     print "  -v               Be verbose about what's happening\n"; | 
 
 
 
 
 
 | 467 | 
     print "  -q               Be quiet, even supress errors\n"; | 
 
 
 
 
 
 | 468 | 
     print "  -V               Print version number\n";  | 
 
 
 
 
 
 | 469 | 
     print "  -h               Prints this help page\n"; | 
 
 
 
 
 
 | 470 | 
     exit(1); | 
 
 
 
 
 
 | 471 | 
 }        | 
 
 
 
 
 
 | 472 | 
  | 
 
 
 
 
 
 | 473 | 
 # prints a log message if verbose is turned on | 
 
 
 
 
 
 | 474 | 
 sub log() { | 
 
 
 
 
 
 | 475 | 
     my($msg) = @_; | 
 
 
 
 
 
 | 476 | 
     print $msg if $verbose; | 
 
 
 
 
 
 | 477 | 
 } | 
 
 
 
 
 
 | 478 | 
  | 
 
 
 
 
 
 | 479 | 
 # prints an error message unless quiet is turned on | 
 
 
 
 
 
 | 480 | 
 sub error() { | 
 
 
 
 
 
 | 481 | 
     my($msg) = @_; | 
 
 
 
 
 
 | 482 | 
     print STDERR $msg unless $quiet; | 
 
 
 
 
 
 | 483 | 
 } |