#!/usr/local/bin/perl
# ========================================================================
# monitor_url - monitor URL and report on state changes
# Andrew Ho (andrew@zeuscat.com)
#
# This program contains embedded documentation in Perl POD (Plain Old
# Documentation) format. Search for the string "=head1" in this document
# to find documentation snippets, or use "perldoc" to read it; utilities
# like "pod2man" and "pod2html" can reformat as well.
#
# $Id: monitor_url,v 1.10 2010/12/03 23:42:12 andrew Exp $
# ========================================================================

=head1 NAME

monitor_url - monitor URL and report on state changes

=head1 SYNOPSIS

    % monitor_url [-h] [-x] \
          [-d delay] [-f logfile] [-l loglevel] [-t title] [-c code] \
          url [email]

=head1 DESCRIPTION

This program monitors an HTTP URL.

By default, it backgrounds itself and makes HTTP fetches to the given
URL at specified intervals, determining whether each fetch is
successful. The program considers it interesting whenever the success
state changes from success to failure, or vice versa.

When a state change occurs, that event is logged to a logfile, if
specified on the command line. If an e-mail address was specified on the
command line, e-mail notifications are sent on state change.
If a program to run was specified, that program is run with a single,
verbatim, lowercase argument, which is either C<failure> (the state
flipped from success to failure), or C<success> (the state flipped from
failure to success).

A URL is required as a command line argument. A second command line
argument is an optional e-mail address to send notifications to. The
following is a list of additional, optional command line parameters that
this program understands.

=over 4

=item -h

Display a usage message and exit.

=item -x

Debug mode; do not daemonize, and set loglevel to default, and always
log to stderr, not to a logfile. Useful for testing.

=item -d I<delay>

Set the poll delay; pause for I<delay> seconds between URL fetches. The
default is 60 seconds.

=item -f I<logfile>

Write log output to I<logfile>. This may be a path to a filename, or a
specification that Perl's <open()> command understands, for example, a
pipe to a process, as in the following example:

    monitor_url -f '| /path/to/my/loghandler'

The default behavior is to append to the logfile if it exists. If no
logfile is specified, log output is sent to stderr, which means that
when the program daemonizes, you will lose all output.

=item -l I<loglevel>

Set log verbosity to one of the following levels:

=over 4

=item * C<error>

=item * C<warning>

=item * C<notice>

=item * C<info>

=item * C<debug>

=back

The default verbosity is C<info>.

=item -t I<title>

If sending notification e-mails, include this text in the subject line
of the e-mail, instead of the URL being monitored. This is useful for
making a more human-friendly subject line. The body of the message will
contain the full URL in any case.

=item -c I<code>

Expect this HTTP status code, instead of 200 OK. This can be used to
monitor a service that (for example) returns an HTTP redirect instead of
an actual page.

=item -p I<program>

Run this program whenever the state changes (from success to failure, or
vice versa). The program is run with a single argument, which is either
C<failure> (the state changed from success to failure), or C<success>
(the state changed from failure to success).

=back

=head1 AUTHOR

Andrew Ho E<lt>F<andrew@zeuscat.com>E<gt>

=cut


# ------------------------------------------------------------------------
# Libraries, globals, and constants

use warnings;
use strict;

use File::Basename qw(basename);
use Getopt::Long qw(GetOptions);
use POSIX qw(setsid);
use LWP::UserAgent ();
use Time::HiRes qw(gettimeofday tv_interval);
use Zeuscat::Log qw(:loglevels);

our $ME = basename $0;
our $FROM = 'URL Monitor <andrew@zeuscat.com>';
our $SENDMAIL = '/usr/local/sbin/sendmail -oi -t';

our @Original_ARGV;
our $Monitor_URL;
our $Notify_Email;
our $Daemonize   = 1;
our $Timeout     = 20;
our $Poll_Delay  = 60;
our $Logfile     = "/home/andrew/.$ME.log";
our $LogLevel    = LOGLEVEL_INFO;
our $Title;
our $Code;
our $Program;

our $USAGE = join ' ', "usage: $ME [-h] [-x]",
    "[-d delay] [-f logfile] [-l loglevel] [-t title] [-c code] [-p program]",
    "url [email]\n";
our $FULL_USAGE = $USAGE . << "EndUsage";
    -h           display this help text and exit
    -x           debug mode (do not daemonize, log verbose output to stderr)
    -d delay     delay this many seconds between polls (default $Poll_Delay)
    -f logfile   log to this file (default $Logfile)
    -l loglevel  log with this level of verbosity (default info)
    -t title     display this text in e-mail subject line (default is URL)
    -c code      accept this HTTP status code as a success
    -p program   run this program on state change
    url          monitor this URL (required, no default)
    email        send state change notification to this e-mail (default none)
EndUsage

use constant STATE_UNKNOWN => 0;
use constant STATE_FAILURE => 1;
use constant STATE_SUCCESS => 2;
our @STATE_LABEL = qw(unknown failure success);


# ------------------------------------------------------------------------
# Parse command line options

@Original_ARGV = @ARGV;

my($help, $debug);
{
    local $SIG{__WARN__} = sub {
        my $errmsg = lcfirst join '', @_;
        chomp $errmsg;
        die "$ME: argument parsing error: $errmsg\n$USAGE";
    };
    GetOptions(
        'h|help'       => \$help,
        'x|debug'      => \$debug,
        'd|delay=i'    => \$Poll_Delay,
        'f|logfile=s'  => \$Logfile,
        'l|loglevel=s' => \$LogLevel,
        't|title=s'    => \$Title,
        'c|code=i'     => \$Code,
        'p|program=i'  => \$Program,
    );
}

if($help) {
    print $FULL_USAGE;
    exit 0;
}

if($debug) {
    $Daemonize = 0;
    $Logfile   = undef;
    $LogLevel  = LOGLEVEL_DEBUG;
}

if(@ARGV) {
    $Monitor_URL = shift @ARGV;
    $Notify_Email = shift @ARGV if @ARGV;
    warn "$ME: ignoring extraneous arguments\n" if @ARGV;
}
if(!$Monitor_URL) {
    die "$ME: required URL argument missing\n$USAGE";
} elsif($Monitor_URL !~ m,^https?://.+,) {
    die "$ME: invalid URL: $Monitor_URL\n$USAGE";
}


# ------------------------------------------------------------------------
# Main loop

our $Exit = 0;
our $Logger = Zeuscat::Log->new($Logfile);
$Logger->open_logfile();
$Logger->loglevel($LogLevel);
my $version = '$Revision: 1.10 $';
   $version =~ s/^\$Revision: //;
   $version =~ s/ \$$//;
$Logger->info_log($ME, ' version ', $version, ' starting up');
$Logger->debug_log('invoked as: ', join ' ', $0, @Original_ARGV);

$SIG{INT}      = make_exit_signal_handler('INT');
$SIG{TERM}     = make_exit_signal_handler('TERM');
$SIG{__DIE__}  = sub { $Logger->error_die('caught fatal error: ', @_) };
$SIG{__WARN__} = sub { $Logger->warning_log('uncaught warning: ', @_) };

daemonize() if $Daemonize;

my $ua = LWP::UserAgent->new;
if(defined($Code) && $Code =~ /^30[1237]$/) {
    @{$ua->requests_redirectable} = ();
}
my $last_state = STATE_UNKNOWN;
$Logger->info_log($0, ' starting monitoring for URL: ', $Monitor_URL);
while(!$Exit) {
    $Logger->debug_log('fetching URL: ', $Monitor_URL);
    my $before = [ gettimeofday() ];
    my $response = $ua->get($Monitor_URL);
    my $elapsed = tv_interval($before);
    my $state;
    if(defined $Code) {
        my $got_code = $response->code;
        $state = $got_code == $Code ? STATE_SUCCESS : STATE_FAILURE;
    } else {
        $state = $response->is_success ? STATE_SUCCESS : STATE_FAILURE;
    }
    $Logger->debug_log(
        sprintf 'fetch returned code %03d (%s) after %d ms',
                $response->code, $STATE_LABEL[$state], 1000 * $elapsed
    );
    if($last_state != $state) {
        my($method, $text);
        my $state_label = $STATE_LABEL[$state];
        if($last_state == STATE_UNKNOWN) {
            $method = $state == STATE_FAILURE ? 'info_log' : 'debug_log';
            $text = "initial state: $state_label";
        } else {
            $method = 'info_log';
            $text = "state change: $STATE_LABEL[$last_state] to $state_label";
            if($Notify_Email) {
                my $subject = join ' ', $Title || $Monitor_URL, $text;
                my $body = "URL: $Monitor_URL\n" . ucfirst($text);
                send_mail($FROM, $Notify_Email, $subject, $body);
            }
            if($Program) {
                my $virgin = 1;
                my $callback = sub {
                    if($virgin) {
                        $Logger->info_log('output from ', $Program, ':');
                        $virgin = 0;
                    }
                    $Logger->info_log('    || ', @_);
                };
                $Logger->debug_log(
                    'running command: ', $Program, ' ', $state_label
                );
                eval { run_command($callback, $Program, $state_label) };
                if($@) {
                    $Logger->error_log('error running ', $Program, ': ', $@);
                } else {
                    $Logger->debug_log($Program, ' ran successfully');
                }
            }
        }
        $Logger->$method($text);
        $last_state = $state;
    }
    sleep $Poll_Delay unless $Exit;
}

$Logger->info_log('process exiting normally');
exit 0;


# ------------------------------------------------------------------------
# Helper functions

sub make_exit_signal_handler {
    my $label = shift;
    my $signal_handler = sub {
        if($Exit) {
            $Logger->info_log('caught multiple SIG', $label, 's, exiting now');
            exit 1;
        } else {
            $Logger->info_log('caught SIG', $label, ', setting exit flag');
            $Exit = 1;
        }
    };
    return $signal_handler;
}

sub daemonize {
    $Logger->debug_log('daemonizing');
    my $pid = fork();
    if(!defined $pid) {
        $Logger->error_die($ME, ': cannot fork: ', $! || 'unknown error');
    } elsif($pid) {
        $Logger->debug_log('parent process exiting');
        exit 0;    # parent process should exit
    } else {
        $Logger->debug_log('child process detaching');
        foreach my $handle (*STDIN, *STDOUT, *STDERR) {
            close $handle;
            unless(open $handle, '+<', '/dev/null') {
                $Logger->warning_log( $ME, ': could not reopen ',
                    $handle, ': ', $! || 'unknown error' );
            }
        }
        if(setsid() < 0) {
            $Logger->error_die( $ME, ': cannot setsid(): ',
                $! || 'unknown error' );
        }
    }
    $Logger->debug_log('finished daemonizing');
}

sub send_mail {
    my($from, $to, $subject, $body) = @_;
    $Logger->debug_log( 'sending e-mail to "', $to, '" with subject "',
        $subject, '"' );
    my $cvs_id = '$Id: monitor_url,v 1.10 2010/12/03 23:42:12 andrew Exp $';
    my $message = << "    EndText";
From: $from
To: $to
Subject: $subject

$body

--
$cvs_id
    EndText
    if(open my $fh, "| $SENDMAIL") {
        print $fh $message;
        close $fh;
        $Logger->info_log('sent e-mail notification to ', $Notify_Email);
    } else {
        $Logger->error_log( 'e-mail notification to ', $Notify_Email, 
            ' failed: ', $! || 'unknown error' );
    }
}

sub run_command {
    my($callback, $command, @args) = @_;
    my $callback_error;
    my $pid = open my $kid, '-|';
    defined $pid or die "could not fork: $!";
    if($pid) {
        no warnings qw(io);
        while(local $_ = readline $kid) {
            eval { $callback->($_) if $callback; };
            last if $callback_error = $@;
        }
        close $kid or
            ($! && $Logger->error_log('could not close child process: ', $!));
        die $callback_error if $callback_error;    # Rethrow
        unless(0 == $?) {
            die "command returned non-zero result of $?";
        }
    } else {
        # Reset environment
        %ENV = ( PATH => '/usr/local/bin:/bin:/usr/bin:/usr/local/sbin' );
        # STDERR may be tied to log object, untie before redirecting
        untie *STDERR;
        open STDERR, '>&STDOUT';
        unless(exec $command, @args) {
            # Do not want to die because caller may try to handle
            # the error (causing this forked child to persist).
            $Logger->error_log('could not exec ', $command, ': ', $!);
            exit 1;
        }
    }
}


# ========================================================================
__END__