#!/usr/bin/perl
#
# $Revision: 1.12 $ $Date: 2024-09-28 06:15:35-04 $
# $Source: /home/vogelke/bin/RCS/killpg,v $
# $Host: furbag $
# $UUID: 130e2362-be9d-3018-9c2d-68c845c086c1 $
#
#<killpg: implementation of killpg(2) as a Perl script.
#
# Borrowed from the Perl Power Tools (PPT) project.
# Original by by Theo Van Dinter (felicity@kluge.net).
# kill,v 1.2 2004/08/05 14:17:43 cwest Exp

use Modern::Perl;
use Config;
use integer;
use Pod::Usage;
use File::Basename;

my $myname = basename($0);
$myname =~ s/\.\w*$//;    # strip any extension

# die if no signals or no arguments
die "$myname: No signals defined ?!?"
  unless defined $Config{"sig_name"};

die "$myname: Too few arguments; try $0 -h\n"
  unless (@ARGV);

my (@signals) = split(/\s+/, $Config{"sig_name"});
my ($signal)  = 15;                                  # default of SIGTERM

my %hsignals;
for (my ($i) = 1 ; $i <= $#signals ; $i++) {
    $hsignals{$signals[$i]} = $i;
}

if ($ARGV[0] =~ /^-l$/i) {    # list signals
    for (my ($i) = 1 ; $i <= $#signals ; $i++) {
        printf "%2d:%-6s%s", $i, $signals[$i],
          (($i % 8 == 0) || ($i == $#signals)) ? "\n" : " ";
    }
    exit(0);
}
elsif ($ARGV[0] =~ /^-h$/i) {    # help me!
    print "usage:  $0 [-s signame] PGID ...
	$0 [-signame] PGID ...
	$0 [-signumber] PGID ...
	$0 PGID ...
	$0 [-hlmvw]
";
    exit(0);
}
elsif ($ARGV[0] =~ /^-m$/i) {    # more help
    my @args = ("perldoc", "$0");
    exec {$args[0]} @args;    # safe even with one-arg list
    die("should not get here\n");
}
elsif ($ARGV[0] =~ /^-v$/i) {    # version
    my $VERSION =
      sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/);
    my $DATE =
      sprintf("%s", q$Date: 2024-09-28 06:15:35-04 $ =~ /Date: (.*) /);
    print "$myname $VERSION $DATE\n";
    exit(0);
}
elsif ($ARGV[0] =~ /^-w$/i) {    # where's the code
    my $SOURCE = sprintf("%s",
        q$Source: /home/vogelke/bin/RCS/killpg,v $ =~ /Source: (.*) /);
    print "$SOURCE\n";
    exit(0);
}
elsif ($ARGV[0] =~ /^-\d+$/) {    # -signalnumber
    ($signal) = ($ARGV[0] =~ /^-(\d+)/);
    die "$0: Bad signal number.\n" if ($signal > $#signals);
    shift @ARGV;
}
elsif ($ARGV[0] =~ /^-/) {    # -NAME or -s NAME
    ($signal) = ($ARGV[0] =~ /^-(.+)$/);
    shift @ARGV;
    $signal = shift @ARGV if (lc $signal eq "s"); # -s has signalname param.
    $signal = uc $signal;
    $signal =~ s/^SIG//;    # remove the "SIG" from SIGNAME
    die "$0: $signal: Unknown signal; $0 -l lists signals.\n"
      unless ($hsignals{$signal});
    $signal = $hsignals{$signal};
}

die "$myname: No PGIDs specified.\n" unless (@ARGV);

my ($ret) = 0;
foreach (@ARGV) {    # do the kills...
    unless (kill(-$signal, $_)) {
        warn "$myname: $_: $!\n";
        $ret = 1;
    }
}

exit($ret);

__END__
=head1 NAME

killpg - send signals to a process group

=head1 SYNOPSIS

B<killpg> [B<-s> I<signame>] PGID ...

B<killpg> [B<-signame>] PGID ...

B<killpg> [B<-signumber>] PGID ...

B<killpg> [B<-hlmvw>]

=head1 DESCRIPTION

B<killpg> sends a signal to all process groups specified on the command line.
This is typically done to cause one or more processes to terminate, reload
configuration files, etc.

Process groups can be very useful, especially for things like long-running
scripts that spawn multiple programs.  For example, this program creates
compressed cpio-style files for backup:

    USER   PID  PPID  PGID      STIME    TIME COMMAND
    root  9353     1  9352   17:29:12   00:00 /bin/ksh /root/bin/docopy
    root 18347  9353  9352   21:22:30   01:07 compress
    root 18346  9353  9352   21:22:30   00:09 pax -wd -x cpio

If you wanted to stop this cleanly without relying on signals propagating
from the parent process, you could kill all three PIDs, or just kill the
process group-leader (9352).

=head1 OPTIONS AND ARGUMENTS

=over 4

=item I<-s>

This parameter takes a single argument of a signal name (see -l) to be
sent to the process groups.

=item I<-signame>

A short form of the C<-s signame> parameter.

=item I<-signumber>

This parameter specifies that the given signal number
should be sent to the process groups.

=item I<-h>

Print a short list of available options and exit.

=item I<-l>

Display a listing of all available signals on the current system.

=item I<-m>

Print a longer manpage with examples and exit.

=item I<-v>

Print the version and exit.

=item I<-w>

Print where the RCS sourcefile is and exit.

=back

=head1 NOTES

If no signal is specified on the command line, SIGTERM is sent to the
process groups.  killpg returns 0 on success or >0 if an error occurred.

Only the super-user may send signals to other users' processes.

Signal names may have the I<SIG> prefix, i.e. C<killpg -HUP> and C<killpg
-SIGHUP> are equivalent.

The signal list C<killpg -l> displays in an "extended" form which lists
both the signal name and number for easy reference.

=head1 HISTORY

Original version rewritten for the Perl Power Tools project from the
description of the kill program in OpenBSD.

=head1 ORIGINAL AUTHOR

Theo Van Dinter (felicity@kluge.net)

Hacked up to kill process groups by Karl Vogel (vogelke@pobox.com)

=head1 SEE ALSO

ps(1), killpg(2)

=cut