#!/usr/local/bin/perl
#
# Copyright (c) 2003, 2005, 2017  Peter Pentchev
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use v5.010;
use strict;
use warnings;

use Getopt::Std;

sub usage(;$)
{
	my ($err) = @_;
	$err //= 1;

	my $s = <<'EOUSAGE' ;
Usage:	stalepid [-bhV] pidfile processname

	-b	use a BSD-like ps(1) syntax (default);
	-d	display debug information;
	-h	display this help text and exit;
	-V	display version information and exit.
EOUSAGE

	if ($err) {
		die $s;
	} else {
		print $s;
	}
}

sub version()
{
	say 'stalepid 1.0.2';
}

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

	die "PID file name not specified\n" unless defined $fname;

	open my $pidfile, '<', $fname or do {
		if ($!{ENOENT}) {
			say STDERR
			    "stalepid: the pid file $fname does not exist"
			    if $cfg->{debug};
			exit 0;
		}
		die "Opening $fname: $!\n";
	};
	my $line = <$pidfile>;
	die "Reading from $fname: $!\n" unless defined $line;
	close $pidfile;

	chomp $line;
	die "Invalid process ID format: $line\n" unless $line =~ /^(\d+)$/;
	$cfg->{pid} = $1;
}

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

	die "Undefined process id in checkproc\n" unless defined $pid;
	die "Undefined process name in checkproc\n" unless defined $procname;

	die "Methods other than a BSD-compatible ps(1) not supported yet!\n" unless $cfg->{bsdps};
	my @cmd = ('/bin/ps', '-c', '-p', $pid, '-o', 'command');
	say STDERR 'stalepid: attempting to execute '.join(' ', @cmd)
	    if $cfg->{debug};
	my $childpid = open my $ps, '-|';
	if (!defined $childpid) {
		die "Creating a child process failed: $!\n";
	} elsif ($childpid == 0) {
		$ENV{PATH} = '/usr/bin:/bin';
		exec { $cmd[0] } @cmd;
		die "Executing '".join(' ', @cmd)." failed: $!\n";
	}
	my @output = <$ps>;
	close $ps;
	if (@output == 1) {
		say STDERR "No process with pid $pid" if $cfg->{debug};
		$cfg->{exists} = undef;
		return;
	}
	if (@output != 2) {
		die 'The ps(1) output should contain 2 lines, not '.
		    scalar(@output)."\n";
	}
	chomp for @output;
	say STDERR "stalepid: got output:\n".join("\n", @output)."---"
	    if $cfg->{debug};
	say STDERR "stalepid: procname is $procname" if $cfg->{debug};
	$cfg->{exists} = $output[1] eq $procname;
	say STDERR "stalepid: exists is $cfg->{exists}, pid is $cfg->{pid}"
	    if $cfg->{debug};
}

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

	die "Undefined process id at killproc\n" unless defined $pid;
	die "Undefined pidfile name at killproc\n" unless defined $fname;

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

sub help_or_version($)
{
	my ($opts) = @_;
	my $has_dash = defined $opts->{'-'};
	my $dash_help = $has_dash && $opts->{'-'} eq 'help';
	my $dash_version = $has_dash && $opts->{'-'} eq 'version';
	
	if ($has_dash && !$dash_help && !$dash_version) {
		warn "Invalid long option '".$opts->{'-'}."' specified\n";
		usage 1;
	}
	version if $opts->{V} || $dash_version;
	usage 0 if $opts->{h} || $dash_help;
	exit 0 if $opts->{V} || $opts->{h} || $has_dash;
}

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

	my %opts;
	getopts("bdhV-:", \%opts) or usage();

	help_or_version \%opts;

	if (defined $opts{b}) {
		# Keep this, might look directly in /proc in the future
		$config{bsdps} = 1;
	}
	$config{debug} = 1 if defined $opts{d};

	usage if @ARGV != 2;
	@config{qw(pidfile procname)} = @ARGV;

	eval {
		readpid \%config;
		checkproc \%config;
		killproc \%config;
	};
	if ($@) {
		my $e = $@;
		chomp $e;
		die "stalepid: $e\n";
	}
}
