The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# slchoosed - choosing daemon for perl Schedule::Load
# See copyright, etc in below POD section.
######################################################################

require 5.004;
use lib 'blib/lib';	# testing
use FindBin qw($RealBin $RealScript $Script);
use Getopt::Long;
use Pod::Usage;
use Sys::Syslog;
use Schedule::Load::Chooser;
use POSIX;
use strict;

BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }	# Secure path

$SIG{PIPE} = 'IGNORE';

######################################################################
# configuration

######################################################################
# globals

use vars qw(@Orig_ARGV);

######################################################################
# main

@Orig_ARGV = @ARGV;

my $Debug = 0;
my %server_params = ();
my $opt_quiet = 1;
my $opt_fork = 1;

if (!GetOptions (
		 "help"		=> \&usage,
		 "debug"	=> \&debug,
		 "version"	=> \&version,
		 "quiet!"	=> \$opt_quiet,	# Debugging
		 "fork!"	=> \$opt_fork,	# Debugging/Test script
		 "port=i"	=> sub {shift; $server_params{port} = shift;},
		 "dhost=s"	=> sub {shift; push @{$server_params{dhost}}, split(':',shift);},
		 )) {
    die "%Error: Bad usage, try 'slchoosed --help'\n";
}

autoflush STDOUT 1;
autoflush STDERR 1;

# We're chdiring to /, so make sure program name has path
if ($0 !~ m!^/!) { $0 = getcwd()."/".$0; }
chdir "/";	# Change immediately to aid debugging of $0 change

if ($opt_quiet && !$Debug) {
    if ($opt_fork) {
	exit if fork();  # Fork once to let parent die
        POSIX::setsid(); # Disassociate from controlling terminal
	exit if fork();  # Prevent possibility of acquiring a controling terminal
	chdir "/";       # Change working directory so can umount .
    }
    # Close open file descriptors
    my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX );
    $openmax = (!defined($openmax) || $openmax < 0) ? 64 : $openmax;
    foreach my $i (0 .. $openmax) { POSIX::close($i); }
    # Silence please (in case user didn't pipe when starting us)
    open(STDIN,  "+>/dev/null");
    open(STDOUT, "+>&STDIN");
    open(STDERR, "+>&STDIN");
}

# Loop in case something kills us
while (1) {
    print "Starting server: $0\n" if $Debug;
    my $pid;
    if (!$opt_fork || (0==($pid = fork()))) {
        Schedule::Load::Chooser->start (%server_params,
					restart	=> sub {},
					);
	exit(0);
    }
    die "%Error: Server aborted\n" if !$opt_fork;

    waitpid($pid,0);
    warn "%Warning: Server aborted\n";
    sleep(1);
    kill 9, $pid;
    sleep(1);
    # Restart this program by re-execing; allows users to restart the daemon
    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
    print "exec $0, @Orig_ARGV\n" if $Debug;
    # Note if testing this, the exec will use the installed library, not the local library
    exec $0, @Orig_ARGV if -x $0;
    # If can't exec we simply start the server again
    #print "Exec failed, looping again\n" if $Debug;
}

exit (0);

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

sub usage {
    print "Version: $Schedule::Load::VERSION\n";
    pod2usage(-verbose=>2, -exitval => 2);
    exit(1);
}

sub version {
    print "Version: $Schedule::Load::VERSION\n";
    exit (1);
}

sub debug {
    $Debug = 1;
    $Schedule::Load::Chooser::Debug = 1;
    $Schedule::Load::Schedule::Debug = 1;
}

######################################################################
__END__

=pod

=head1 NAME

slchoosed - Distributed load chooser for Perl Schedule::Load

=head1 SYNOPSIS

B<slchoosed>
[ B<--help> ]
[ B<--port=>I<port> ]
[ B<--dhost=>I<host> ]
[ B<--version> ]

=head1 DESCRIPTION

slchoosed will start a daemon to choose machines for the Schedule::Load
package.  Slchoosed creates two processes, so that if second process exits,
the first may restart it automatically.

L<slchoosed> is run on one host in the network.  This host is specified in
the SLCHOOSED_HOST environment variable, which may also specify additional
cold standby hosts in case the first host goes down.  Slchoosed collects
connections from the L<slreportd> reporters, and maintains a internal
database of the entire network.  User clients also connect to the chooser,
which then gets updated information from the reporters, and returns the
information to the user client.  As the chooser has the entire network
state, it can also choose the best host across all CPUs in the network.

It will take 30-60 seconds for the reporting hosts to be rediscovered when
the chooser first starts.

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --dhost

Specifies the daemon host name that slchoosed uses.  May be specified
multiple times to specify backup hosts.  Defaults to SLCHOOSED_HOST
environment variable, which contains colon separated host names.  When
slchoosed starts, any hosts listed AFTER the current host are assumed to be
backup hosts, and are sent a reset so that this host may takeover the
choosing task.

=item --nofork

For debugging, prevents the daemon from creating additional processes and
from going into the background.  This allows messages to appear on stdout,
and ctrl-C to stop the daemon.

=item --port

Specifies the port number that slchoosed uses.  Defaults to SLCHOOSED_PORT
environment variable or slchoosed service, or 1752.

=item --version

Displays program version and exits.

=back

=head1 DISTRIBUTION

The latest version is available from CPAN and from L<http://www.veripool.org/>.

Copyright 1998-2011 by Wilson Snyder.  This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

L<slchoosed_watchd>, L<slreportd>, L<Schedule::Load>, L<Schedule::Load::Chooser>

=cut
######################################################################