#!/usr/local/bin/perl -w
#$Revision: 1.9 $$Date: 2002/08/20 15:13:26 $$Author: wsnyder $
######################################################################
#
# This program is Copyright 2002 by Wilson Snyder.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either the GNU General Public License or the
# Perl Artistic License.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the Perl Artistic License
# along with this module; see the file COPYING.  If not, see
# www.cpan.org
#                                                                           
######################################################################

require 5.6.0;
use Getopt::Long;
use IO::File;
use Pod::Usage;
use Sys::Hostname;
use Cwd qw (getcwd chdir);
use strict;
use vars qw ($Debug);
use IPC::PidStat;

#======================================================================

our @Orig_Argv = @ARGV;
our @Opt_FgArgv;
our $Opt_Host = hostname();
our $Opt_Pid;
our $Opt_Signal = 'HUP';
our $Opt_Killer;

#======================================================================
# main

$SIG{CHLD} = 'IGNORE';

my $opt_cd;
my %server_params = ();

$Debug = 0;
Getopt::Long::config ("require_order");
if (! GetOptions (
		  "help"	=> \&usage,
		  "debug"	=> \&debug,
		  "port=i"	=> sub {shift; $server_params{port} = shift;},
		  #
		  "host=s"	=> \$Opt_Host,
		  "pid=i"	=> \$Opt_Pid,
		  "cd=s"	=> \$opt_cd,
		  "signal=s"	=> \$Opt_Signal,
		  "killer=s"	=> \$Opt_Killer,
		  "<>"		=> \&parameter,
		  )) {
    usage();
}
push @Opt_FgArgv, @ARGV;

$Opt_Host or die "%Error: --host not specified\n";
$Opt_Pid or die "%Error: --pid not specified\n";
$Opt_FgArgv[0] or die "%Error: No command specified\n";

if ($opt_cd && -d $opt_cd) {
    $ENV{PWD} = $opt_cd;
    chdir ($opt_cd);
}

my $exister = new IPC::PidStat (%server_params);

# Debugging
my $dbgfh = \&STDERR;
#$dbgfh = IO::File->new("$ENV{HOME}/pidwatch_$$","w") if $Debug;
print $dbgfh "\tArgs: @Orig_Argv\n" if $Debug;

# Fork once to start parent process
my $foreground_pid = $$;  # Unlike most forks, the job goes in the parent
if (my $pid = fork()) {  # Parent process, foreground job
    print $dbgfh "\tForeground: @Opt_FgArgv\n" if $Debug;
    exec ("/bin/sh", "-c", join(' ',@Opt_FgArgv));
    die "%Error: Exec failed: @Opt_FgArgv,";
}
#else, rest is for child process.

# Disassociate from controlling terminal
POSIX::setsid();
open(STDIN,  "+>/dev/null");
if (!$Debug) {
    open(STDOUT, "+>&STDIN");
    open(STDERR, "+>&STDIN");
}
# Prevent possibility of acquiring a controling terminal
exit if fork();
# Change working directory
chdir "/";

while (1) {
    if (IPC::PidStat::local_pid_doesnt_exist($foreground_pid)) {
	print $dbgfh "  Local pid $foreground_pid died\n" if $Debug;
	exit(0);
    }
    $exister->pid_request(host=>$Opt_Host, pid=>$Opt_Pid);
    my @recved;
    eval {
	local $SIG{ALRM} = sub { die "Timeout\n"; };
	alarm(1);
	@recved = $exister->recv_stat();
	alarm(0);
    };
    if ($recved[0]
	&& $recved[0]==$Opt_Pid
	&& $recved[1]==0) {   # It doesn't exist.  Oh my.
	print $dbgfh "  Remote pid $Opt_Pid died\n" if $Debug;
	if ($Opt_Killer) {
	    exec ($Opt_Killer, $Opt_Signal, $foreground_pid);
	    exit(0);  # If exec fails...
	} else {
	    $Opt_Signal =~ s/^-?(SIG)?//;
	    kill $Opt_Signal, $foreground_pid;
	}
	exit(0);
    }
    sleep 1;
}

#----------------------------------------------------------------------

sub usage {
    print '$Revision: 1.9 $$Date: 2002/08/20 15:13:26 $$Author: wsnyder $ ', "\n";
    pod2usage(-verbose=>2, -exitval => 2);
    exit (1);
}

sub debug {
    $Debug = 1;
    $IPC::PidStat::Debug = 1;
}

sub parameter {
    my $param = shift;
    if ($Opt_FgArgv[0] || $param !~ /^-/) {
	push @Opt_FgArgv, $param;
    } else {
	die "%Error: Unknown option: $param\n";
    }
}
 
#######################################################################
__END__

=pod

=head1 NAME

pidwatch - Run a command and if another PID exits, kill the command

=head1 SYNOPSIS

C<pidwatch> [--cd I<cd>] --host I<host> --pid I<pid>  [args....]

=head1 DESCRIPTION

Chdir to the specified directory, if specified and possible.

Run the arguments as a command in the forground.  When the forground
process exits, return its exit status.

In the background, watch the specified pid on the specified host.  If
C<pidstatd> is running on the specified host, and the specified pid goes
away, kill the forground command.

Common usage is to kill remote rsh children when a parent is kill -9ed.
An example Perl application would invoke:

    system("rsh \$remote_host pidwatch"
           ." --cd \$ENV{PWD} --host \$ENV{HOST} --pid \$\$"
           ."\$remote_command...");

=head1 ARGUMENTS

=over 4

=item --cd I<dir>

Directory to chdir to.

=item --help

Displays this message and program version and exits.

=item --host I<host>

Hostname to check for specified pid on.  C<pidstatd> must be running
on that host to have this program be useful.

=item --killer I<program>

Program to use instead of kill when it's time to terminate the pid.  Will
be passed arguments as if it was /bin/kill (I<program> I<signame> I<pid>).

=item --pid I<pid>

Process ID to watch.  When this pid exits, the program will kill the
foreground process.

=item --port I<port>

Port of C<pidstatd> server on remote host.

=item --signal I<signame>

Signal number/name to send to process on remote PID's death.  Defaults to
-HUP.

=back

=head1 SEE ALSO

C<IPC::PidStat>

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=cut

######################################################################
### perl -e 'print "$$\n"; while(1) { sleep(1); }'
### Local Variables:
### compile-command: "./pidwatch "
### End:
