#!/usr/bin/perl
#
# Plugin to show loadtime of domains and/or URLs per hour
#
# Contributed by GwenDragon <info@gwendragon.de>
# 	(c) 2009 by GwenDragon
#	free use; but don't change copyright header
#
#	Version 0.19 BETA
#
# 	2010-06-15	GwenDragon <info@gwendragon.de>
# 	2011-04-30	GwenDragon <info@gwendragon.de>
# 	2011-08-23	GwenDragon <info@gwendragon.de>
# 	2012-07-07	GwenDragon <info@gwendragon.de>
# 	2013-06-18	GwenDragon <info@gwendragon.de>
# 	2014-09-29	GwenDragon <info@gwendragon.de>
# 	2014-10-06	replaced LWP with curl for better measurement, GwenDragon <info@gwendragon.de>
# 	2015-09-22	shorten label text, fix empty domain, GwenDragon <info@gwendragon.de>
# 	2016-07-06	shorter URLs in label, GwenDragon <info@gwendragon.de>
# 	2016-08-27	follow redirects (for SSL redir), GwenDragon <info@gwendragon.de>
# 	2018-08-01	add warn/crit level in config, GwenDragon <info@gwendragon.de>
#	2021-01-05	BETA! response_code in case of not reachable server/domain, return 0 as loadtime
#

# Magic markers - optional - used by installation scripts and
# munin-config:
#
#%# family=manual
#%# capabilities=autoconf

# configuration example
#
#   [loadtime]
#   env.usevhosts = 1
#   env.vhostsroot = /var/www/vhosts
#   env.domains = domain1.tld  domain2.tld
#   env.urls = domain1.tld/test/this.htm domain2.tld/test2/ https://domain3.tld/
#   env.report = /var/log/munin/muninplugin-loadtime.log
#   env.warning = 2
#   env.critical = 5
#

use strict;
use Fcntl qw(:flock);

my $warn_level     = $ENV{'warning'}  // 2;
my $critical_level = $ENV{'critical'} // 5;

my $usevhosts = 1;
$usevhosts = $ENV{'usevhosts'} if defined $ENV{'usevhosts'};

my $vhostsroot = $ENV{'vhostsroot'} || '/var/www/vhosts';

my @domains;
push( @domains, grep( !/^(default|chroot|fs-?|system)/, qx(ls $vhostsroot) ) )
  if $usevhosts;
push @domains, split /\s+/, $ENV{'domains'} if defined $ENV{'domains'};
chomp(@domains);

my @urls;
@urls = split( /\s+/, $ENV{'urls'} ) if defined $ENV{'urls'};
chomp(@urls);

my %domain_data;
foreach my $d (@domains) {
    my $label = $d;
    $d .= '/' if $d !~ m(/$);
    $label =~ s#^https?://##;
    $label =~ s#[^A-Za-z]#_#g;
    next if $label eq "_";
    $domain_data{$d} = [ $label, 0 ];
}
foreach my $d (@urls) {
    my $label = $d;
    $label =~ s#^https?://##;
    $label =~ s#[^A-Za-z]#_#g;
    next if $label eq "_";
    $domain_data{$d} = [ $label, 0 ];
}

if ( $ARGV[0] and $ARGV[0] eq 'autoconf' ) { print 'yes'; exit 0; }
elsif ( $ARGV[0] and $ARGV[0] eq 'config' ) {
    print <<CONFIG;
graph_title HTTP loadtime of a domain
graph_args --base 1000 -l 0
graph_vlabel Load time in seconds
graph_category network
graph_info This graph shows load time of domain/URL in seconds
CONFIG

    for my $domain ( keys %domain_data ) {
        my $label = $domain_data{$domain}->[0];
        print "$label.label ", short_label($domain), "\n";
        print "$label.draw LINE1\n";
        print "$label.info Load time of $domain\n";
        print "$label.warning $warn_level\n";
		print "$label.critical $critical_level\n";
    }
    exit 0;
} ## end elsif ( $ARGV[0] and $ARGV...)

###
my $ua = 'CheckLoadTime/0.4 (Web page response checker)';
my $cmd
  = '/usr/bin/curl' . q( -L) . q( -s)
  . qq( --user-agent "$ua")
  . q( --connect-timeout 15)
  . q( -o /dev/null)
  . q( --write-out)
  # Add HTTP response code in timimng string for later check
  . q( "#TIMING R:%{response_code}# L:%{time_namelookup} C:%{time_connect} T:%{time_starttransfer} F:%{time_total} #\n");

for my $domain ( keys %domain_data ) {
    my $d = $domain;
    $d = "http://$d" if $d !~ m(^https?://);

    open( my $fh, "$cmd --url $d |" );
    while ( my $line = <$fh> ) {
		my $elapsed;
		my $response;
        if ( $line =~ /#TIMING R:(\d+)#\s/ ) {             
		    $response = $1;
            if ($response != 200) { # response from server, 200=Success
               $elapsed = 0;        # means: error, time to fetch URL can never be 0
	    	}
            else { 
               ($elapsed) = $line =~ /F:(\d+\.\d+)/; # extract full transfer loadtime
            }
            $domain_data{$domain}->[1] = $elapsed;
            last;
        }
    }
    close $fh;
}

foreach my $k ( keys %domain_data ) {
	if ( $domain_data{$k}->[1] >= 0 ) { 
    	print $domain_data{$k}->[0], '.value ', $domain_data{$k}->[1], "\n";
	}
	
    # Log if out of limits
	if ( $domain_data{$k}->[1] == 0 ) { # value 0 is a error
		report_log(
            $domain_data{$k}->[0] . ' load ERROR: ' . $domain_data{$k}->[1] );
	}
    elsif ( $domain_data{$k}->[1] >= $warn_level ) {
        report_log(
            $domain_data{$k}->[0] . ' loads slow: ' . $domain_data{$k}->[1] );
    }
    elsif ( $domain_data{$k}->[1] >= $critical_level ) {
        report_log( 
            $domain_data{$k}->[0] . ' loads very slow: ' . $domain_data{$k}->[1] );
    }
}

sub short_label {
    my $label = shift;
    if ( $label =~ m|^https?://(www\.)?| ) {
        $label =~ s|^https://(www\.)?|(SSL) |;
        $label =~ s|^http://(www\.)?||;
    }
    $label = substr( $label, 0, 35 ) . '...' if length $label > 35;
    return $label;
}

sub report_log {
    my @msg     = @_;
    my $logfile = $ENV{'report'} || '/var/log/munin/muninplugin-loadtime.log';
    if ( open( my $log, '>>', $logfile ) ) {
        my $d = localtime(time);
        flock $log, LOCK_EX;
        print $log "$d ", join( "\n", @msg ), "\n";
        close $log;
    }
}

1;