#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

=head1 NAME

bric_dist_mon - Bricolage distribution monitor

=head1 VERSION

$LastChangedRevision$

=head1 DATE

$LastChangedDate: 2006-03-18 01:26:34 +0100 (Sat, 18 Mar 2006) $

=head1 SYNOPSIS

  bric_dist_mon -u username -p password

  bric_dist_mon -u username -p password -i 15

  bric_dist_mon -u username -p password -c

  bric_dist_mon -u username -p password

=head1 DESCRIPTION

This program triggers the execution of distribution jobs when they're due. It
does this by sending a ticler request to the Bricolage server on a regular
basis.

F<bric_dist_mon> works in one of two ways. The first is as a cron job. Use the
C<-c> option in a crontab and F<bric_dist_mon> will always execute once and
then exit. Using F<bric_dist_mon> in a cron job allows the interval for its
execution to be managed by cron, but limits it to the intervals supported by
cron. For example, cron typically allows jobs to be scheduled to run as
frequently as every minute. This will be fine for most applications. However,
in a busy Bricolage environment with highly time-critical content, it may be
important to have F<bric_dist_mon> trigger new distribution jobs more
frequently than cron will allow.

For those environments, F<bric_dist_mon> can be used as a persistent, forking
program. This is the default way to run F<bric_dist_mon>, and the interval can
be set via the C<-i> option. For example, if a busy environment needed
distribution jobs checked for and executed every 15 seconds, C<-i 15> will
cause F<bric_dist_mon> to fork a new process every fifteen seconds to send
a tickle request to the distribution server.

Note that, to run F<bric_dist_mon> as a persistent forking application, some
method of ensuring that it remains running and gets restarted if it exits will
need to be put in place. But since most environments will be well served by
the 1-minute intervals allowed by cron, we expect that approach to be the
main way of running F<bric_dist_mon>, thus avoiding the persistence issues.

=head1 OPTIONS

=over 4

=item -u

Bricolage user login. All distribution jobs will be executed by this
user. B<Required.>

=item -p

Bricolage user password. B<Required.>

=item -i

Interval (in seconds) between checks for jobs to execute and expire. Defaults
to 30 seconds.

=item -U

The distribution server URL, including the protocol. Defaults to
"http://localhost/dist/". If "/dist" isn't appended to the end of the URL,
F<bric_dist_mon> will append it for you.

=item -a

IP Address from which the distribution requests will be sent to the
distribution server. If not provided, F<bric_dist_mon> will do its best to
figure out what the IP address is.

=item -c

Cron mode. Will run only once and then exit.

=item -f

An integer representing the number of times the script should fork. Useful for
testing. Does not apply with C<-c>.

=item -d

Print and log debugging data to the system logs. This can be very verbose and
fill up your logs, so use with care.

=item -h

Print a usage statement.

=item -v

Print the version number.

=back

=head1 AUTHOR

David Wheeler <david@justatheory.com>

=head1 SEE ALSO

L<Bric::Dist::Client|Bric::Dist::Client>,
L<Bric::Dist::Handler|Bric::Dist::Handler>.

=cut

use strict;
use File::Spec::Functions qw(catdir);

BEGIN {
    # $BRICOLAGE_ROOT defaults to /usr/local/share/bricolage
    $ENV{BRICOLAGE_ROOT} ||= "/usr/local/share/bricolage";

    # use $BRICOLAGE_ROOT/lib if exists
    my $lib = catdir($ENV{BRICOLAGE_ROOT}, "lib");
    if (-e $lib) {
        $ENV{PERL5LIB} = defined $ENV{PERL5LIB} ?
          "$ENV{PERL5LIB}:$lib" : $lib;
        unshift @INC, $lib;
    }

    # make sure Bric is found
    eval { require Bric };
    die <<"END" if $@;
######################################################################

   Cannot load Bricolage libraries. Please set the environment
   variable BRICOLAGE_ROOT to the location of your Bricolage
   installation or set the environment variable PERL5LIB to the
   directory where Bricolage's libraries are installed.

   The specific error encountered was as follows:

   $@

######################################################################
END
}

use Bric::Dist::Client;
use Bric::Util::Trans::FS;
use Bric::App::Auth;
use Getopt::Std;
use Unix::Syslog qw(:subs :macros);
use POSIX qw(:sys_wait_h);
use Apache::FakeRequest;
use Term::ReadPassword;

use constant INTERVAL => 30;
use constant DEBUG => 0;
use constant URL => 'http://localhost/dist/';

# Get the options.
our ($opt_i, $opt_U, $opt_h, $opt_d, $opt_c, $opt_f, $opt_v, $opt_u, $opt_p,
     $opt_a);

getopts('i:u:p:hdcvf:U:P:a:');

# Get the version number.
use Bric; our $VERSION = Bric->VERSION;

# Get the program name.
my $prog = Bric::Util::Trans::FS->base_name($0);

# Print a usage statement, if necessary.
usage() if $opt_h;
version() if $opt_v;

if ($opt_p eq '') {
    {
        $opt_p = read_password('Password: ');
        redo unless $opt_p;
    }
}

usage("User name and password are required.") unless $opt_u && $opt_p;

# Make sure we have an interval and a debugging value.
$opt_i ||= INTERVAL;
$opt_d ||= DEBUG;
if ($opt_U) {
    unless ($opt_U =~ m[/dist/?$]) {
        $opt_U .= $opt_U =~ m[/$] ? 'dist/' : '/dist/';
    }
} else {
    $opt_U ||= URL;
}

################################################################################
{
    # This Section is for the creation of a fake Apache object that can be
    # used by Bric::App::Auth.
    package FakeConn;
    unless ($opt_a) {
	require Sys::Hostname;
	$opt_a = sprintf "%vd", scalar gethostbyname(Sys::Hostname::hostname())
	  || die "Unable to determine IP address.";
    }
    sub new { bless {} }
    sub remote_ip { $opt_a }
}


################################################################################
# We're gonna need to reap the dead children.
our $zombies = 0;
#$SIG{CHLD} = sub { $zombies++ };
$SIG{CHLD} = 'IGNORE';
sub reaper {
    log_msg("Reaping zombie processes.") if $opt_d;
    my $zombie;
    $zombies = 0;
    while (($zombie = waitpid(-1,WNOHANG)) != -1) {
	# Log it in debug mode.
	log_msg("Reaped process $zombie.") if $opt_d;
    }
}

################################################################################
# Here's where the work gets done.
if ($opt_c) {
    # We're in CRON mode. Just do it and exit.
    send_jobs();
    exit;
} else {
    # We're in forking mode. Run forever.
    my $i = 0;
    while ($opt_f ? $i < $opt_f : 1) {
	# Increment if we're only doing this a few times.
	$i++ if $opt_f;
	log_msg("Forking new process.") if $opt_d;
	my $pid;
	if ($pid = fork) {
	    # Parent process - take a nap.
	    sleep $opt_i;
	} else {
	    # It's the child process.
	    send_jobs();
	    exit;
	}
	# Reap any dead children.
	reaper() if $zombies;
    }
}

################################################################################

sub send_jobs {
    log_msg("Checking for new jobs.") if $opt_d;
    eval {
	# Create the authentication cookie.
	my $r = Apache::FakeRequest->new(connection => FakeConn->new);
	my ($cookie, $msg) = Bric::App::Auth::login($r, $opt_u, $opt_p);
        log_err($msg) if $msg;

	# Create a client and load the Job IDs.
	my $client = Bric::Dist::Client->new({ url => $opt_U,
                                               cookie => $cookie->as_string });
#	$client->load_ids;

	# Send debugging info, if necessary.
	if ($opt_d) {
#	    my $exec = $client->get_exec_ids;
#	    $exec = !@$exec ? 'no Job IDs' : $#$exec > 0 ? "Job ID @$exec" :
#	      "Job IDs @$exec";
#	    local $" = ', ';
#	    log_msg("Sending $exec for execution.");
            log_msg("Sending execution request.");
	}
	# Send the Job IDs.
	$client->send;
    };
    # Log any errors.
    log_err($@) if $@;
}

################################################################################

sub log_msg {
    my ($err) = @_;
    # Log the error to the system log.
    if ($opt_d) {
	# Log more stuff and to STDERR for debugging.
	openlog($prog, LOG_PID | LOG_PERROR, LOG_USER);
	if (ref $err) {
	    syslog(LOG_ERR, "Debug: %s (%s line %d). %s",
		   $err->get_msg, $err->get_pkg, $err->get_line,
		   $err->get_payload || '');
	} else {
	    syslog(LOG_ERR, "Debug: %s", $err);
	}
    } else {
	# Just to regular logging.
	openlog($prog, LOG_PID, LOG_USER);
	if (ref $err) {
	    syslog(LOG_ERR, "Error: %s: %s. Consult the Apache " .
                   "error log for more details", $err->get_msg,
		   $err->get_payload || '');
	} else {
	    syslog(LOG_ERR, "Error: %s", $err);
	}
    }
    closelog();
    # Identifier: LOG_PID   0x01    /* log the pid with each message */
    # Priority:   LOG_ERR   3       /* error conditions */
    # Facility:   LOG_USER  (1<<3)  /* random user-level messages */
}

##############################################################################

sub log_err {
    my $err = shift;
    log_msg($err);
    print STDERR "$err\n" unless $opt_d;
    exit 1;
}

################################################################################

sub usage {
    my $err = shift;
    print "\nERROR: $err\n" if $err;
    print qq{
Usage: $prog -u username -p password [options]

Supported Options:
  -u User login. All distribution jobs will be executed by this user. Required.
  -p User password. Required.
  -i Interval (in seconds) between checks for jobs to execute and expire.
     Default is 30 seconds.
  -U The distribution server URL including the protocol. Defaults is
     'http://localhost/dist/'.
  -a IP Address from which the distribution requests will be sent to the
     distribution server. If not provided, $prog will do its best to figure
     out what the IP address is.
  -c Cron mode. Will run only once and then exit.
  -f An integer representing the number of times the script should fork.
     Useful for testing. Does not apply with -c.
  -d Print and log debugging data. This can be very verbose and fill up your
     logs, so use with care.
  -h Print this usage statement.
  -v Print the version number.

};
    exit;
}

################################################################################

sub version {
    print "\nBricolage Distribution Monitor version $VERSION\n";
    usage();
}

__END__

