#!/usr/bin/perl 

# Copyright 2007, Robert Auch, totalnetsolutions.net.
# This script accesses websites and sends an email ONLY if
# one of them is down (avoiding false-positives).
# This script requires chk-web.ini to work properly.
# Formatting of chk-web.ini explained inside parseIni()
# chk-web.ini created automatically with initial data if it's missing

# Mail server settings stored in %mailSettings after read from INI

use strict; 
#use warnings;
use LWP::UserAgent;
use HTTP::Request;
use Tie::File;
use Config::IniFiles;
use Net::SMTP;

my (@webs, @upwebs, %mailSettings);
my ($searchString, $sendMail, $errorLog, $responseLimit, $localtime, $outputLog);
my ($el, $data, $name, $temp, $error, @badResponses);
my $iniFile="./chk-web.ini";  # Change this to change the INI file in use.
#  You can set this to a non-existant file, or delete the INI file that was sent to you,
#  and this program will create a blank one with all possible values filled with dummy
#  data.  Change all parameters in there, except for the path and $debug below.
my $debug=0;    # Change this to 1 to print all sorts of odd debug info to STDOUT
$errorLog="webcheck-errors.log";
$error = parseIni($iniFile);
if ($error) {
	error($error);
	die "Error with INI File: $error\n";
}


$localtime=localtime;
$debug && print scalar localtime, "\n";
my ($day,$month,$date,$hour,$year) = split /\s/, $localtime;
$debug && print "$outputLog-$date.$month.$year.txt";
$outputLog = "$outputLog-$date.$month.$year.txt";
if (-e $outputLog) {
	open(OUT,">> $outputLog") or error("Cant open exist file $outputLog for append");
} else {
	open(OUT,"> $outputLog") or error("Cant open new file $outputLog for writing");
}


$debug && print "Successfully parsed INI file\n";

foreach $el (@webs) {
	check_url($el);
	$debug && print "tested $el\n";
}

$debug && print "$#badResponses down URLs and $#webs URLs\n";
if ($#badResponses>=0) {
	$debug && print "mailing about $el\n";
	$error=sendMail($el);
	$debug && $error && print "mail error is $error\n";
	$error && error($error);
	$error && die ("$error\n");
}

exit 0;

sub check_url
{  # subroutine who check given URL
	my $target = $_[0];
	my $ua = LWP::UserAgent->new;
        $ua->agent("$0/0.1 " . $ua->agent);
        my $req = HTTP::Request->new(GET => "$target");
        $req->header('Accept' => 'text/html');          #Accept HTML Page
        # send request
        my $start = time;      # Start timer
        my $res = $ua->request($req);
        # check the outcome
        if ($res->is_success) {# Success....all content of page has been received
        	my $time = time;     # End timer
		my $out_format;
	        $time = ($time - $start); # Result of timer
        	if ($responseLimit && ($responseLimit <= $time)) {
		        push(@badResponses, "Slow response from $target\: $time seconds");
		        $out_format = sprintf "| %-50.50s %-10s %-20s |\n", $target, "SLOW", "Response $time seconds";
		} else {
        		$out_format = sprintf "| %-50.50s %-10s %-20s |\n", $target, "ACCESSED", "Response $time seconds";
	        }
        	print OUT $out_format; # write to file
	        $debug && print $out_format;     # print to console
        } else {                 # Error .... Site is DOWN and script send e-mail to you..
		my $out_format = sprintf "| %-50.50s %-10s %-20s |\n", $target, "DOWN", " N/A";
	        push(@badResponses, "$target is DOWN." . $res->status_line) or error("Cannot push error for DOWN");
	        print OUT $out_format; # write to file
	        $debug && print $out_format;     # print to console
	}
}

sub error
{      # subroutine who print in Error Log
	my $error_msg = shift;
	$debug && print "$error_msg\n";
	if (-e $errorLog) {
	        open(ERR,">> $errorLog") or error("Cant open exist file $errorLog for append");
	} else {
        	open(ERR,"> $errorLog") or error("Cant open new file $errorLog for writing");
	}

	open (ERR, "@>> $errorLog") or print "Cannot open log file $errorLog : $!\n";
	print ERR "$localtime\: $error_msg : $!\n";
	print "$localtime\: $error_msg : $!\n";
	close ERR or die "Cannot close log file $errorLog : $!\n";
	exit 1;
}

sub makeIni 
{
	my $confFile = shift;
	my $error;
	my $cfg = new Config::IniFiles ();

	unless ($cfg->SetFileName($iniFile)) {
		return "Could not create or set file name.  $!";
	}
	unless ($cfg->AddSection ("WebServers")) {
		return "Could not add 'WebServers' section.  $!";
	}
	unless ($cfg->AddSection ("MailSettings")) {
		return "Could not add 'MailSettings' section.  $!";
	}
	unless ($cfg->AddSection ("Logging")) {
		return "Could not add 'Logging' section.  $!";
	}
	unless ($cfg->newval("WebServers", "URLList", "http://www.google.com", "http://www.hotmail.com")) {
		return "Could not set 'URLList' parameter.  $!";
	}
	unless ($cfg->newval("WebServers", "SearchString", "<script ")) {
		return "Could not set 'SearchString' parameter. $!";
	}
	unless ($cfg->newval("WebServers", "ResponseLimit", "12")) {
		return "Could not set 'ResponseLimit' parameter.  $!";
	}
	unless ($cfg->newval("MailSettings", "SendMail", "0")) {
		return "Could not set 'SendMail' parameter.  $!";
	}
	unless ($cfg->newval("MailSettings", "ServerList", "192.168.0.1")) {
		return "Could not set 'ServerList' parameter.  $!";
	}
	unless ($cfg->newval("MailSettings", "From", 'you@domain.com')) {
		return "Could not set 'From' parameter.  $!";
	}
	unless ($cfg->newval("MailSettings", "ToList", 'alerts@domain.com')) {
		return "Could not set 'ToList' parameter.  $!";
	}
	unless ($cfg->newval("MailSettings", "Subject", "Web Site Down!!!")) {
		return "Could not set 'Subject' parameter.  $!";
	}
	unless ($cfg->newval("MailSettings", "BodyLines", 'web site down!!', 'Fix this problem asap')) {
		return "Could not set 'BodyLines' parameter.  $!";
	}
	unless ($cfg->newval("Logging", "ErrorLog", "webcheck-errors.log")) {
		return "Could not set 'ErrorLog' parameter.  $!";
	}
	unless ($cfg->newval("Logging", "OutputLogStub", "webcheck")) {
		return "Could not set 'OutputLog' parameter. $!";
	}
	unless ($cfg->WriteConfig($iniFile)) {
		return "Could not write $iniFile.  $!";
	}
	return;
}

sub parseIni {
	my $error;
	my $cfg = new Config::IniFiles( -file => "$iniFile");
	unless ($cfg) {
		print "$iniFile did not exist, so it will be created.  Please edit this file with the values appropriate for your environment.\n";
		$error=makeIni ($iniFile);
		return "$error" if ($error);
		return "$iniFile did not exist, so we created it.";
	}
	unless ($cfg->SectionExists("WebServers") && $cfg->SectionExists("MailSettings") && $cfg->SectionExists("Logging")) {
		return "$iniFile exists, but is not complete.  Please rename this file and rerun this program, so that you can compare your file to the default.";
	}
	@webs=$cfg->val("WebServers", "URLList");
	foreach my $el (@webs) {
		chomp $el;
		next if ($el=~/^http:\/\/\S+\.\w{2,4}\/*/i or $el=~/^http:\/\/([\d]{1,3}\.){3}[\d]{1,3}\/*/i);  #looking for http://xxxxx.mobi or http://server.yyyyy.ca
		return "No URL specified, or parameter not formatted as proper URI.  Exiting.\n";
	}
	return "Need a minimum of 2 URLs to work properly.  Exiting\n" if ($#webs<1);
	$searchString=$cfg->val("WebServers", "SearchString");
	unless ($searchString) {
		return "No search string defined, or parameter 'SearchString' does not exist.  Exiting.\n";
	}
	$responseLimit=$cfg->val("WebServers", "ResponseLimit");
	unless ($responseLimit) {
		return "No ResponseLimit defined, or parameter missing.  Exiting.\n";
	}
	$errorLog=$cfg->val("Logging", "ErrorLog");
	unless ($errorLog) {
		return "No error log filename or full path entered.  Exiting.\n";
	}
	$outputLog=$cfg->val("Logging", "OutputLogStub");
	unless ($outputLog) {
		return "No output log filename entered.  Exiting.\n";
	}
	$sendMail=$cfg->val("MailSettings", "SendMail");
	$!="";
	if ($sendMail) {
		%mailSettings= (
			ServerList =>$cfg->val("MailSettings", "ServerList"),
			From => $cfg->val("MailSettings", "From"),
			ToList => $cfg->val("MailSettings", "ToList"),
			Subject => $cfg->val("MailSettings", "Subject"),
			BodyLines => $cfg->val("MailSettings", "BodyLines"),
		);
	}
	return $!;
}

sub removeHtmlTags
{
	# Remove HTML tags (simplistic method)
	
	my $text=shift;

	$text=~s/<br>/ /gs;	# was to replace <br> with newline, but it screwed up more stuff than it fixed.
	$text=~s/<[^>]*>//gs;  #remove the actual tags
	$text=~s/&nbsp;/ /gsi;
	$text=~s/&gt;/>/gsi;
	$text=~s/&lt;/</gsi;
	$text=~s/&amp;/&/gsi;
	$text=~s/\&[^\;\s]+\;//gs;  #remove non-breaking spaces and other special characters
	
	return $text;
}

sub sendMail 
{
	my $servername=shift;
	my ($smtp, $el);

	my @recipients=split /,/, $mailSettings{ToList};
	my @mailbody=split /,/, $mailSettings{BodyLines};
	@mailbody=(@mailbody, @badResponses);

	$smtp= Net::SMTP->new($mailSettings{ServerList});
	unless ($smtp) {
		return "Unable to connect to $mailSettings{ServerList} - $!\n";
	}
	unless ($smtp->mail($mailSettings{From})) {
		$smtp->reset();
		return "Unable to send mail from $mailSettings{From} - $!\n";
	}
	foreach $el (@recipients) {
		unless ($smtp->to($el)) {
			$smtp->reset();
			return "Error with SMTP 'To' address: $!\n";
		}
	}
	unless ($smtp->data()) {
		$smtp->reset();
		return "Unable to set object to send data - $!\n";
	}
	foreach $el (@recipients) {
		unless ($smtp->datasend("To: $el\n")) {
			$smtp->reset();
			return "Error with MIME 'To' address: $!\n";
		}
	}
	unless ($smtp->datasend("From: $mailSettings{From}\n")) {
		$smtp->reset();
		return "Error with MIME 'From' address: $!\n";
	}
	unless ($smtp->datasend("Subject: $mailSettings{Subject}\n")) {
		$smtp->reset();
		return "Unable to set Subject as $mailSettings{Subject}) - $!\n";
	}
	foreach $el (@mailbody) {
		$el=eval "\"$el\"";
		chomp($el);
		$debug && print "writing body $el\n";
		unless ($smtp->datasend("$el\n")) {
			$smtp->reset();
			return "Can't send line $el - $!\n";
		}
	}
	unless ($smtp->dataend()) {
		$smtp->reset();
		return "Error ending data stream - $!\n";
	}
	unless ($smtp->quit) {
		return "Error quitting smtp object - $!\n";
	}
}