munin 2.0.33-1 / usr / share / munin / munin-graph

#!/usr/bin/perl
# -*- cperl -*-

=encoding utf8

=begin comment

Copyright (C) 2004-2010 Jimmy Olsen, Steve Schnepp

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; version 2 dated June,
1991.

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/>.

$Id$

=end comment

=cut

use strict;
use warnings;
use IO::Handle;

BEGIN {
    # This is needed because Date::Manip has deprecated the functional
    # interface in >= 6.x. So, we force the use of the 5.x API.
    $Date::Manip::Backend = 'DM5';

    # Double line here to avoid spurious warnings about D::M::Backend being
    # used only once.
    $Date::Manip::Backend = 'DM5';
}
use Date::Manip;
use POSIX qw(strftime);
use Time::HiRes qw(gettimeofday tv_interval);
use IO::File;

use Munin::Master::GraphOld;
use Munin::Master::Utils;

use Munin::Master::Logger;
use Log::Log4perl qw( :easy );

my $GRAPHER = "$Munin::Common::Defaults::MUNIN_LIBDIR/munin-graph";
my $conffile = "$Munin::Common::Defaults::MUNIN_CONFDIR/munin.conf";

my %period  = ( "day"   => 300,
		"week"  => 1800,
		"month" => 7200,
		"year"  => 86400,
		"week-sum" => 1800,
		"year-sum" => 86400
	    );

my $logfile;
my $scale = "day";

my @params = @ARGV;

push @params, "--no-fork"; # We do *not* want to fork. Perf -> FastCGI
push @params, "--log-file", $logfile;

my $config = graph_startup(\@params);

logger_open($config->{'logdir'});
logger_debug() if $config->{debug} or defined($ENV{CGI_DEBUG});

if (! graph_check_cron() ) {
	# Should not be launched from cron.
	INFO "[INFO] graphing is cgi, do nothing";	
	exit 0;
}

# BEGIN FAST-CGI LOOP:
my $nb_request = 0;
my $nb_request_max = 0;
my $graph_fh = new IO::File($config->{dbdir} . "/graphs");
while (my $path = <$graph_fh>) {
    my $pinpoint = undef;
    DEBUG "Request path is $path";

    # The full URL looks like this:
    # Case 1:
    # http://localhost:8080/munin-cgi/munin-cgi-graph/client/\
    #    Backend/dafnes.client.example.com/diskstats_iops-week.png
    # $path should be
    #   client/Backend/dafnes.client.example.com/diskstats_iops-week.png
    #
    # Interesting bits about that url: Nested groups!
    #
    # Case 2:
    # http://localhost:8080/munin-cgi/munin-cgi-graph/client/\
    #    Backend/dafnes.client.example.com/diskstats_iops/sda-week.png
    # path should be
    #    client/Backend/dafnes.client.example.com/diskstats_iops/\
    #    sda-week.png
    #
    # Interesting bit that url: Nested groups at the start and multigraph
    # nesting bits at the end.
    #
    # Case 3:
    # http://localhost:8080/munin-cgi/munin-cgi-graph/client/\
    #   dafnes.client.example.com/if_err_bond0-day.png
    # path:
    #   client/dafnes.client.example.com/if_err_bond0-day.png
    #
    # Simplest (old munin 1.2): No nesting at any end, fixed number of /es
    #
    # Despite the slippery structure of the $path this expression works with
    # the rest of the code.  To make a more scientific try we would need to
    # split on / and traverse the $config to determine what kind of part
    # (domain, nested domain, host, service/plugin, or nested service)
    # we're looking at.
    #
    # Scale will in any case work out since - is only used before the
    # day/week/month/year/pinpoint part, and the next part is always .png.
    #

    my ($dom, $host, $serv, $scale) =
      $path =~ m#^/(.*)/([^/]+)/(\w+)-([\w=,]+)\.png#; ## avoid bug in vim

    DEBUG "asked for ($dom, $host, $serv, $scale)";

    if ($scale =~ /pinpoint=(\d+),(\d+)/) {
	    $pinpoint = [ $1, $2, ];
    }

    if (! &verify_parameters ($dom, $host, $serv, $scale)) {
	ERROR "Invalid parameters!";
	next;
    }

    my $filename = get_picture_filename ($config, $dom, $host, $serv, $scale, $ENV{QUERY_STRING});

    my $time = time;

    my $no_cache = 0;
    # Compute the cache values
    my $graph_ttl = $period{$scale} || 1;
    my $graph_last_expires = $time - ($time % $graph_ttl);

    if ($pinpoint || ! -f $filename || (stat(_))[9] < $graph_last_expires) {
        # Should generate it
	my $scale_options;
	if ($pinpoint) {
	    $scale_options = "--pinpoint=" . $pinpoint->[0] . "," . $pinpoint->[1];
	} else {
	    $scale_options = "--$scale";
	}
	next unless
	  draw_graph_or_complain($dom, $host, $serv, $scale_options, $filename);
    }

    # Now send it: headers
    DEBUG "X-Munin-Request: $nb_request/$nb_request_max";

} continue {
	$nb_request++;
	if ($nb_request_max && $nb_request > $nb_request_max) {
		# Cycle
		last;
	}
}
# END FAST-CGI LOOP - Time to die.  Nicely.

exit 0;

sub get_w3c_date_from_epoch {
    my($epoch) = @_;
    return strftime("%a, %d %b %Y %H:%M:%S GMT", gmtime($epoch));
}


sub send_graph_data {
    # Serve the graph contents.
    my($filename) = @_;
    my $buffer;

    if (! open (GRAPH_PNG_FILE, '<', $filename) ) {
	ERROR "[FATAL] Could not open image file \"$filename\" for reading: $!\n";
	die "[FATAL] Could not open image file \"$filename\" for reading: $!\n";
    }

    # No buffering wanted when sending the file
    local $| = 1;

    while (sysread(GRAPH_PNG_FILE,$buffer,40960)) {
	print $buffer;
    }

    close (GRAPH_PNG_FILE);
}


sub get_picture_filename {
    my $config  = shift;
    my $domain  = shift;
    my $name    = shift;
    my $service = shift;
    my $scale   = shift;
    my $params  = shift;

    my $cgi_tmp_dir = $config->{htmldir};

    $params = $params ? "?$params" : "";
    $params =~ tr/\//_/; # / are forbidden in a filename
    $params = $1 if $params =~ m/(.*)/; # XXX - Q&D untaint
    return "$cgi_tmp_dir/$domain/$name/$service-$scale.png" . $params;
}


sub verify_parameters {
    my $dom   = shift;
    my $host  = shift;
    my $serv  = shift;
    my $scale = shift;

    if (!$dom) {
	WARN '[WARNING] Request for graph without specifying domain. Bailing out.';
	return 0;
    }
    if (!$host) {
	WARN '[WARNING] Request for graph without specifying host. Bailing out.';
	return 0;
    }
    if (!$serv) {
	WARN '[WARNING] Request for graph without specifying service. Bailing out.';
	return 0;
    }

    if (!$scale) {
	WARN '[WARNING] Request for graph without specifying scale. Bailing out.';
	return 0;
    } else {
	if (!defined $period{$scale} && $scale !~ /pinpoint=\d+,\d+/) {
	    WARN '[WARNING] Weird pinpoint setting "'.$scale.'". Bailing out.';
	    return 0;
	}
    }
    return 1;
}


sub file_newer_than {
    my $filename = shift;
    my $time     = shift;

    if (-f $filename) {
	my @stats = stat (_);
	# $stats[9] holds the "last update" time and this needs
	# to be in the last update period
	my $last_update = $stats[9];
	if ($last_update > $time) {
	    return $last_update;
	} else {
	    return 0;
	}
    }

    # No file found
    return 0;
}


sub draw_graph {
    my $dom  = shift;
    my $host  = shift;
    my $serv  = shift;
    my $scale = shift;

    my $filename = shift;

    # remove old file if present
    if (-f $filename and !unlink($filename)) {
	ERROR "[FATAL] Could not remove \"$filename\": $!";
	die("[FATAL] cannot remove old graph file \"$filename\": $!");
    }

    $serv =~ s{[^\w_\/"'\[\]\(\)+=-]}{_}g; $serv =~ /^(.+)$/; $serv = $1; #"
    # . needs to be legal in host names
    $host =~ s{[^\w_\/"'\[\]\(\)\.+=-]}{_}g; $host =~ /^(.+)$/; $host = $1; #"

    # FIXME: Make "root" implied!
    my @params = ( '--host', $host,
		   '--only-fqn', "root/$dom/$host/$serv",
		   $scale,
		   '--output-file', $filename );

    graph_main(\@params);

    return $filename;
}


sub draw_graph_or_complain {
    my $t0 = [ gettimeofday ];

    # Actuall work done here.
    my $ret = draw_graph(@_);

    my $graph_duration = tv_interval($t0);

    if (! -f $ret) {
	my ($dom, $host, $serv, $scale, $filename ) = @_;
	WARN "[WARNING] Could not draw graph \"$filename\": $ret";
        return 0;
    } else {
	return $ret;
    }
}


sub rfctime_newer_than {
    # See if the file has been modified since "the last time".
    # Format of since_string If-Modified-Since: Wed, 23 Jun 2004 16:11:06 GMT
    my $since_string = shift;
    my $created      = shift;
    my $ifmodsec = &UnixDate (&ParseDateString ($since_string), "%s");

    return 1 if ($ifmodsec < $created);
    return 0;
}

# vim: syntax=perl ts=8