html/cgi-bin/getrrdimage.cgi

   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;
  24 use Text::Wrap;
  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)
  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");
  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
  47 my $origin = lc $query{'origin'}; # lower case
  48 my $graph = $query{'graph'};
  49 my $range = lc $query{'range'}; # lower case
  50
  51 # Check parameters
  52 unless(($origin =~ /^\w+?\.cgi$/) && ($graph =~ /^[\w\-.,; ]+?$/) && ($range ~~ @Graphs::time_ranges)) {
  53         # Send HTTP headers
  54         _start_svg_output();
  55
  56         _print_error("URL parameters missing or malformed.");
  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
  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}";
  65
  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
  71
  72         print "Unsupported origin, request redirected to '$location'";
  73         exit;
  74 }
  75
  76 ### Create graphs ###
  77 # Send HTTP headers
  78 _start_svg_output();
  79
  80 # Graphs are first grouped by their origin.
  81 # This is because some graph categories require special parameter handling.
  82 my $graphstatus = '';
  83 if($origin eq "entropy.cgi") {                          ## entropy.cgi
  84         $graphstatus = Graphs::updateentropygraph($range);
  85 # ------
  86
  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);
 100         } else {
 101                 $graphstatus = "Unknown graph name.";
 102         }
 103 # ------
 104
 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);
 108         } else {
 109                 $graphstatus = "Unknown graph name.";
 110         }
 111 # ------
 112
 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);
 118         } else {
 119                 $graphstatus = "Unknown graph name.";
 120         }
 121 # ------
 122
 123 } elsif($origin eq "netexternal.cgi") {         ## netexternal.cgi
 124         $graphstatus = Graphs::updateifgraph($graph, $range);
 125 # ------
 126
 127 } elsif($origin eq "netinternal.cgi") {         ## netinternal.cgi
 128         if ($graph =~ /wireless/){
 129                 $graph =~ s/wireless//g;
 130                 $graphstatus = Graphs::updatewirelessgraph($graph, $range);
 131         } else {
 132                 $graphstatus = Graphs::updateifgraph($graph, $range);
 133         }
 134 # ------
 135
 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);
 141         } else {
 142                 $graphstatus = Graphs::updatepinggraph($graph, $range);
 143         }
 144 # ------
 145
 146 } elsif($origin eq "netovpnrw.cgi") {           ## netovpnrw.cgi
 147         if($graph ne "UNDEF") {
 148                 $graphstatus = Graphs::updatevpngraph($graph, $range);
 149         } else {
 150                 $graphstatus = "Unknown graph name.";
 151         }
 152 # ------
 153
 154 } elsif($origin eq "netovpnsrv.cgi") {          ## netovpnsrv.cgi
 155         if ($graph =~ /ipsec-/){
 156                 $graph =~ s/ipsec-//g;
 157                 $graphstatus = Graphs::updateifgraph($graph, $range);
 158         } else {
 159                 $graphstatus = Graphs::updatevpnn2ngraph($graph, $range);
 160         }
 161 # ------
 162
 163 } elsif($origin eq "qos.cgi") {                         ## qos.cgi
 164         $graphstatus = Graphs::updateqosgraph($graph, $range);
 165 # ------
 166
 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);
 172         } else {
 173                 $graphstatus = "Unknown graph name.";
 174         }
 175 # ------
 176
 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);
 184         } else {
 185                 $graphstatus = "Unknown graph name.";
 186         }
 187 # ------
 188
 189 } else {
 190         $graphstatus = "Unknown graph origin.";
 191 }
 192
 193 ### Print error message ###
 194 # Add request parameters for debugging
 195 if($graphstatus) {
 196         $graphstatus = "$graphstatus\n($origin, $graph, $range)";
 197
 198         # Save message in system log for further inspection
 199         General::log($graphstatus);
 200
 201         _print_error($graphstatus);
 202 }
 203
 204 ###--- Internal functions ---###
 205
 206 # Send HTTP headers
 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
 212 }
 213
 214 # Print error message to SVG output
 215 sub _print_error {
 216         my ($message) = @_;
 217
 218         # Prepare image options
 219         my %img = (
 220                 'width' => $Graphs::image_size{'width'},
 221                 'height' => $Graphs::image_size{'height'},
 222                 'text_center' => int($Graphs::image_size{'width'} / 2),
 223                 'line_height' => 20,
 224                 'font_family' => "DejaVu Sans, Helvetica, sans-serif" # Matching the IPFire theme
 225         );
 226
 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);
 230
 231         # Create new image with fixed background and border
 232         print <<END
 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">
 235         <!-- Background -->
 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"/>
 238         <!-- Message -->
 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">
 241 END
 242 ;
 243
 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
 248                         print <<END
 249                 <tspan x="$img{'text_center'}" dy="$shift_y">$line</tspan>
 250 END
 251 ;
 252                         $shift_y = $img{'line_height'};
 253                 } else { # Create blank lines by summing up unused line height
 254                         $shift_y += $img{'line_height'};
 255                 }
 256         }
 257
 258         # Finish SVG output
 259         print <<END
 260         </text>
 261 </svg>
 262 END
 263 ;
 264 }