#!/usr/local/bin/perl
#
# zap  -- blow away (or renice) processes
# tom christiansen -- tchrist@convex.com
#
# currently configured for BSD
#
# Patterned after an idea from K&P, an old script
# of mine, and Jeff Forys's humungous C program, skill. :-)
#
#
# some defaults... look out for the first one!

($PRIO_MIN, $PRIO_MAX) = (-64, 64); 	# from sys/resource.h
$signal   = 'TERM';
$priority = +4;

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

setpriority(0, $$, $PRIO_MIN);  	# faster faster faster
$SIG{HUP} = IGNORE;

$| = 1;

&init;
&parse_args;
&usage unless @cmd || @tty || @pid || @regexp || @user;
&dump_values if $flag{'d'};
&start_ps;
&kill_procs;
exit $status;

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

sub parse_args {
    local($numarg, $type, $signals);  # include *targets and die

    while ($_ = shift @ARGV) {
	if (/^[-+](\d+)$/) { 
	    $numarg = $_;   # signal or numeric
	} 
	elsif (s/^-//) {
	    if (defined $signame{$_}) { 
		if ($mode eq 'nice') {
		    warn "$0: can't mix signals with niceties, ignoring -$_\n";
		} else {
		    $signal = $_; 
		}
	    } 
	    elsif (s/^([cputr])(.*)//) {
		*targets = $targptr{$type = $abbrev{$1}};
		$_ = $2 || shift @ARGV;
		unless (&targets($_)) {
		    die "$0: $_: invalid $type" unless $type eq 'regexp';
		    die "$0: $@\n";
		}
		push(@targets, $_);
	    } 
	    else { 	# these can be anywhere
		$flag{$1}++ while s/^([ildvNna])//; 
		if (/[cputr]/) { s/^/-/; redo; }   # bad hack
		if ($_ ne '') {
		    warn "$0: unknown option -$_\n";
		    &usage;
		}
		if ($flag{'l'}) {
		    $signals = "@signum";
		    write; # see format at end of file
		    exit;
		} 
	    } 
	} 
	else { 					# time to guess
	    if ( s!^/dev/!! || &tty($_)) {
		*targets = $targptr{'tty'};
	    } elsif (&user($_)) {
		*targets = $targptr{'user'};
	    } elsif (&pid($_)) {
		*targets = $targptr{'pid'};
	    } elsif (s!^/(.*)/?$!$1!) {
		die "$0: $@\n" unless &regexp($_);
		*targets = $targptr{'regexp'};
	    } else {
		*targets = $targptr{'cmd'};
	    } 
	    push(@targets,$_);
	} 
    } 

    $mode = 'nice' if $flag{'N'};

    if (defined $numarg) {
	if ($mode eq 'kill') {
	    $numarg =~ s/^[-+]//;
	    $signal = $numarg ? $signum[$numarg] : 0; #  perl hates 'ZERO'
	} else {
	    undef $signal;
	    $priority = $numarg;
	    $priority = $PRIO_MIN 	if $priority < $PRIO_MIN;
	    $priority = $PRIO_MAX 	if $priority > $PRIO_MAX;
	} 
    }

} 


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

sub uid2name {
    local($uid) = @_;
    unless (defined $name{$uid}) {
	local($name) = (getpwuid($uid))[0];
	$uid{$name} = $uid;
	$name{$uid} = $name;
    }
    $name{$uid};
} 

sub name2uid {
    local($name) = @_;
    unless (defined $uid{$name}) {
	local($uid) = (getpwnam($name))[2];
	$uid{$name} = $uid;
	$name{$uid} = $name;
    }
    $uid{$name};
} 

######################################################################
# magic names here -- touch these and you are apt to be surprised

sub pid {
    local($pid) = @_;
    $pid =~ /^\d+$/;
}

sub tty {
    local($tty) = @_;
    $tty =~ /^tty/ && -c "/dev/$tty";
} 

sub user { 
    local($who) = @_;
    local($ok) = &name2uid($who); 
    defined $ok;
} 

sub cmd {
    1;   
} 

sub regexp {
    local($pat) = @_;
    eval '/$pat/';
    $@ =~ s/at \(eval\).*\n//;
    $@ eq '';
} 

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

sub init {

#    run either as skill or as snice; this tells whether -5 is a 
#    signal or a priority

    $mode = 'kill';
    $mode = 'nice' if $0 =~ /nice/;

#   generate signal names ; comment out signames assignment
#   to run kill -l instead to figure it out

    $signames = <<__EOLIST__;  # comment out for dynamic determination
	HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM
	TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF
	WINCH LOST USR1 USR2
__EOLIST__

    local($signal);
    $signum[0] = 'ZERO';
    for (split(' ', $signames ? $signames : `kill -l`)) { 
	$signame{$_} = ++$signal; 
	$signum[$signal] = $_;
    }

#   set up pointers and single-char abbrev for our 4 target arrays
#   if you change one of strings, all idents of this name, including
#   the subroutines, must change also.  be VERY CAREFUL.

    for ('cmd', 'pid', 'user', 'tty', 'regexp') {
	$abbrev{(/^(.)/)[0]} = $_;
	$targptr{$_} = eval "*$_";
    } 

#   some defaults

}

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

sub dump_values {
    print "signal is $signal -$signame{$signal}\n" if $mode eq 'kill';
    print "will renice targets to $priority\n" if $mode eq 'nice';

    for (keys %targptr) {
	*targ = $targptr{$_};
	next unless defined @targ;
	print "$_ targets are ", join(', ', @targ), "\n";
    } 

    @flags = keys %flag;
    grep(s/^/-/, @flags);
    print "option flags are @flags\n";
}

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

sub usage {
     die <<EOF;
Usage:
     skill [-signal] [-Nildvna] {tty user command pid regexp}
     snice [(-|+)priority] [-Nildvna] {tty user command pid regexp}

	 -i	interactive
	 -v	show candidates
	 -n	like -v but do not really do it
	 -a	all procs are candidates
	 -N	nice mode 
	 -d	enable debugging

	 -l	list signals and exit

     Uniquely identify {...} args with leading -t, -u, -c, -p, -r
     Or use a leading slash for a regexp.
EOF
    exit 1;
} 

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

sub start_ps {
    $ps = 'ps xl';
    $ps .= 'w';

    grep($pid{$_}++, @pid);
    grep($user{&name2uid($_)}++, @user);
    grep($tty{$_}++, @tty);
    grep($cmd{$_}++, @cmd);
    $regexp = join('|', @regexp);

    $ps .= 'w' if $regexp;
    $ps .= 'a' if  $> == 0  	||
		   $flag{'a'}   ||
		   @user > 1 	|| 
		   (@user == 1 && &name2uid($user[0]) != $>);
    
    if (! $pattern && @cmd && !grep(m!^/!, @cmd)) { $ps .= 'c'; } 

    if (@tty == 1) {  # faster
	$tty[0] =~ /^tty(..)/;
	$ps .= "t$1";
    } 

    print "ps command is $ps\n" if $flag{'d'};

    defined($kid_pid = open(PS, "$ps |")) ||   die  "can't run ps: $!";
    if (<PS> !~ /UID/) {
	warn "Something's wrong with ps";
	kill 'TERM', $kid_pid;
	exit 2;
    } 

    $dad_pid = getppid();
} 

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

sub kill_procs {
    while (<PS>) {
	($user, $pid) = /^\s*[a-f\d]+\s+(\d+)\s*(\d+)/i;

	next if $pid == $$;
	next if $pid == $kid_pid;
	next if $pid == $dad_pid && $mode eq 'kill';
	
	next if @user && !$user{$user};
	next if @pid  && !$pid{$pid};

	($tty, $cmd) = /\s*(\S*)\s*\d+:\d+\s+(.*)$/;
	$tty = "tty$tty" unless $tty =~ /\?/;

	next if @tty  && !$tty{$tty};
	next if @regexp && $cmd !~ /$regexp/o;

	if (@cmd) {
	    ($cmdname) = ($cmd =~ /^(\S+)/);
	    $cmdname =~ s!.*/!!;
	    next if !$cmd{$cmd} && !$cmd{$cmdname};
	}

	printf "%5d  %-8s %-5s  %s ", $pid, &uid2name($user), $tty, $cmd
	    if $flag{'v'} || $flag{'i'} || $flag{'n'};

	if ($flag{'i'}) {
	    $_ = <STDIN>;
	    defined 	|| exit;
	    /^\s*y/i 	|| next;
	}

	$hits++;

	unless ($flag{'n'}) {
	    $! = 0;
	    if ($mode eq 'kill') {
		kill $signal, $pid;
	    } else {
		setpriority(0, $pid, $priority);
	    } 
	    if ($!) { 
		warn (($mode eq 'kill' ? 'kill' : 'setpriority')
		    .   " $pid: $!\n");
		$status = 1;
		next;
	    }
	}

	print "\n" if $flag{'v'} || $flag{'n'};
    } 
    close PS || die "something happened to your $ps";
    warn "$0: no target processes found\n" unless $hits;
} 

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

format STDOUT = 
Any of the following signals are valid, or their numeric equivalents:
~~   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      $signals
.