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 GD;
  25 use GD::Text::Wrap;
  26 use experimental 'smartmatch';
  27
  28 # debugging
  29 #use warnings;
  30 #use CGI::Carp 'fatalsToBrowser';
  31
  32 require '/var/ipfire/general-functions.pl';
  33 require "${General::swroot}/lang.pl";
  34 require "${General::swroot}/header.pl";
  35 require "${General::swroot}/graphs.pl";
  36
  37 # List of graph origins that getrrdimage.cgi can process directly
  38 # (unknown origins are forwarded to ensure compatibility)
  39 my @supported_origins = ("entropy.cgi", "hardwaregraphs.cgi", "media.cgi",
  40         "memory.cgi","netexternal.cgi", "netinternal.cgi", "netother.cgi",
  41         "netovpnrw.cgi", "netovpnsrv.cgi", "qos.cgi", "system.cgi");
  42
  43 ### Process GET parameters ###
  44 # URL format: /?origin=[graph origin cgi]&graph=[graph name]&range=[time range]
  45 my $uri = URI->new($ENV{'REQUEST_URI'});
  46 my %query = $uri->query_form;
  47
  48 my $origin = lc $query{'origin'}; # lower case
  49 my $graph = $query{'graph'};
  50 my $range = lc $query{'range'}; # lower case
  51
  52 # Check parameters
  53 unless(($origin =~ /^\w+?\.cgi$/) && ($graph =~ /^[\w\-.,; ]+?$/) && ($range ~~ @Graphs::time_ranges)) {
  54         # Send HTTP headers
  55         _start_png_output();
  56
  57         _print_error("URL parameters missing or malformed.");
  58         exit;
  59 }
  60
  61 # Unsupported graph origin: Redirect request to the CGI specified in the "origin" parameter
  62 # This enables backwards compatibility with addons that use Graphs::makegraphbox to ouput their own graphs
  63 unless(($origin ~~ @supported_origins) || ($origin eq "getrrdimage.cgi")) {
  64         # Rewrite to old URL format: /[graph origin cgi]?[graph name]?[time range]
  65         my $location = "https://$ENV{'SERVER_NAME'}:$ENV{'SERVER_PORT'}/cgi-bin/${origin}?${graph}?${range}";
  66
  67         # Send HTTP redirect
  68         print "Status: 302 Found\n";
  69         print "Location: $location\n";
  70         print "Content-type: text/html; charset=UTF-8\n";
  71         print "\n"; # End of HTTP headers
  72
  73         print "Unsupported origin, request redirected to '$location'";
  74         exit;
  75 }
  76
  77 ### Create graphs ###
  78 # Send HTTP headers
  79 _start_png_output();
  80
  81 # Graphs are first grouped by their origin.
  82 # This is because some graph categories require special parameter handling.
  83 my $graphstatus = '';
  84 if($origin eq "entropy.cgi") {                          ## entropy.cgi
  85         $graphstatus = Graphs::updateentropygraph($range);
  86 # ------
  87
  88 } elsif($origin eq "hardwaregraphs.cgi") {      ## hardwaregraphs.cgi
  89         if($graph eq "hwtemp") {
  90                 $graphstatus = Graphs::updatehwtempgraph($range);
  91         } elsif($graph eq "hwfan") {
  92                 $graphstatus = Graphs::updatehwfangraph($range);
  93         } elsif($graph eq "hwvolt") {
  94                 $graphstatus = Graphs::updatehwvoltgraph($range);
  95         } elsif($graph eq "thermaltemp") {
  96                 $graphstatus = Graphs::updatethermaltempgraph($range);
  97         } elsif($graph =~ "sd?") {
  98                 $graphstatus = Graphs::updatehddgraph($graph, $range);
  99         } elsif($graph =~ "nvme?") {
 100                 $graphstatus = Graphs::updatehddgraph($graph, $range);
 101         } else {
 102                 $graphstatus = "Unknown graph name.";
 103         }
 104 # ------
 105
 106 } elsif($origin eq "media.cgi") {                       ## media.cgi
 107         if ($graph =~ "sd?" || $graph =~ "mmcblk?" || $graph =~ "nvme?n?" || $graph =~ "xvd??" || $graph =~ "vd?" || $graph =~ "md*" ) {
 108                 $graphstatus = Graphs::updatediskgraph($graph, $range);
 109         } else {
 110                 $graphstatus = "Unknown graph name.";
 111         }
 112 # ------
 113
 114 } elsif($origin eq "memory.cgi") {                      ## memory.cgi
 115         if($graph eq "memory") {
 116                 $graphstatus = Graphs::updatememorygraph($range);
 117         } elsif($graph eq "swap") {
 118                 $graphstatus = Graphs::updateswapgraph($range);
 119         } else {
 120                 $graphstatus = "Unknown graph name.";
 121         }
 122 # ------
 123
 124 } elsif($origin eq "netexternal.cgi") {         ## netexternal.cgi
 125         $graphstatus = Graphs::updateifgraph($graph, $range);
 126 # ------
 127
 128 } elsif($origin eq "netinternal.cgi") {         ## netinternal.cgi
 129         if ($graph =~ /wireless/){
 130                 $graph =~ s/wireless//g;
 131                 $graphstatus = Graphs::updatewirelessgraph($graph, $range);
 132         } else {
 133                 $graphstatus = Graphs::updateifgraph($graph, $range);
 134         }
 135 # ------
 136
 137 } elsif($origin eq "netother.cgi") {            ## netother.cgi
 138         if($graph eq "conntrack") {
 139                 $graphstatus = Graphs::updateconntrackgraph($range);
 140         } elsif($graph eq "fwhits") {
 141                 $graphstatus = Graphs::updatefwhitsgraph($range);
 142         } else {
 143                 $graphstatus = Graphs::updatepinggraph($graph, $range);
 144         }
 145 # ------
 146
 147 } elsif($origin eq "netovpnrw.cgi") {           ## netovpnrw.cgi
 148         if($graph ne "UNDEF") {
 149                 $graphstatus = Graphs::updatevpngraph($graph, $range);
 150         } else {
 151                 $graphstatus = "Unknown graph name.";
 152         }
 153 # ------
 154
 155 } elsif($origin eq "netovpnsrv.cgi") {          ## netovpnsrv.cgi
 156         if ($graph =~ /ipsec-/){
 157                 $graph =~ s/ipsec-//g;
 158                 $graphstatus = Graphs::updateifgraph($graph, $range);
 159         } else {
 160                 $graphstatus = Graphs::updatevpnn2ngraph($graph, $range);
 161         }
 162 # ------
 163
 164 } elsif($origin eq "qos.cgi") {                         ## qos.cgi
 165         $graphstatus = Graphs::updateqosgraph($graph, $range);
 166 # ------
 167
 168 } elsif($origin eq "services.cgi") {            ## services.cgi
 169         if($graph eq "processescpu") {
 170                 $graphstatus = Graphs::updateprocessescpugraph($range);
 171         } elsif($graph eq "processesmemory") {
 172                 $graphstatus = Graphs::updateprocessesmemorygraph($range);
 173         } else {
 174                 $graphstatus = "Unknown graph name.";
 175         }
 176 # ------
 177
 178 } elsif($origin eq "system.cgi") {                      ## system.cgi
 179         if($graph eq "cpu") {
 180                 $graphstatus = Graphs::updatecpugraph($range);
 181         } elsif($graph eq "cpufreq") {
 182                 $graphstatus = Graphs::updatecpufreqgraph($range);
 183         } elsif($graph eq "load") {
 184                 $graphstatus = Graphs::updateloadgraph($range);
 185         } else {
 186                 $graphstatus = "Unknown graph name.";
 187         }
 188 # ------
 189
 190 } else {
 191         $graphstatus = "Unknown graph origin.";
 192 }
 193
 194 ### Print error message ###
 195 # Add request parameters for debugging
 196 if($graphstatus) {
 197         $graphstatus = "$graphstatus\n($origin, $graph, $range)";
 198
 199         # Save message in system log for further inspection
 200         General::log($graphstatus);
 201
 202         _print_error($graphstatus);
 203 }
 204
 205 ###--- Internal functions ---###
 206
 207 # Send HTTP headers and switch to binary output
 208 # (don't print any non-image data to STDOUT afterwards)
 209 sub _start_png_output {
 210         print "Cache-Control: no-cache, no-store\n";
 211         print "Content-Type: image/png\n";
 212         print "\n"; # End of HTTP headers
 213         binmode(STDOUT);
 214 }
 215
 216 # Print error message to PNG output
 217 sub _print_error {
 218         my ($message) = @_;
 219         $message = "- Error -\n \n$message";
 220
 221         # Create new image with the same size as a graph
 222         my $img = GD::Image->new($Graphs::image_size{'width'}, $Graphs::image_size{'height'});
 223         $img->interlaced('true');
 224
 225         # Basic colors
 226         my $color_background = $img->colorAllocate(255, 255, 255);
 227         my $color_border = $img->colorAllocate(255, 0, 0);
 228         my $color_text = $img->colorAllocate(0, 0, 0);
 229
 230         # Background and border
 231         $img->setThickness(2);
 232         $img->filledRectangle(0, 0, $img->width, $img->height, $color_background);
 233         $img->rectangle(10, 10, $img->width - 10, $img->height - 10, $color_border);
 234
 235         # Draw message with line-wrap
 236         my $textbox = GD::Text::Wrap->new($img,
 237                 text => $message,
 238                 width => ($img->width - 50),
 239                 color => $color_text,
 240                 align => 'center',
 241                 line_space => 5,
 242                 preserve_nl => 1
 243         );
 244         $textbox->set_font(gdLargeFont);
 245         $textbox->draw(25, 25);
 246
 247         # Get PNG output
 248         print $img->png;
 249 }