2 ###############################################################################
4 # IPFire.org - A linux based firewall #
5 # Copyright (C) 2005-2021 IPFire Team #
7 # This program is free software: you can redistribute it and/or modify #
8 # it under the terms of the GNU General Public License as published by #
9 # the Free Software Foundation, either version 3 of the License, or #
10 # (at your option) any later version. #
12 # This program is distributed in the hope that it will be useful, #
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of #
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
15 # GNU General Public License for more details. #
17 # You should have received a copy of the GNU General Public License #
18 # along with this program. If not, see <http://www.gnu.org/licenses/>. #
20 ###############################################################################
25 use experimental
'smartmatch';
29 #use CGI::Carp 'fatalsToBrowser';
31 require '/var/ipfire/general-functions.pl';
32 require "${General::swroot}/lang.pl";
33 require "${General::swroot}/header.pl";
34 require "${General::swroot}/graphs.pl";
36 # List of graph origins that getrrdimage.cgi can process directly
37 # (unknown origins are forwarded to ensure compatibility)
38 my @supported_origins = ("entropy.cgi", "hardwaregraphs.cgi", "media.cgi",
39 "memory.cgi", "netexternal.cgi", "netinternal.cgi", "netother.cgi",
40 "netovpnrw.cgi", "netovpnsrv.cgi", "qos.cgi", "services.cgi", "system.cgi");
42 ### Process GET parameters ###
43 # URL format: /?origin=[graph origin cgi]&graph=[graph name]&range=[time range]
44 my $uri = URI
->new($ENV{'REQUEST_URI'});
45 my %query = $uri->query_form;
47 my $origin = lc $query{'origin'}; # lower case
48 my $graph = $query{'graph'};
49 my $range = lc $query{'range'}; # lower case
52 unless(($origin =~ /^\w+?\.cgi$/) && ($graph =~ /^[\w\-.,; ]+?$/) && ($range ~~ @Graphs::time_ranges
)) {
56 _print_error
("URL parameters missing or malformed.");
60 # Unsupported graph origin: Redirect request to the CGI specified in the "origin" parameter
61 # This enables backwards compatibility with addons that use Graphs::makegraphbox to ouput their own graphs
62 unless(($origin ~~ @supported_origins) || ($origin eq "getrrdimage.cgi")) {
63 # Rewrite to old URL format: /[graph origin cgi]?[graph name]?[time range]
64 my $location = "https://$ENV{'SERVER_NAME'}:$ENV{'SERVER_PORT'}/cgi-bin/${origin}?${graph}?${range}";
67 print "Status: 302 Found\n";
68 print "Location: $location\n";
69 print "Content-type: text/html; charset=UTF-8\n";
70 print "\n"; # End of HTTP headers
72 print "Unsupported origin, request redirected to '$location'";
80 # Graphs are first grouped by their origin.
81 # This is because some graph categories require special parameter handling.
83 if($origin eq "entropy.cgi") { ## entropy.cgi
84 $graphstatus = Graphs
::updateentropygraph
($range);
87 } elsif($origin eq "hardwaregraphs.cgi") { ## hardwaregraphs.cgi
88 if($graph eq "hwtemp") {
89 $graphstatus = Graphs
::updatehwtempgraph
($range);
90 } elsif($graph eq "hwfan") {
91 $graphstatus = Graphs
::updatehwfangraph
($range);
92 } elsif($graph eq "hwvolt") {
93 $graphstatus = Graphs
::updatehwvoltgraph
($range);
94 } elsif($graph eq "thermaltemp") {
95 $graphstatus = Graphs
::updatethermaltempgraph
($range);
96 } elsif($graph =~ "sd?") {
97 $graphstatus = Graphs
::updatehddgraph
($graph, $range);
98 } elsif($graph =~ "nvme?") {
99 $graphstatus = Graphs
::updatehddgraph
($graph, $range);
101 $graphstatus = "Unknown graph name.";
105 } elsif($origin eq "media.cgi") { ## media.cgi
106 if ($graph =~ "sd?" || $graph =~ "mmcblk?" || $graph =~ "nvme?n?" || $graph =~ "xvd??" || $graph =~ "vd?" || $graph =~ "md*" ) {
107 $graphstatus = Graphs
::updatediskgraph
($graph, $range);
109 $graphstatus = "Unknown graph name.";
113 } elsif($origin eq "memory.cgi") { ## memory.cgi
114 if($graph eq "memory") {
115 $graphstatus = Graphs
::updatememorygraph
($range);
116 } elsif($graph eq "swap") {
117 $graphstatus = Graphs
::updateswapgraph
($range);
119 $graphstatus = "Unknown graph name.";
123 } elsif($origin eq "netexternal.cgi") { ## netexternal.cgi
124 $graphstatus = Graphs
::updateifgraph
($graph, $range);
127 } elsif($origin eq "netinternal.cgi") { ## netinternal.cgi
128 if ($graph =~ /wireless/){
129 $graph =~ s/wireless//g;
130 $graphstatus = Graphs
::updatewirelessgraph
($graph, $range);
132 $graphstatus = Graphs
::updateifgraph
($graph, $range);
136 } elsif($origin eq "netother.cgi") { ## netother.cgi
137 if($graph eq "conntrack") {
138 $graphstatus = Graphs
::updateconntrackgraph
($range);
139 } elsif($graph eq "fwhits") {
140 $graphstatus = Graphs
::updatefwhitsgraph
($range);
142 $graphstatus = Graphs
::updatepinggraph
($graph, $range);
146 } elsif($origin eq "netovpnrw.cgi") { ## netovpnrw.cgi
147 if($graph ne "UNDEF") {
148 $graphstatus = Graphs
::updatevpngraph
($graph, $range);
150 $graphstatus = "Unknown graph name.";
154 } elsif($origin eq "netovpnsrv.cgi") { ## netovpnsrv.cgi
155 if ($graph =~ /ipsec-/){
156 $graph =~ s/ipsec-//g;
157 $graphstatus = Graphs
::updateifgraph
($graph, $range);
159 $graphstatus = Graphs
::updatevpnn2ngraph
($graph, $range);
163 } elsif($origin eq "qos.cgi") { ## qos.cgi
164 $graphstatus = Graphs
::updateqosgraph
($graph, $range);
167 } elsif($origin eq "services.cgi") { ## services.cgi
168 if($graph eq "processescpu") {
169 $graphstatus = Graphs
::updateprocessescpugraph
($range);
170 } elsif($graph eq "processesmemory") {
171 $graphstatus = Graphs
::updateprocessesmemorygraph
($range);
173 $graphstatus = "Unknown graph name.";
177 } elsif($origin eq "system.cgi") { ## system.cgi
178 if($graph eq "cpu") {
179 $graphstatus = Graphs
::updatecpugraph
($range);
180 } elsif($graph eq "cpufreq") {
181 $graphstatus = Graphs
::updatecpufreqgraph
($range);
182 } elsif($graph eq "load") {
183 $graphstatus = Graphs
::updateloadgraph
($range);
185 $graphstatus = "Unknown graph name.";
190 $graphstatus = "Unknown graph origin.";
193 ### Print error message ###
194 # Add request parameters for debugging
196 $graphstatus = "$graphstatus\n($origin, $graph, $range)";
198 # Save message in system log for further inspection
199 General
::log($graphstatus);
201 _print_error
($graphstatus);
204 ###--- Internal functions ---###
207 # (don't print any non-image data to STDOUT afterwards)
208 sub _start_svg_output
{
209 print "Cache-Control: no-cache, no-store\n";
210 print "Content-Type: image/svg+xml\n";
211 print "\n"; # End of HTTP headers
214 # Print error message to SVG output
218 # Prepare image options
220 'width' => $Graphs::image_size
{'width'},
221 'height' => $Graphs::image_size
{'height'},
222 'text_center' => int($Graphs::image_size
{'width'} / 2),
224 'font_family' => "DejaVu Sans, Helvetica, sans-serif" # Matching the IPFire theme
227 # Line-wrap message to fit image (adjust to font width if necessary)
228 local($Text::Wrap
::columns
) = int($img{'width'} / 10);
229 $message = wrap
('', '', $message);
231 # Create new image with fixed background and border
233 <?xml version="1.0" encoding="UTF-8"?>
234 <svg width="$img{'width'}px" height="$img{'height'}px" viewBox="0 0 $img{'width'} $img{'height'}" version="1.1" xmlns="http://www.w3.org/2000/svg">
236 <rect width="100%" height="100%" fill="white"/>
237 <rect width="100%" height="100%" fill="none" stroke="red" stroke-width="2" transform="scale(0.95)" transform-origin="center"/>
239 <text x="$img{'text_center'}" y="50" font-size="20" font-family="$img{'font_family'}" text-anchor="middle">- $Lang::tr{'error'} -</text>
240 <text x="$img{'text_center'}" y="90" font-size="14" font-family="$img{'font_family'}" text-anchor="middle">
244 # Print message lines
245 my $shift_y = 0; # Shifts text along y-axis
246 foreach my $line (split(/\n/, $message)) {
247 if($line ne "") { # Don't create empty tspan elements
249 <tspan x="$img{'text_center'}" dy="$shift_y">$line</tspan>
252 $shift_y = $img{'line_height'};
253 } else { # Create blank lines by summing up unused line height
254 $shift_y += $img{'line_height'};