bric_queued

#!/usr/bin/perl -w

# $Id$

=head1 NAME

bric_queued - Bricolage jobs queue daemon

=head1 SYNOPSIS

  bric_queud [options]

=head1 DESCRIPTION

F<bric_queued> runs as a daemon that polls a Bricolage jobs queue and executes
any unexecuted jobs with current or past scheduled times. Normally, (see
C<-s>) it executes all of the jobs found in a given poll in order of their
scheduled times with distribution and publish jobs handled by seperate
sub-processes--since distribution is normally an order of magnitude faster
than publishing.

In cases where the program finds no jobs in the queue it will wait a specified
amount of time (defaulting to 30 seconds) and then re-poll.

B<Note:>

Unlike L<bric_dist_mon|bric_dist_mon>, F<bric_queued> is a stand-alone program
that makes no HTTP requests to the Bricolage Apache/mod_perl server. This
allows it to to publish and distribute resources in its own process without
bogging down the Apache/mod_perl server and therefore its UI.

=head1 OPTIONS

=head2 --username

The username to use for the distribution.

=head2 --password

The password for the user specified by the C<--username> option.

=head2 -p <file> | --pid <file>

Specifies a pid file.

=head2 -d <number> | --delay <number>

Specifies a delay in seconds after finding the queue empty.

=head2 -s [type] | --single [type]

Run a single job of C<type> where C<type> is one of 'pub' or 'dist'.
Implies -verbose.

=head2 -v | --verbose

Turn on verbose mode for debugging.

=head2 -l <file> | --log <file>

Specifies a file to which to send debugging information. There is no need to
use this option for normal operation since Bricolage stores this information
in its database in much greater detail.

=head2 -h | --help

Print usage information and exit.

=head1 DEPENDENCIES

=head2 C<$BRICOLAGE_ROOT>

Set this environment variable as usual to indicate where to find the Bricolage
libraries.

=head2 Perl Modules

=over 4

=item Getopt::Long

=item Pod::Usage

=item POSIX

=item File::Spec::Functions

=back

=cut

use warnings;
use strict;
use Getopt::Long;
use POSIX 'setsid';
use File::Spec::Functions qw(catdir);
use Term::ReadPassword;

BEGIN {
    $ENV{BRIC_QUEUED} = 1;
    # $BRICOLAGE_ROOT defaults to /usr/local/bricolage
    $ENV{BRICOLAGE_ROOT} ||= "/usr/local/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. Use Bric::Config to prevent warnings.
    eval { require Bric::Config };
    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::Config qw(:sys_user);

if ($> == 0) {
    # Switch from root to the system user (set in bricolage.conf).
    $) = SYS_GROUP;
    die "Unable to set effective group id ". SYS_GROUP . "\n"
      unless $) == SYS_GROUP;
    $> = SYS_USER;
    die "Unable to set effective user id ". SYS_USER . "\n"
      unless $> == SYS_USER;
}

use Bric::App::Event qw(commit_events);
use Bric::Biz::Person::User;
use Bric::Util::Time qw(:all);
use Bric::Util::Job;
use Bric::Util::Job::Dist;
use Bric::Util::Job::Pub;
use Bric::Dist::Action;
use Bric::Util::Language;
use Bric::Dist::Action::Mover;
use Bric::Dist::Action::Email;
use Bric::Dist::Action::DTDValidate;

# Allow templates from before 1.10 to keep working.
use Bric::Biz::Asset::Business::Parts::Tile::Container;
use Bric::Biz::Asset::Formatting;
use Bric::Biz::AssetType;

##############################################################################
# Constants.
##############################################################################

use constant DELAY      => 30; # seconds to wait after finding an empty queue
use constant JOB_PKG    => 'Bric::Util::Job';
use constant DIST_PKG   => JOB_PKG . '::Dist';
use constant PUB_PKG    => JOB_PKG . '::Pub';

##############################################################################
# Global Variables.
##############################################################################

my $Pidfile = undef;            # pid of *daemonized* process
my $DistPid = undef;            # pid of Dist child process
my $Delay = DELAY;
my $SingleJobMode = undef;
my $Verbose = undef;
my $Logfile = '/dev/null';
my $HelpMode = undef;
my $CaughtSignal = 0;         # to be set by the signal handler

##############################################################################
# The script.
##############################################################################
# Parse the command line options.
Getopt::Long::Configure ("bundling");
GetOptions(
    "pid|p=s"    => \$Pidfile,
    "delay|d=i"  => \$Delay,
    "single|s=s" => \$SingleJobMode,
    "verbose|v"  => \$Verbose,
    "log|l=s"    => \$Logfile,
    "help|h"     => \$HelpMode,
    "username=s" => \my $username,
    "password=s" => \my $password,
);

require Pod::Usage && Pod::Usage::pod2usage("Missing required --username option.")
  unless $username;
require Pod::Usage && Pod::Usage::pod2usage("Missing required --password option.")
  unless $password;

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

# do help if we got the help flag
require Pod::Usage && Pod::Usage::pod2usage(1) if $HelpMode; # see Pod::Usage(8)
if ($SingleJobMode) {
    run_single_job();
} else {
    run_as_daemon();
}

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

=begin comment

=head1 SUBROUTINES

=head2 run_as_daemon

This is our main loop for normal daemon mode

=cut

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

sub run_as_daemon {
    daemonize();
    # fork off a process for dist jobs
    my $pkg = fork_to_dist();
    login();
    while (1) {
        # XXX Add a Limit parameter here? Seems like we should be able to
        # force it to do no more than a few at a time.
        for my $job ($pkg->list({
            sched_time => [undef, strfdate()],
            comp_time  => undef,
            failed     => '0',
            executing  => '0',
        })) {
            print 'Executing ' . $job->get_name . "\n" if $Verbose;
            eval {
                $job->execute_me;
                commit_events();
            };
            print $@ if $@;
            terminate() if $CaughtSignal;
        }

        # Flush out the publish_another queue.
        if ($pkg eq PUB_PKG) {
            eval {
                Bric::Util::Burner->flush_another_queue;
                commit_events();
            };
            print $@ if $@;
            terminate() if $CaughtSignal;
        }

        # no need to store the TERM signal during sleep
        $SIG{TERM} = \&terminate;
        sleep $Delay;
        $SIG{TERM} = \&handle_term;

        # If we are the parent (pub) process we should check to see that
        # the child (dist) process is still running so that the user only
        # has one to worry about.
        if ($DistPid) {
            print "Checking on Dist process, $DistPid ..." if $Verbose;
            if (kill 0 => $DistPid) {
                print "OK\n" if $Verbose;
            } else {
                print "No child pid found.  Exiting.\n";
                # The safest thing to do at this point is to quit and let
                # perl clean everything up.
                terminate();
            }
        }
    };
}

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

=head2 run_single_job

This is our main loop for normal daemon mode

=cut

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

sub run_single_job {
    $Verbose = 1;  # as promised in OPTIONS
    login();
    # get the package name from the command line type
    my $pkg;
    if (lc $SingleJobMode eq 'dist') {
        $pkg = DIST_PKG;
    } elsif (lc $SingleJobMode eq 'pub') {
        $pkg = PUB_PKG;
    } else {
        require Pod::Usage;
        Pod::Usage::pod2usage({
            -message => "Invalid argument to -s or --single.\n",
            -verbose => 1,
            -exitval => 1,
        });
    }
    # get the list of jobs and run the first one
    my ($job) = $pkg->list({
        sched_time => [undef, strfdate()],
        comp_time  => undef,
        failed     => '0',
        executing  => '0',
    });
    exit unless $job;
    print 'Executing ' . $job->get_name . "\n" if $Verbose;
    eval {
        $job->execute_me;
        Bric::Util::Burner->flush_another_queue if $pkg eq PUB_PKG;
        commit_events();
    };
    print $@ if $@;
}

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

=head2 fork_to_dist

This forks a second process and stores its PID so that the user only has to
worry about keeping the parent (pub) running.

Returns a package name from which we will get jobs to run.

=cut

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

sub fork_to_dist {
    my $reaper;
    $SIG{CHLD} = sub { wait; $SIG{CHLD} = $reaper; };
    defined ($DistPid = fork) or die "Can't fork: $!\n";
    if ($DistPid) {  # a non-zero pid means we are the parent
        return PUB_PKG;
    } else {
        return DIST_PKG;
    }
}

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

=head2 terminate

To be run after whatever job is in progress when we catch a SIGTERM.

=cut

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

sub terminate {
    print "Received TERM signal. Shutting down.";
    if ($DistPid) {  # we are the parent if this is non-zero
        kill 15 => $DistPid;
        del_pid();
    }
    print " OK\n";
    exit;
}

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

=head2 handle_term

Deal with SIGTERM.  We'll ignore the others for now.

B<Note:>

This does as little as possible itself as so to avoid problems associated
with catching signals in pre 5.7.x, even though Bricolage requires 5.8 or
better we can never be too careful.  Besides, we want to finish what we are
doing before we acutally exit.

=cut

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

sub handle_term {
    $CaughtSignal = 1;
}

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

=head2 write_pid

open and write the pidfile if any then close it again right away

=cut

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

sub write_pid {
    my $pid = shift;
    return unless $Pidfile;
    open PID, ">$Pidfile" or die "Cannot open PID file $Pidfile";
    print PID $pid;
    close PID;
}

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

=head2 read_pid

if there is a pidfile open and read it, then close it again right away

=cut

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

sub read_pid {
    return unless $Pidfile;
    open PID, $Pidfile or die "Cannot open PID file $Pidfile.";
    my $pid = <PID>;
    close PID;
    return chomp $pid;
}

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

=head2 del_pid

delete the pidfile if any

=cut

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

sub del_pid {
    return unless $Pidfile;
    unlink $Pidfile or die "Cannot unlink PID file $Pidfile.\n"
}

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

=head2 daemonize

based on an approach found in the perlipc documentation

=cut

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

sub daemonize {
    write_pid('');  # tests the writability of Pidfile
    del_pid();      # in case the process dies before forking
    $SIG{TERM} = \&handle_term;
    chdir '/'                 or die "Can't chdir to /: $!\n";
    open STDIN, '/dev/null'   or die "Can't read from /dev/null: $!\n";
    open STDOUT, ">>$Logfile" or die "Can't write to logfile: $!\n";
    defined (my $pid = fork)  or die "Can't fork: $!\n";
    if ($pid) {
        # only the parent process gets the PID of the new running daemon
        write_pid($pid);
        exit;
    }
    setsid                   or die "Can't start a new session: $!\n";
    open STDERR, '>&STDOUT'  or die "Can't dup stdout: $!\n";
}

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

sub login {
    # Find the user and make sure they're legit.
    my $user = Bric::Biz::Person::User->lookup({ login => $username });
    die qq{Invalid username or password\n} unless $user;

    # Uncomment this line to be insecure.
    $user->chk_password($password) or die qq{Invalid username or password\n};

    # Set up the user.
    Bric::App::Session::set_user(undef, $user);

    # Set up localization.
    Bric::Util::Language->get_handle($user->get_pref('Language'));
}

__END__

=end comment

=head1 AUTHOR

Mark Jaroski <jaroskim@who.int>