Proc-Terminator-0.05/0000755000175000017500000000000012006343165014677 5ustar mnunbergmnunbergProc-Terminator-0.05/Makefile.PL0000644000175000017500000000123711741740602016656 0ustar mnunbergmnunberguse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Proc::Terminator', AUTHOR => q{M. Nunberg }, VERSION_FROM => 'lib/Proc/Terminator.pm', ABSTRACT_FROM => 'lib/Proc/Terminator.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'Time::HiRes' => 0, 'POSIX' => 0, 'Moo' => 0.009014 }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Proc-Terminator-*' }, ); Proc-Terminator-0.05/lib/0000755000175000017500000000000012006343165015445 5ustar mnunbergmnunbergProc-Terminator-0.05/lib/Proc/0000755000175000017500000000000012006343165016350 5ustar mnunbergmnunbergProc-Terminator-0.05/lib/Proc/Terminator.pm0000644000175000017500000002430612006342775021045 0ustar mnunbergmnunbergpackage Proc::Terminator::Ctx; use strict; use warnings; use POSIX qw(errno_h); my $DEBUG = $ENV{PROC_TERMINATOR_DEBUG}; use Moo; has pid => ( is =>'ro', required => 1, isa => sub { ($_[0] && $_[0] > 0) or die "PID must be a positive number!" }, ); has siglist => ( is => 'rw', required => 0, isa => sub { ref $_[0] eq 'ARRAY' or die "Siglist must be an array reference" }, default => sub { [] } ); has last_sent => ( is => 'rw', default => sub { 0 } ); has error => ( is => 'rw', default => sub { "" } ); sub try_kill { my ($self,$do_kill) = @_; if (kill(0, $self->pid) == 0) { my $errno_save = $!; $DEBUG and warn "Kill with signal=0 returned 0 (dead!)"; if ($errno_save != ESRCH) { $self->error($errno_save); warn $errno_save; return -1; } # else, == ESRCH return 1; } if (!$do_kill) { $DEBUG and warn "We were not requested to proceed with signal. Returning"; return 0; } my $sig = shift @{$self->siglist}; if (!defined $sig) { $DEBUG and warn "Cannot kill ${\$self->pid} because no signals remain"; return -1; } $DEBUG and warn "Using signal $sig for ${\$self->pid}"; if (kill($sig, $self->pid) == 1) { return 0; } if ($! == ESRCH) { return 1; } else { warn $!; return -1; } } # This class represents a single 'batch' of PIDs each withe package Proc::Terminator::Batch; use strict; use warnings; use POSIX qw(:errno_h); use Time::HiRes qw(sleep time); use Moo; has procs => ( is => 'rw', isa => sub { ref $_[0] eq 'HASH' or die "Expected hash reference!" }, default => sub { { } }, ); has grace_period => ( is => 'rw', default => sub { 0.75 }); has max_wait => ( is => 'rw', default => sub { 10 }); has interval => (is => 'rw', default => sub { 0.25 }); has badprocs => (is => 'rw', isa => sub { ref $_[0] eq 'ARRAY' or die "Expected arrayref!" }, default => sub { [ ] } ); has begin_time => (is => 'rw', default => sub { 0 }); sub with_pids { my ($cls,$pids,%options) = @_; $pids = ref $pids ? $pids : [ $pids ]; my $siglist = delete $options{siglist} || [ @Proc::Terminator::DefaultSignalOrder ]; my %procs; foreach my $pid (@$pids) { $procs{$pid} = Proc::Terminator::Ctx->new( pid => $pid, siglist => [ @$siglist ], last_sent => 0); } my $self = $cls->new( procs => \%procs, max_wait => delete $options{max_wait} || 10, interval => delete $options{interval} || 0.25, grace_period => delete $options{grace_period} || 0.75, ); return $self; } sub _check_one_proc { my ($self,$ctx,$now) = @_; my $do_send_kill = $now - $ctx->last_sent > $self->grace_period; if ($do_send_kill) { $ctx->last_sent($now); $DEBUG and warn("Will send signal to ${\$ctx->pid}"); } my $ret = $ctx->try_kill($do_send_kill); if ($ret) { delete $self->procs->{$ctx->pid}; if ($ret == -1) { push @{ $self->badprocs }, $ctx; } } return $ret; } # The point of abstracting this is so that this module may be integrated # within event loops, where this method is called by a timer, or something. sub loop_once { my $self = shift; my @ctxs = values %{ $self->procs }; if (!scalar @ctxs) { $DEBUG and warn "Nothing left to check.."; if (@{$self->badprocs}) { return undef; } return 0; #nothing left to do } my $now = time(); if ($self->max_wait && ($now - $self->begin_time > $self->max_wait)) { # do one last sweep? while (my ($pid,$ctx) = each %{$self->procs}) { if (kill(0, $pid) == 0 && $! == ESRCH) { delete $self->procs->{$pid}; } else { push @{$self->badprocs}, $ctx; } } if (@{$self->badprocs}) { return undef; } return 0; } $self->_check_one_proc($_, $now) foreach (@ctxs); if (keys %{$self->procs}) { return scalar keys %{$self->procs}; } else { if (@{$self->badprocs}) { return undef; } return 0; } } package Proc::Terminator; use warnings; use strict; use Time::HiRes qw(time sleep); use POSIX qw(:signal_h :sys_wait_h :errno_h); use base qw(Exporter); our $VERSION = 0.05; our @DefaultSignalOrder = ( SIGINT, SIGQUIT, SIGTERM, SIGKILL ); our @EXPORT = qw(proc_terminate); use Data::Dumper; # Kill a bunch of processes sub proc_terminate { my ($pids, %options) = @_; my $batch = Proc::Terminator::Batch->with_pids($pids, %options); $batch->begin_time(time()); #print Dumper($batch); while ($batch->loop_once) { $DEBUG and warn "Sleeping for ${\$batch->interval} seconds"; sleep($batch->interval); } my @badprocs = map { $_->pid } @{$batch->badprocs}; if (wantarray) { return @badprocs; } else { return !@badprocs; } } __END__ =head1 NAME Proc::Terminator - Conveniently terminate processes =head1 SYNOPSIS use Proc::Terminator; # Try and kill $pid using various methods, waiting # up to 20 seconds proc_terminate($pid, max_wait => 20); =head1 DESCRIPTION C provides a convenient way to kill a process, often useful in utility and startup functions which need to ensure the death of an external process. This module provides a simple, blocking, and procedural interface to kill a process or multiple processes (not tested), and not return until they are all dead. C can know if you do not have permissions to kill a process, if the process is dead, and other interesting tidbits. It also provides for flexible options in the type of death a process will experience. Whether it be slow or immediate. This module exports a single function, C =head2 C Will try to terminate C<$pid>, waiting until the process is no longer alive, or until a fatal error happens (such as a permissions issue). C<$pid> can either be a single PID (a scalar), or a reference to an array of I PIDs, in which case they are all attempted to be killed, and the function only returning once all of them are dead (or when no possible kill alternatives remain). The C<%options> is a hash of options which control the behavior for trying to terminate the pid(s). =over =item C Specify the time (in seconds) that the function should try to spend killing the provided PIDs. The function is guaranteed to not wait longer than C. This parameter can also be a fractional value (and is passed to L). I: 10 Seconds. =item C An array of signal constants (use L's C<:signal_h> to get them). The signals are tried in order, until there are no more signals remaining. Sometimes applications do proper cleanup on exit with a 'proper' signal such as C. The default value for this parameter The default signal list can be found in C<@Proc::Terminator::DefaultSignalOrder> I: C<[SIGINT, SIGQUIT, SIGTERM, SIGKILL]> =item C This specifies a time, in seconds, between the shifting of each signal in the C parameter above. In other words, C will wait C<$grace_period> seconds after sending each signal in C. Thereafter the signal is removed, and the next signal is attempted. Currently, if you wish to have controlled signal wait times, you can simply insert a signal more than once into C I: 0.75 =item C This is the loop interval. The loop will sleep for ever C seconds. You probably shouldn't need to modify this I: 0.25 =back When called in a scalar context, returns true on sucess, and false otherwise. When called in list context, returns a list of the PIDS B killed. =head2 OO Interface This exists mainly to provide compatibility for event loops. While C loops internally, event loops will generally have timer functions which will call within a given interval. In the OO interface, one instantiates a C object which contains information about the PIDs the user wishes to kill, as well as the signal list (in fact, C is a wrapper around this interface) =head3 Proc::Terminator::Batch methods =head4 Proc::Terminator::Batch->with_pids($pids,$options) Creates a new C. The arguments are exactly the same as that for L. Since this module does not actually loop or sleep on anything, it is important to ensure that the C and C options are set appropriately. In a traditional scenario, a timer would be associated with this object which would fire every C seconds. =head4 $batch->loop_once() Iterates once over all remaining processes which have not yet been killed, and try to kill them. Returns a true value if processes still remain which may be killed, and a false value if there is nothing else to do for this batch. More specifically, if all processes have been killed successfully, this function returns C<0>. If there are still processes which are alive (but cannot be killed due to the signal stack being empty, or another error), then C is returned. =head4 $batch->badprocs Returns a reference to an array of C objects which were not successfully terminated. The Ctx object is a simple container. Its API fields are as follows: =over =item pid The numeric PID of the process =item siglist A reference to an array of remaining signals which would have been sent to this process =item error This is the captured value of C<$!> at the time the error occured (if any). If this is empty, then most likely the process did not respond to any signals in the signal list. =head1 SEE ALSO L L L =head1 AUTHOR & COPYRIGHT Copyright (C) 2012 M. Nunberg You may use and distribute this software under the same terms and conditions as Perl itself. Proc-Terminator-0.05/t/0000755000175000017500000000000012006343165015142 5ustar mnunbergmnunbergProc-Terminator-0.05/t/00-all.t0000644000175000017500000000321311741476212016320 0ustar mnunbergmnunberg#!/usr/bin/env perl use strict; use warnings; use Test::More; use Time::HiRes qw(time); use POSIX qw(pause :signal_h :sys_wait_h); use_ok('Proc::Terminator'); # Try with a single PID first, right? my @SIG_ORDER = ( SIGINT, SIGQUIT, SIGKILL ); my $MAX_WAIT = 5; my $GRACE_PERIOD = 1; my $CHILD_DEAD = 0; my $PID; $SIG{CHLD} = sub { waitpid($PID, WNOHANG); diag sprintf( "REAP %d. WIFSIGNALED: %d WTERMSIG: %d", $PID, WIFSIGNALED($?), WTERMSIG($?)); $CHILD_DEAD = 1; }; sub _forkproc { local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; $PID = fork(); die "Couldn't fork" unless $PID >= 0; diag "SPAWN $PID" if $PID; if ($PID==0) { alarm(7); while (1) { POSIX::pause(); warn("Interrupted.."); } die("We shouldn't get here!"); } } my $ret; my ($BEGIN_TIME,$DURATION); $BEGIN_TIME = time(); _forkproc(); $ret = proc_terminate($PID, max_wait => $MAX_WAIT, grace_period => $GRACE_PERIOD); $DURATION = time() - $BEGIN_TIME; ok($DURATION > 1, "We slept a bit waiting"); ok($DURATION < 3, "We didn't sleep too much"); ok($ret, "Killed successfuly"); $BEGIN_TIME = time(); _forkproc(); $ret = proc_terminate($PID, max_wait => 5, siglist => [SIGINT], grace_period => 0.5); $DURATION = time() - $BEGIN_TIME; ok($DURATION < 1.5, "Waited less than 1.5 secs"); ok(!$ret, "Couldn't kill with ignored signal"); $BEGIN_TIME = time(); $ret = proc_terminate($PID, max_wait => 0.1, siglist => [SIGTERM]); $DURATION = time() - $BEGIN_TIME; ok($DURATION < 1, "Slept less than a second"); ok($ret, "Killed ok with SIGTERM"); done_testing(); Proc-Terminator-0.05/MANIFEST0000644000175000017500000000035612006343165016034 0ustar mnunbergmnunbergChanges MANIFEST Makefile.PL README lib/Proc/Terminator.pm t/00-all.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Proc-Terminator-0.05/Changes0000644000175000017500000000067512006343041016173 0ustar mnunbergmnunbergRevision history for Proc-Terminator 0.04 August 1 2012 Make defaults coderefs for Moo 0.03 April 12 2012 Exposed OO interface for subsequent use in POE component 0.02 April 11 2012 Fixed race condition in tests (forking and modifying %ENV) Make final kill(0, $pid) sweep before determining process is not yet dead 0.01 Date/time First version, released on an unsuspecting world. Proc-Terminator-0.05/META.yml0000644000175000017500000000103512006343165016147 0ustar mnunbergmnunberg--- abstract: 'Conveniently terminate processes' author: - 'M. Nunberg ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Proc-Terminator no_index: directory: - t - inc requires: Moo: 0.009014 POSIX: 0 Test::More: 0 Time::HiRes: 0 version: 0.05 Proc-Terminator-0.05/README0000644000175000017500000000303411725253116015562 0ustar mnunbergmnunbergProc-Terminator The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it to get an idea of the module's uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Proc::Terminator You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Proc-Terminator AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Proc-Terminator CPAN Ratings http://cpanratings.perl.org/d/Proc-Terminator Search CPAN http://search.cpan.org/dist/Proc-Terminator/ LICENSE AND COPYRIGHT Copyright (C) 2012 M. Nunberg This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Proc-Terminator-0.05/META.json0000644000175000017500000000170712006343165016325 0ustar mnunbergmnunberg{ "abstract" : "Conveniently terminate processes", "author" : [ "M. Nunberg " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Proc-Terminator", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "Moo" : "0.009014", "POSIX" : 0, "Test::More" : 0, "Time::HiRes" : 0 } } }, "release_status" : "stable", "version" : "0.05" }