[people/pmueller/ipfire-2.x.git] / html / cgi-bin / getrrdimage.cgi

#!/usr/bin/perl
###############################################################################
#                                                                             #
# IPFire.org - A linux based firewall                                         #
# Copyright (C) 2005-2021  IPFire Team                                        #
#                                                                             #
# This program is free software: you can redistribute it and/or modify        #
# it under the terms of the GNU General Public License as published by        #
# the Free Software Foundation, either version 3 of the License, or           #
# (at your option) any later version.                                         #
#                                                                             #
# This program is distributed in the hope that it will be useful,             #
# but WITHOUT ANY WARRANTY; without even the implied warranty of              #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
# GNU General Public License for more details.                                #
#                                                                             #
# You should have received a copy of the GNU General Public License           #
# along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
#                                                                             #
###############################################################################

use strict;
use URI;
use Text::Wrap;
use experimental 'smartmatch';

# debugging
#use warnings;
#use CGI::Carp 'fatalsToBrowser';

require '/var/ipfire/general-functions.pl';
require "${General::swroot}/lang.pl";
require "${General::swroot}/header.pl";
require "${General::swroot}/graphs.pl";

# List of graph origins that getrrdimage.cgi can process directly
# (unknown origins are forwarded to ensure compatibility)
my @supported_origins = ("hardwaregraphs.cgi", "media.cgi",
	"memory.cgi", "netexternal.cgi", "netinternal.cgi", "netother.cgi",
	"netovpnrw.cgi", "netovpnsrv.cgi", "qos.cgi", "services.cgi", "system.cgi");

### Process GET parameters ###
# URL format: /?origin=[graph origin cgi]&graph=[graph name]&range=[time range]
my $uri = URI->new($ENV{'REQUEST_URI'});
my %query = $uri->query_form;

my $origin = lc ($query{'origin'} // ''); # lower case
my $graph = $query{'graph'} // '';
my $range = lc ($query{'range'} // ''); # lower case

# Check parameters
unless(($origin =~ /^\w+?\.cgi$/) && ($graph =~ /^[\w\-.,; ]+?$/) && ($range ~~ @Graphs::time_ranges)) {
	# Send HTTP headers
	_start_svg_output();

	_print_error("URL parameters missing or malformed.");
	exit;
}

# Unsupported graph origin: Redirect request to the CGI specified in the "origin" parameter
# This enables backwards compatibility with addons that use Graphs::makegraphbox to ouput their own graphs
unless(($origin ~~ @supported_origins) || ($origin eq "getrrdimage.cgi")) {
	# Rewrite to old URL format: /[graph origin cgi]?[graph name]?[time range]
	my $location = "https://$ENV{'SERVER_NAME'}:$ENV{'SERVER_PORT'}/cgi-bin/${origin}?${graph}?${range}";

	# Send HTTP redirect
	print "Status: 302 Found\n";
	print "Location: $location\n";
	print "Content-type: text/html; charset=UTF-8\n";
	print "\n"; # End of HTTP headers

	print "Unsupported origin, request redirected to '$location'";
	exit;
}

### Create graphs ###
# Send HTTP headers
_start_svg_output();

# Graphs are first grouped by their origin.
# This is because some graph categories require special parameter handling.
my $graphstatus = '';
if($origin eq "hardwaregraphs.cgi") {		## hardwaregraphs.cgi
	if($graph eq "hwtemp") {
		$graphstatus = Graphs::updatehwtempgraph($range);
	} elsif($graph eq "hwfan") {
		$graphstatus = Graphs::updatehwfangraph($range);
	} elsif($graph eq "hwvolt") {
		$graphstatus = Graphs::updatehwvoltgraph($range);
	} elsif($graph eq "thermaltemp") {
		$graphstatus = Graphs::updatethermaltempgraph($range);
	} elsif($graph =~ "sd?") {
		$graphstatus = Graphs::updatehddgraph($graph, $range);
	} elsif($graph =~ "nvme?") {
		$graphstatus = Graphs::updatehddgraph($graph, $range);
	} else {
		$graphstatus = "Unknown graph name.";
	}
# ------

} elsif($origin eq "media.cgi") {			## media.cgi
	if ($graph =~ "sd?" || $graph =~ "mmcblk?" || $graph =~ "nvme?n?" || $graph =~ "xvd??" || $graph =~ "vd?" || $graph =~ "md*" ) {
		$graphstatus = Graphs::updatediskgraph($graph, $range);
	} else {
		$graphstatus = "Unknown graph name.";
	}
# ------

} elsif($origin eq "memory.cgi") {			## memory.cgi
	if($graph eq "memory") {
		$graphstatus = Graphs::updatememorygraph($range);
	} elsif($graph eq "swap") {
		$graphstatus = Graphs::updateswapgraph($range);
	} else {
		$graphstatus = "Unknown graph name.";
	}
# ------

} elsif($origin eq "netexternal.cgi") {		## netexternal.cgi
	$graphstatus = Graphs::updateifgraph($graph, $range);
# ------

} elsif($origin eq "netinternal.cgi") {		## netinternal.cgi
	if ($graph =~ /wireless/){
		$graph =~ s/wireless//g;
		$graphstatus = Graphs::updatewirelessgraph($graph, $range);
	} else {
		$graphstatus = Graphs::updateifgraph($graph, $range);
	}
# ------

} elsif($origin eq "netother.cgi") {		## netother.cgi
	if($graph eq "conntrack") {
		$graphstatus = Graphs::updateconntrackgraph($range);
	} elsif($graph eq "fwhits") {
		$graphstatus = Graphs::updatefwhitsgraph($range);
	} else {
		$graphstatus = Graphs::updatepinggraph($graph, $range);
	}
# ------

} elsif($origin eq "netovpnrw.cgi") {		## netovpnrw.cgi
	if($graph ne "UNDEF") {
		$graphstatus = Graphs::updatevpngraph($graph, $range);
	} else {
		$graphstatus = "Unknown graph name.";
	}
# ------

} elsif($origin eq "netovpnsrv.cgi") {		## netovpnsrv.cgi
	if ($graph =~ /ipsec-/){
		$graph =~ s/ipsec-//g;
		$graphstatus = Graphs::updateifgraph($graph, $range);
	} else {
		$graphstatus = Graphs::updatevpnn2ngraph($graph, $range);
	}
# ------

} elsif($origin eq "qos.cgi") { 			## qos.cgi
	$graphstatus = Graphs::updateqosgraph($graph, $range);
# ------

} elsif($origin eq "services.cgi") {		## services.cgi
	if($graph eq "processescpu") {
		$graphstatus = Graphs::updateprocessescpugraph($range);
	} elsif($graph eq "processesmemory") {
		$graphstatus = Graphs::updateprocessesmemorygraph($range);
	} else {
		$graphstatus = "Unknown graph name.";
	}
# ------

} elsif($origin eq "system.cgi") { 			## system.cgi
	if($graph eq "cpu") {
		$graphstatus = Graphs::updatecpugraph($range);
	} elsif($graph eq "cpufreq") {
		$graphstatus = Graphs::updatecpufreqgraph($range);
	} elsif($graph eq "load") {
		$graphstatus = Graphs::updateloadgraph($range);
	} else {
		$graphstatus = "Unknown graph name.";
	}
# ------

} else {
	$graphstatus = "Unknown graph origin.";
}

### Print error message ###
# Add request parameters for debugging
if($graphstatus) {
	$graphstatus = "$graphstatus\n($origin, $graph, $range)";

	# Save message in system log for further inspection
	General::log($graphstatus);

	_print_error($graphstatus);
}

###--- Internal functions ---###

# Send HTTP headers
# (don't print any non-image data to STDOUT afterwards)
sub _start_svg_output {
	print "Cache-Control: no-cache, no-store\n";
	print "Content-Type: image/svg+xml\n";
	print "\n"; # End of HTTP headers
}

# Print error message to SVG output
sub _print_error {
	my ($message) = @_;

	# Prepare image options
	my %img = (
		'width' => $Graphs::image_size{'width'},
		'height' => $Graphs::image_size{'height'},
		'text_center' => int($Graphs::image_size{'width'} / 2),
		'line_height' => 20,
		'font_family' => "DejaVu Sans, Helvetica, sans-serif" # Matching the IPFire theme
	);

	# Line-wrap message to fit image (adjust to font width if necessary)
	local($Text::Wrap::columns) = int($img{'width'} / 10);
	$message = wrap('', '', $message);

	# Create new image with fixed background and border
	print <<END
<?xml version="1.0" encoding="UTF-8"?>
<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">
	<!-- Background -->
	<rect width="100%" height="100%" fill="white"/>
	<rect width="100%" height="100%" fill="none" stroke="red" stroke-width="2" transform="scale(0.95)" transform-origin="center"/>
	<!-- Message -->
	<text x="$img{'text_center'}" y="50" font-size="20" font-family="$img{'font_family'}" text-anchor="middle">- $Lang::tr{'error'} -</text>
	<text x="$img{'text_center'}" y="90" font-size="14" font-family="$img{'font_family'}" text-anchor="middle">
END
;

	# Print message lines
	my $shift_y = 0; # Shifts text along y-axis
	foreach my $line (split(/\n/, $message)) {
		if($line ne "") { # Don't create empty tspan elements
			print <<END
		<tspan x="$img{'text_center'}" dy="$shift_y">$line</tspan>
END
;
			$shift_y = $img{'line_height'};
		} else { # Create blank lines by summing up unused line height
			$shift_y += $img{'line_height'};
		}
	}

	# Finish SVG output
	print <<END
	</text>
</svg>
END
;
}
Commit	Line	Data
910f1e84 LAH	1	#!/usr/bin/perl
	2	###############################################################################
	3	# #
	4	# IPFire.org - A linux based firewall #
	5	# Copyright (C) 2005-2021 IPFire Team #
	6	# #
	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. #
	11	# #
	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. #
	16	# #
	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/>. #
	19	# #
	20	###############################################################################
	21
	22	use strict;
	23	use URI;
fd7a0226	24	use Text::Wrap;
910f1e84 LAH	25	use experimental 'smartmatch';
	26
	27	# debugging
	28	#use warnings;
	29	#use CGI::Carp 'fatalsToBrowser';
	30
	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";
	35
	36	# List of graph origins that getrrdimage.cgi can process directly
	37	# (unknown origins are forwarded to ensure compatibility)
138b26e0	38	my @supported_origins = ("hardwaregraphs.cgi", "media.cgi",
6eb9d445 LAH	39	"memory.cgi", "netexternal.cgi", "netinternal.cgi", "netother.cgi",
6eb9d445 LAH	40	"netovpnrw.cgi", "netovpnsrv.cgi", "qos.cgi", "services.cgi", "system.cgi");
910f1e84 LAH	41
	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;
	46
4c04960b LAH	47	my $origin = lc ($query{'origin'} // ''); # lower case
	48	my $graph = $query{'graph'} // '';
	49	my $range = lc ($query{'range'} // ''); # lower case
910f1e84 LAH	50
910f1e84 LAH	51	# Check parameters
a276dfba	52	unless(($origin =~ /^\w+?\.cgi$/) && ($graph =~ /^[\w\-.,; ]+?$/) && ($range ~~ @Graphs::time_ranges)) {
910f1e84	53	# Send HTTP headers
fd7a0226	54	_start_svg_output();
66c36198 PM	55
66c36198 PM	56	_print_error("URL parameters missing or malformed.");
910f1e84 LAH	57	exit;
	58	}
	59
	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
c095f814	62	unless(($origin ~~ @supported_origins) \|\| ($origin eq "getrrdimage.cgi")) {
910f1e84 LAH	63	# Rewrite to old URL format: /[graph origin cgi]?[graph name]?[time range]
910f1e84 LAH	64	my $location = "https://$ENV{'SERVER_NAME'}:$ENV{'SERVER_PORT'}/cgi-bin/${origin}?${graph}?${range}";
66c36198	65
910f1e84 LAH	66	# Send HTTP redirect
	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
66c36198	71
910f1e84 LAH	72	print "Unsupported origin, request redirected to '$location'";
	73	exit;
	74	}
	75
	76	### Create graphs ###
	77	# Send HTTP headers
fd7a0226	78	_start_svg_output();
910f1e84 LAH	79
	80	# Graphs are first grouped by their origin.
	81	# This is because some graph categories require special parameter handling.
	82	my $graphstatus = '';
138b26e0	83	if($origin eq "hardwaregraphs.cgi") { ## hardwaregraphs.cgi
910f1e84 LAH	84	if($graph eq "hwtemp") {
	85	$graphstatus = Graphs::updatehwtempgraph($range);
	86	} elsif($graph eq "hwfan") {
	87	$graphstatus = Graphs::updatehwfangraph($range);
	88	} elsif($graph eq "hwvolt") {
	89	$graphstatus = Graphs::updatehwvoltgraph($range);
	90	} elsif($graph eq "thermaltemp") {
	91	$graphstatus = Graphs::updatethermaltempgraph($range);
	92	} elsif($graph =~ "sd?") {
	93	$graphstatus = Graphs::updatehddgraph($graph, $range);
	94	} elsif($graph =~ "nvme?") {
	95	$graphstatus = Graphs::updatehddgraph($graph, $range);
	96	} else {
	97	$graphstatus = "Unknown graph name.";
	98	}
	99	# ------
	100
	101	} elsif($origin eq "media.cgi") { ## media.cgi
	102	if ($graph =~ "sd?" \|\| $graph =~ "mmcblk?" \|\| $graph =~ "nvme?n?" \|\| $graph =~ "xvd??" \|\| $graph =~ "vd?" \|\| $graph =~ "md*" ) {
	103	$graphstatus = Graphs::updatediskgraph($graph, $range);
	104	} else {
	105	$graphstatus = "Unknown graph name.";
	106	}
	107	# ------
	108
	109	} elsif($origin eq "memory.cgi") { ## memory.cgi
	110	if($graph eq "memory") {
	111	$graphstatus = Graphs::updatememorygraph($range);
	112	} elsif($graph eq "swap") {
	113	$graphstatus = Graphs::updateswapgraph($range);
	114	} else {
	115	$graphstatus = "Unknown graph name.";
	116	}
	117	# ------
	118
	119	} elsif($origin eq "netexternal.cgi") { ## netexternal.cgi
	120	$graphstatus = Graphs::updateifgraph($graph, $range);
	121	# ------
	122
	123	} elsif($origin eq "netinternal.cgi") { ## netinternal.cgi
	124	if ($graph =~ /wireless/){
	125	$graph =~ s/wireless//g;
	126	$graphstatus = Graphs::updatewirelessgraph($graph, $range);
	127	} else {
	128	$graphstatus = Graphs::updateifgraph($graph, $range);
	129	}
	130	# ------
	131
	132	} elsif($origin eq "netother.cgi") { ## netother.cgi
	133	if($graph eq "conntrack") {
	134	$graphstatus = Graphs::updateconntrackgraph($range);
	135	} elsif($graph eq "fwhits") {
	136	$graphstatus = Graphs::updatefwhitsgraph($range);
	137	} else {
	138	$graphstatus = Graphs::updatepinggraph($graph, $range);
	139	}
	140	# ------
	141
	142	} elsif($origin eq "netovpnrw.cgi") { ## netovpnrw.cgi
	143	if($graph ne "UNDEF") {
	144	$graphstatus = Graphs::updatevpngraph($graph, $range);
	145	} else {
	146	$graphstatus = "Unknown graph name.";
	147	}
148	# ------
149
150	} elsif($origin eq "netovpnsrv.cgi") { ## netovpnsrv.cgi
151	if ($graph =~ /ipsec-/){
152	$graph =~ s/ipsec-//g;
153	$graphstatus = Graphs::updateifgraph($graph, $range);
154	} else {
155	$graphstatus = Graphs::updatevpnn2ngraph($graph, $range);
156	}
157	# ------
158
159	} elsif($origin eq "qos.cgi") { ## qos.cgi
160	$graphstatus = Graphs::updateqosgraph($graph, $range);
161	# ------
162
163	} elsif($origin eq "services.cgi") { ## services.cgi
164	if($graph eq "processescpu") {
165	$graphstatus = Graphs::updateprocessescpugraph($range);
166	} elsif($graph eq "processesmemory") {
167	$graphstatus = Graphs::updateprocessesmemorygraph($range);
168	} else {
169	$graphstatus = "Unknown graph name.";
170	}
171	# ------
172
173	} elsif($origin eq "system.cgi") { ## system.cgi
174	if($graph eq "cpu") {
175	$graphstatus = Graphs::updatecpugraph($range);
176	} elsif($graph eq "cpufreq") {
177	$graphstatus = Graphs::updatecpufreqgraph($range);
178	} elsif($graph eq "load") {
179	$graphstatus = Graphs::updateloadgraph($range);
180	} else {
181	$graphstatus = "Unknown graph name.";
182	}
183	# ------
184
185	} else {
186	$graphstatus = "Unknown graph origin.";
187	}
188
189	### Print error message ###
190	# Add request parameters for debugging
191	if($graphstatus) {
192	$graphstatus = "$graphstatus\n($origin, $graph, $range)";
c095f814 LAH	193
	194	# Save message in system log for further inspection
	195	General::log($graphstatus);
	196
910f1e84 LAH	197	_print_error($graphstatus);
	198	}
	199
	200	###--- Internal functions ---###
	201
fd7a0226	202	# Send HTTP headers
910f1e84	203	# (don't print any non-image data to STDOUT afterwards)
fd7a0226	204	sub _start_svg_output {
910f1e84	205	print "Cache-Control: no-cache, no-store\n";
fd7a0226	206	print "Content-Type: image/svg+xml\n";
910f1e84	207	print "\n"; # End of HTTP headers
910f1e84 LAH	208	}
910f1e84 LAH	209
fd7a0226	210	# Print error message to SVG output
910f1e84 LAH	211	sub _print_error {
910f1e84 LAH	212	my ($message) = @_;
910f1e84	213
fd7a0226 LAH	214	# Prepare image options
	215	my %img = (
	216	'width' => $Graphs::image_size{'width'},
	217	'height' => $Graphs::image_size{'height'},
	218	'text_center' => int($Graphs::image_size{'width'} / 2),
	219	'line_height' => 20,
	220	'font_family' => "DejaVu Sans, Helvetica, sans-serif" # Matching the IPFire theme
910f1e84	221	);
910f1e84	222
fd7a0226 LAH	223	# Line-wrap message to fit image (adjust to font width if necessary)
	224	local($Text::Wrap::columns) = int($img{'width'} / 10);
	225	$message = wrap('', '', $message);
	226
	227	# Create new image with fixed background and border
	228	print <<END
	229	<?xml version="1.0" encoding="UTF-8"?>
	230	<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">
	231	<!-- Background -->
	232	<rect width="100%" height="100%" fill="white"/>
	233	<rect width="100%" height="100%" fill="none" stroke="red" stroke-width="2" transform="scale(0.95)" transform-origin="center"/>
	234	<!-- Message -->
	235	<text x="$img{'text_center'}" y="50" font-size="20" font-family="$img{'font_family'}" text-anchor="middle">- $Lang::tr{'error'} -</text>
	236	<text x="$img{'text_center'}" y="90" font-size="14" font-family="$img{'font_family'}" text-anchor="middle">
	237	END
	238	;
	239
	240	# Print message lines
	241	my $shift_y = 0; # Shifts text along y-axis
	242	foreach my $line (split(/\n/, $message)) {
	243	if($line ne "") { # Don't create empty tspan elements
	244	print <<END
	245	<tspan x="$img{'text_center'}" dy="$shift_y">$line</tspan>
	246	END
	247	;
	248	$shift_y = $img{'line_height'};
	249	} else { # Create blank lines by summing up unused line height
	250	$shift_y += $img{'line_height'};
	251	}
	252	}
	253
	254	# Finish SVG output
	255	print <<END
	256	</text>
	257	</svg>
	258	END
	259	;
910f1e84	260	}