]> git.ipfire.org Git - ipfire-2.x.git/blob - html/cgi-bin/qosgraph.cgi
Uploads.cgi entfernt. Die war noch ueber.
[ipfire-2.x.git] / 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 }