# $Id$
use Config;
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($Config{'osname'} eq 'VMS' or
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";

print OUT <<"!GROK!THIS!";
$Config{'startperl'} -w
    eval 'exec perl -S \$0 "\$@"'
        if 0;

!GROK!THIS!

print OUT <<'!NO!SUBS!';
        
# refer to the bottom of this file for documentation
BEGIN {

	# load core libraries
	use strict;
	use warnings;
	use IO::File;
	use Pod::Usage;
	use File::Spec;
	use diagnostics;
	use Getopt::Long;
	use Sys::Hostname;
	use POSIX 'setsid';
	
	# update search paths
	if ( not $ENV{'CIPRES_ROOT'} ) {
		print "Environment variable \$CIPRES_ROOT not set.\n";
		pod2usage( 1 );
	}
	my $libpath = File::Spec->catdir(
		$ENV{'CIPRES_ROOT'},
		'lib/perl/lib'
	);
	push @INC, $libpath;
}

BEGIN {
	# load CIPRES libraries
	use Cipres::Registry;
	use Cipres::CipresProperties;
	use Exception::Class::TCF;
}

# "global" variables needed before getoptions
my $PERSISTENT;
my $FIXED;
my $HIJACKED;
my $ACTION;
my %ACTIONS   = (
	'START'   => \&start,
	'STOP'    => \&stop,
	'RESTART' => \&restart,
	'STATUS'  => \&status,
);

# instantiate and prepare services
sub init {
	my @SERVICES = (  new Cipres::CipresProperties, new Cipres::Registry );
	my %PID;
	for my $service ( @SERVICES ) {
		my $name = ref $service;
		$PID{$name} = '(initializing)';
		$service->get_user_observable->set( $ENV{'USER'} );
		$service->get_runstatus_observable->add_callback(
			sub {
				$PID{$name} = shift;
				my $status = $PERSISTENT ? " (persistent)" : "";
				my $name = "cipresd$status for $ENV{'USER'} [";
				$name .= join '|', map { $_ . ':' . $PID{$_} } keys %PID;
				$name .= ']';
				$0 = $name;
			}
		);
	}
	$SERVICES[1]->set_fixed_port( $FIXED );
	return @SERVICES;
}

# scope block, hide variables
{
	
	# process command line options and args
	my $msg = "Action has to be one of START, STOP, RESTART, STATUS";
	my $re  = qr/^(?:START|STOP|RESTART|STATUS)$/i;
	GetOptions(
		'help|?'     => sub { pod2usage( 1 ) },
		'man'        => sub { pod2usage( '-exitstatus' => 0, '-verbose' => 2 ) },
		'action=s'   => sub { $ACTION = pop; $ACTION !~ $re && pod2usage( $msg ) },
		'persistent' => \$PERSISTENT,
		'fixedPort'  => \$FIXED,
	) or pod2usage( 2 );
	pod2usage( "No action provided!" ) unless $ACTION;
}

# dispatch action
$ACTIONS{ uc( $ACTION ) }->(init);

sub hijack {
	unless ( $HIJACKED ) {
		$HIJACKED = 1;
		
		# pid of daemon
		my $PID;
		my $PIDFILE = File::Spec->catfile(
			$ENV{'HOME'},
			'/cipres/tmp/',
			hostname() . '_cipresd.pid',
		);
	
		# get pid from file
		if ( -e $PIDFILE ) {
			my $fh = new IO::File;
			$fh->open("< $PIDFILE")   or die "Can't open $PIDFILE: $!";
			$PID = $fh->getline;
			$fh->close                or die "Can't close $PIDFILE: $!";
		}
	
		# kill previous daemon
		kill 9, $PID if ( $PID && kill 0, $PID );
	
		if ( $PERSISTENT ) {
			# change to root in case cwd is unmounted
			chdir '/'                 or die "Can't chdir to /: $!";
			
			# fork to demonize
			defined( my $pid = fork ) or die "Can't fork: $!";
			exit if $pid;
			setsid                    or die "Can't start a new session: $!";
		}
		
		# update PID
		$PID = $$;
		
		# write new pid
		my $fh = new IO::File;
		$fh->open( "> $PIDFILE" )     or die "Can't open $PIDFILE: $!";
		$fh->print( $PID );
		$fh->close                    or die "Can't close $PIDFILE: $!";
			
	}	
}

sub start {
	my @SERVICES = @_;
	hijack;
	
	# main loop for (re)starting
	SERVICE_POLL_AND_LAUNCH: while ( 1 ) {
		
		# start if not running
		for my $service ( @SERVICES ) {
			
			# already running
			if ( my $service_pid = $service->is_running ) {
				unless ( $PERSISTENT ) {
					printf "\tAlready running: %s [PID:%s]\n", ref $service, $service_pid;
				}
			}
			
			# not yet running
			else {
				try {
					$service->start;
				} 
				catch 'Cipres::Exception::ProcessError' => sub {
					printf "\tError launching %s: %s\n", ref $service, shift->message;
				};
				if ( my $service_pid = $service->is_running ) {
					printf "\tStarted: %s [PID:%s]\n", ref $service, $service_pid;
				}
				else {
					printf "\tNot started after 10 seconds: %s\n", ref $service;
				}
			}
		}
		if ( $PERSISTENT ) {
			sleep 10;
			next SERVICE_POLL_AND_LAUNCH;
		}
		else {
			while(1){}
		}
	}
}

sub stop {
	my @SERVICES = @_;
	hijack;
	
	# loop over and kill services
	printf "Stopping processes for user %s:\n", $ENV{'USER'};
	for my $service ( @SERVICES ) {
		if ( my $service_pid = $service->is_running ) {
			$service->stop;
			printf "\tStopped: %s [PID:%s]\n", ref $service, $service_pid;
		}
		else {
			printf "\tService %s wasn't running anyway\n", ref $service;
		}
	}
	
}

sub restart {
	my @SERVICES = @_;
	hijack;
	
	# stopping and starting
	print "Restarting.\n";
	stop(  @SERVICES );
	start( @SERVICES );
}

sub status {
	my @SERVICES = @_;
	
	# loop over and check on services
	printf "Processes for user %s:\n", $ENV{'USER'};
	for my $service ( @SERVICES ) {
		if ( my $service_pid = $service->is_running ) {
			printf "\tRunning: %s [PID:%s]\n", ref $service, $service_pid;
		}
		else {
			printf "\tNot running: %s\n", ref $service;
		}
	}
}

# cleanup
my $deleteable_file = File::Spec->catfile(
	$ENV{'HOME'},
	'/cipres/tmp/',
	hostname() . '_cipresd.pid',
);
unlink $deleteable_file if -e $deleteable_file;

print "Done.\n";
exit 0;

__END__

=head1 NAME

cipresd - Daemon for CIPRES registry and properties services.

=head1 SYNOPSIS

 cipresd 
 	 --action=[start|stop|restart|status] [--persistent] [--fixedPort] [--help] [--man]

=head1 OPTIONS

=over 8

=item B<--help>, B<-?>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--persistent>

Switches to background process and continues to monitor launched services.

=item B<--fixedPort>

Starts registry service on a fixed port.

=item B<--action=>I<[action]>

Specifies which action to take, where available actions are listed below.

=back

=head2 ACTIONS

=over 12

=item I<start>

Starts any services currently not running. Leaves running processes, other than
the daemon, in place.

=item I<stop>

Stops any currently running services, including the daemon.

=item I<restart>

Restarts any services currently not running. Leaves running processes, other than
the daemon, in place.

=item I<status>

Prints the status of services: whether they are running, and under what PID.

=back

=head1 DESCRIPTION

This program launches and monitors CIPRES registry and properties services.
Correct usage of this program ensures no zombie process are created, while
any unexpectedly died services are restarted.

The daemon modifies its process table entry to reflect which process IDs it
is monitoring, and for which user. For example, an entry such as the 
following (produced with the C<ps -ax> command):

 cipresd (persistent) for rvosa [Cipres::CipresProperties:1443|Cipres::Registry:1447]

means that the daemon is tracking, for user rvosa, the CipresProperties service 
running under PID 1443, and the Registry service running under 1447.
The parenthetical C<(persistent)> indicates that, should one of these services 
die, the daemon will relaunch it and show the PID of the newly spawned service 
instead. 

Note that this feature is not available on Solaris (this is because the C<ps> 
command on that platform obtains its entries directly from the kernel, so that 
running process cannot modify their textual representation in the table).

=head1 ENVIRONMENT

=head2 VARIABLES

=over

=item $CIPRES_ROOT

The $CIPRES_ROOT environment variable needs to be set, and point to the root
of the cipres installation - i.e. the folder that contains the bin/, include/,
lib/ and share/ folders.

=back

=head2 FILES

=over

=item Writable $HOME/cipres/tmp

The daemon needs to be able to write PIDs to files (small text files with the 
.pid extension). This means that the $HOME/cipres/tmp folder structure must
exist and be writable.

=back

=head1 AUTHOR

Rutger Vos,

=over

=item email: C<rvos@interchange.ubc.ca>

=back

=cut


!NO!SUBS!