#!/usr/bin/perl -wT
# $Ringlet: perl/sys/stalepid/stalepid.pl,v 1.2 2003/12/04 14:09:09 roam Exp $

use strict;

use Errno;
use Error qw(:try);
use Getopt::Std;

sub usage()
{
	die("Usage: stalepid [-5bhV] pidfile processname\n".
	    "\t-5\tuse a SysV-like ps(1) syntax (not implemented yet);\n".
	    "\t-b\tuse a BSD-like ps(1) syntax (default);\n".
	    "\t-d\tdisplay debug information;\n".
	    "\t-h\tdisplay this help text and exit;\n".
	    "\t-V\tdisplay version information and exit.\n");
}

sub version()
{
	print("stalepid 1.0pre1\n");
}

sub readpid($)
{
	my $cfg = $_[0];
	my ($fname) = $cfg->{'pidfile'};
	my ($line);

	if (!defined($fname)) {
		die("PID file name not specified");
	}
	if (!open(PIDFILE, "< $fname")) {
		if ($!{ENOENT}) {
			print STDERR
			    "stalepid: the pid file $fname does not exist\n"
			    if $cfg->{'debug'};
			exit(0);
		}
		die("Opening $fname: $!\n");
	}
	if (!defined($line = <PIDFILE>)) {
		die("Reading from $fname: $!\n");
	}
	close(PIDFILE);
	$line =~ s/[\r\n]*$//;
	if ($line !~ /^(\d+)$/) {
		die("Invalid process ID format: $line\n");
	}
	$cfg->{'pid'} = $1;
}

sub checkproc($)
{
	my $cfg = $_[0];
	my ($pid, $procname) = ($cfg->{'pid'}, $cfg->{'procname'});
	my ($childpid, @cmd, @output);

	if (!defined($pid)) {
		die("Undefined process id in checkproc\n");
	}
	if (!defined($procname)) {
		die("Undefined process name in checkproc\n");
	}
	if ($cfg->{'bsdps'}) {
		@cmd = ('/bin/ps', '-axc', '-p', $pid, '-o', 'command');
	} else {
		die("SysV ps not supported yet!\n");
	}
	print STDERR 'stalepid: attempting to execute '.join(' ', @cmd)."\n"
	    if $cfg->{'debug'};
	if (!defined($childpid = open(PS, "-|"))) {
		die("Creating a child process failed: $!\n");
	} elsif ($childpid == 0) {
		$ENV{'PATH'} = '/usr/bin:/bin';
		exec(@cmd);
		die("Executing '".join(' ', @cmd)." failed: $!\n");
	}
	@output = <PS>;
	close(PS);
	if ($#output == 0) {
		print STDERR "No process with pid $pid\n" if $cfg->{'debug'};
		$cfg->{'exists'} = undef;
		return;
	}
	if ($#output != 1) {
		die('The ps(1) output should contain 2 lines, not '.
		    ($#output + 1)."\n");
	}
	map { s/[\r\n]*$// } @output;
	print STDERR "stalepid: got output:\n".join("\n", @output)."---\n"
	    if $cfg->{'debug'};
	print STDERR "stalepid: procname is $procname\n" if $cfg->{'debug'};
	$cfg->{'exists'} = $output[1] eq $procname;
	print STDERR "stalepid: exists is ".$cfg->{'exists'}.", pid is ".
	    $cfg->{'pid'}."\n" if $cfg->{'debug'};
}

sub killproc($)
{
	my $cfg = $_[0];
	my ($pid, $fname) = ($cfg->{'pid'}, $cfg->{'pidfile'});

	if (!defined($pid)) {
		die("Undefined process id at killproc\n");
	}
	if (!defined($fname)) {
		die("Undefined pidfile name at killproc\n");
	}
	if ($cfg->{'exists'}) {
		if (kill(0, $pid) == 1) {
			print STDERR 'stalepid: the '.$cfg->{'procname'}.
			    " process is alive and running as $pid\n"
			    if $cfg->{'debug'};
			return;
		}
		if (!$!{ENOENT}) {
			die("Attempting to signal process $pid: $!\n");
		}
	}
	unlink($fname) or die("Removing pid file $fname: $!\n");
}

MAIN:
{
	my %opts;
	my %config = (
		'bsdps'		=> 1,
		'debug'		=> 0,
		'exists'	=> 0,
		'pid'		=> undef,
		'pidfile'	=> undef,
		'procname'	=> undef,
	);

	getopts("5bdhV", \%opts) or usage();

	if (defined($opts{'V'})) {
		version();
		exit(0);
	}
	usage() if (defined($opts{'h'}));
	if (defined($opts{'b'})) {
		usage() if (defined($opts{'5'}));
		$config{'bsdps'} = 1;
	} elsif (defined($opts{'5'})) {
		$config{'bsdps'} = 0;
	}
	$config{'debug'} = 1 if (defined($opts{'d'}));

	usage() if ($#ARGV < 1);
	# Anything goes for the pidfile syntax..
	if ($ARGV[0] =~ '^(.*)$') {
		$config{'pidfile'} = $1;
	}
	# ...and for the procname syntax, too.
	if ($ARGV[1] =~ '^(.*)$') {
		$config{'procname'} = $1;
	}

	try {
		&readpid(\%config);
		&checkproc(\%config);
		&killproc(\%config);
	} catch Error with {
		my $e = shift;
		chomp $e;
		die("stalepid: $e\n");
	}
}