html/cgi-bin/qosgraph.cgi

   1 #!/usr/bin/perl
   2 #
   3 # SmoothWall CGIs
   4 #
   5 # This code is distributed under the terms of the GPL
   6 #
   7 # (c) The SmoothWall Team
   8 #
   9 #
  10
  11 use strict;
  12
  13 # enable only the following on debugging purpose
  14 use warnings;
  15 use CGI::Carp 'fatalsToBrowser';
  16
  17 require '/var/ipfire/general-functions.pl';
  18 require "${General::swroot}/lang.pl";
  19 require "${General::swroot}/header.pl";
  20 require "${General::swroot}/graphs.pl";
  21
  22 #workaround to suppress a warning when a variable is used only once
  23 my @dummy = ( ${Header::colourred} );
  24 undef (@dummy);
  25
  26 my %qossettings = ();
  27 my %checked = ();
  28 my %netsettings = ();
  29 my $message = '';
  30 my $errormessage = "";
  31 my $c = "";
  32 my $direntry = "";
  33 my $classentry = "";
  34 my $subclassentry = "";
  35 my $l7ruleentry = "";
  36 my $portruleentry = "";
  37 my $tosruleentry = "";
  38 my @tmp = ();
  39 my @classes = ();
  40 my @subclasses = ();
  41 my @l7rules = ();
  42 my @portrules = ();
  43 my @tosrules = ();
  44 my @tmpline = ();
  45 my @classline = ();
  46 my @subclassline = ();
  47 my @l7ruleline = ();
  48 my @portruleline = ();
  49 my @tosruleline = ();
  50 my @proto = ();
  51 my %selected= ();
  52 my @checked = ();
  53 my $classfile = "/var/ipfire/qos/classes";
  54 my $subclassfile = "/var/ipfire/qos/subclasses";
  55 my $level7file = "/var/ipfire/qos/level7config";
  56 my $portfile = "/var/ipfire/qos/portconfig";
  57 my $tosfile = "/var/ipfire/qos/tosconfig";
  58 &General::readhash("${General::swroot}/ethernet/settings", \%netsettings);
  59
  60 &overviewgraph($qossettings{'RED_DEV'});
  61 &overviewgraph($qossettings{'IMQ_DEV'});
  62
  63 my %color = ();
  64 my %mainsettings = ();
  65 &General::readhash("${General::swroot}/main/settings", \%mainsettings);
  66 &General::readhash("/srv/web/ipfire/html/themes/".$mainsettings{'THEME'}."/include/colors.txt", \%color);
  67
  68 my %cgiparams=();
  69 # Maps a nice printable name to the changing part of the pid file, which
  70 # is also the name of the program
  71
  72
  73 # Generate Graphs from rrd Data
  74 &Graphs::updatecpugraph ("day");
  75 &Graphs::updateloadgraph ("day");
  76
  77 &Header::showhttpheaders();
  78 &Header::getcgihash(\%cgiparams);
  79 &Header::openpage($Lang::tr{'status information'}, 1, '');
  80 &Header::openbigbox('100%', 'left');
  81
  82         open( FILE, "< $classfile" ) or die "Unable to read $classfile";
  83         @classes = <FILE>;
  84         close FILE;
  85         open( FILE, "< $subclassfile" ) or die "Unable to read $subclassfile";
  86         @subclasses = <FILE>;
  87         close FILE;
  88         &Header::openbox('100%', 'left', 'QoS Graphen');
  89         print <<END
  90         <table width='100%'>    <tr><td align='center'><font color='red'>Diese Seite braucht je nach Geschwindigkeit des Computers laenger zum Laden.</font>
  91                                 <tr><td align='center'><b>Klasse:</b>
  92 END
  93 ;
  94         foreach $classentry (sort @classes)
  95         {
  96                 @classline = split( /\;/, $classentry );
  97                 $qossettings{'CLASS'}=$classline[1];
  98                 print <<END
  99                 <input type="button" onClick="swapVisibility('$qossettings{'CLASS'}')" value='$qossettings{'CLASS'}' />
 100 END
 101 ;
 102         }
 103         print <<END
 104         </table>
 105 END
 106 ;
 107         &Header::closebox();
 108         foreach $classentry (sort @classes)
 109         {
 110                 @classline = split( /\;/, $classentry );
 111                 $qossettings{'DEV'}=$classline[0];
 112                 $qossettings{'CLASS'}=$classline[1];
 113                 &gengraph($qossettings{'DEV'},$qossettings{'CLASS'});
 114                 print "<div id='$qossettings{'CLASS'}' style='display: none'>";
 115                 &Header::openbox('100%', 'center', "$qossettings{'CLASS'} ($qossettings{'DEV'})");
 116                 print <<END
 117                 <table>
 118                 <tr><td colspan='2' align='center'><img src='/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}-packets.png' />
 119                 <tr><td colspan='2' align='center'><img src='/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}-borrowed.png' />
 120                 <tr><td colspan='2' align='center'><img src='/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}-bytes.png' />
 121 END
 122 ;
 123                 foreach $subclassentry (sort @subclasses)
 124                 {
 125                         @subclassline = split( /\;/, $subclassentry );
 126                         if ($subclassline[1] eq $classline[1]) {
 127                                 $qossettings{'DEV'}=$subclassline[0];
 128                                 $qossettings{'SCLASS'}=$subclassline[2];
 129                                 &gengraph($qossettings{'DEV'},$qossettings{'SCLASS'});
 130                                 print <<END
 131                                 <tr><td colspan='2' align='center'><img src='/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'SCLASS'}_$qossettings{'DEV'}-packets.png' />
 132                                 <tr><td colspan='2' align='center'><img src='/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'SCLASS'}_$qossettings{'DEV'}-borrowed.png' />
 133                                 <tr><td colspan='2' align='center'><img src='/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'SCLASS'}_$qossettings{'DEV'}-bytes.png' />
 134 END
 135 ;
 136                         }
 137                 }
 138                 print "\t\t</table>";
 139                 &Header::closebox();
 140                 print "</div>\n";
 141         }
 142 print <<END
 143         </table>
 144 END
 145 ;
 146
 147 if (( -e "/srv/web/ipfire/html/graphs/qos-graph-$qossettings{'RED_DEV'}.png") && ( -e "/srv/web/ipfire/html/graphs/qos-graph-$qossettings{'IMQ_DEV'}.png")) {
 148         print <<END
 149                 <tr><td colspan='9' align='center'><img alt="" src="/graphs/qos-graph-$qossettings{'RED_DEV'}.png" />
 150                 <tr><td colspan='9' align='center'><img alt="" src="/graphs/qos-graph-$qossettings{'IMQ_DEV'}.png" />
 151 END
 152 ;}
 153
 154
 155 &Header::closebox();
 156 &Header::closebigbox();
 157 &Header::closepage();
 158
 159 sub gengraph {
 160         $qossettings{'DEV'} = shift;
 161         $qossettings{'CLASS'} = shift;
 162         my $ERROR="";
 163         if ( $qossettings{'DEV'} eq $qossettings{'RED_DEV'} ) {
 164                 $qossettings{'CLASSPRFX'} = '1';
 165         } else {
 166                 $qossettings{'CLASSPRFX'} = '2';
 167         }
 168         my $color=random_hex_color(6);
 169
 170         RRDs::graph ("/srv/web/ipfire/html/graphs/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}-packets.png",
 171                 "--start", "-3240", "-aPNG", "-i", "-z",
 172                 "--alt-y-grid", "-w 600", "-h 150", "-r",
 173                 "--color", "SHADEA#EAE9EE",
 174                 "--color", "SHADEB#EAE9EE",
 175                 "--color", "BACK#FFFFFF",
 176                 "-t $qossettings{'CLASS'} ($qossettings{'DEV'})",
 177                 "DEF:pkts=/var/log/rrd/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}.rrd:pkts:AVERAGE",
 178                 "DEF:dropped=/var/log/rrd/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}.rrd:dropped:AVERAGE",
 179                 "DEF:overlimits=/var/log/rrd/class_$qossettings{'CLASSPRFX'}-$qossettings{'CLASS'}_$qossettings{'DEV'}.rrd:overlimits:AVERAGE",
 180                 "AREA:pkts$color:packets",
 181                 "GPRINT:pkts:LAST:total packets\\:%8.3lf %s packets\\j",
 182                 "LINE3:dropped#FF0000:dropped",
 183                 "GPRINT:dropped:LAST:dropped packets\\:%8.3lf %s packets\\j",
 184                 "LINE3:overlimits#0000FF:overlimits",
 185                 "GPRINT:overlimits:LAST:overlimits\\:%8.3lf %s packets\\j",
 186         );
 187 }
 188
 189
 190 sub overviewgraph {
 191         $qossettings{'DEV'} = shift;
 192         if ( $qossettings{'DEV'} eq $qossettings{'RED_DEV'} ) {
 193                 $qossettings{'CLASSPRFX'} = '1';
 194         } else {
 195                 $qossettings{'CLASSPRFX'} = '2';
 196         }
 197         my $ERROR="";
 198         my $count="1";
 199         my $color="#000000";
 200         my @command=("/srv/web/ipfire/html/graphs/qos-graph-$qossettings{'DEV'}.png",
 201                 "--start", "-3240", "-aPNG", "-i", "-z",
 202                 "--alt-y-grid", "-w 600", "-h 150", "-r",
 203                 "--color", "SHADEA#EAE9EE",
 204                 "--color", "SHADEB#EAE9EE",
 205                 "--color", "BACK#FFFFFF",
 206                 "-t Auslastung auf ($qossettings{'DEV'})"
 207         );
 208         open( FILE, "< $classfile" ) or die "Unable to read $classfile";
 209         @classes = <FILE>;
 210         close FILE;
 211         foreach $classentry (sort @classes)
 212         {
 213                 @classline = split( /\;/, $classentry );
 214                 if ( $classline[0] eq $qossettings{'DEV'} )
 215                 {
 216                         $color=random_hex_color(6);
 217                         push(@command, "DEF:$classline[1]=/var/log/rrd/class_$qossettings{'CLASSPRFX'}-$classline[1]_$qossettings{'DEV'}.rrd:bits:AVERAGE");
 218
 219                         if ($count eq "1") {
 220                                 push(@command, "AREA:$classline[1]$color:Klasse $classline[1] - $classline[8]\\j");
 221                         } else {
 222                                 push(@command, "STACK:$classline[1]$color:Klasse $classline[1] - $classline[8]\\j");
 223                         }
 224                         $count++;
 225                 }
 226         }
 227         RRDs::graph (@command);
 228 }
 229
 230 sub random_hex_color {
 231     my $size = shift;
 232     $size = 6 if $size !~ /^3|6$/;
 233     my @hex = ( 0 .. 9, 'a' .. 'f' );
 234     my @color;
 235     push @color, @hex[rand(@hex)] for 1 .. $size;
 236     return join('', '#', @color);
 237 }