Skip Menu |
 

This queue is for tickets about the Unix-PID-Tiny CPAN distribution.

Report information
The Basics
Id: 86817
Status: resolved
Priority: 0/
Queue: Unix-PID-Tiny

People
Owner: Nobody in particular
Requestors: dmuey [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: minor fixes
MIME-Version: 1.0
X-Mailer: MIME-tools 5.504 (Entity 5.504)
Content-Disposition: inline
X-RT-Interface: Web
Message-ID: <rt-4.0.13-29743-1373403655-1864.0-0-0 [...] rt.cpan.org>
Content-Type: text/plain; charset="utf-8"
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
X-RT-Encrypt: 0
X-RT-Sign: 0
Content-Length: 1951
Download (untitled) / with headers
text/plain 1.9k
* init minimum_pid * quiet some uninit warnings when given wonky args * change CORE::kill so tests can mock kill @@ -17,12 +17,12 @@ sub new { $args_hr->{'ps_path'} = ''; } - return bless { 'ps_path' => $args_hr->{'ps_path'} }, $self; + return bless { 'ps_path' => $args_hr->{'ps_path'}, 'minimum_pid' => $args_hr->{'minimum_pid'} }, $self; } sub kill { my ( $self, $pid, $give_kill_a_chance) = @_; - $give_kill_a_chance = int $give_kill_a_chance; + $give_kill_a_chance = int $give_kill_a_chance if defined $give_kill_a_chance; $pid = int $pid; my $min = int $self->{'minimum_pid'}; if ( $pid < $min ) { @@ -38,10 +38,10 @@ sub kill { # RC from CORE::kill is not a boolean of if the PID was killed or not, only that it was signaled # so it is not an indicator of "success" in killing $pid - CORE::kill( 15, $pid ); # TERM - CORE::kill( 2, $pid ); # INT - CORE::kill( 1, $pid ); # HUP - CORE::kill( 9, $pid ); # KILL + kill( 15, $pid ); # TERM + kill( 2, $pid ); # INT + kill( 1, $pid ); # HUP + kill( 9, $pid ); # KILL # give kill() some time to take effect? if ($give_kill_a_chance) { @@ -55,7 +55,10 @@ sub kill { sub is_pid_running { my ( $self, $check_pid ) = @_; - return 1 if $> == 0 && CORE::kill(0, $check_pid); # if we are superuser we can avoid the the system call. For details see `perldoc -f kill` + $check_pid = int $check_pid; + return if !$check_pid || $check_pid < 0; + + return 1 if $> == 0 && kill(0, $check_pid); # if we are superuser we can avoid the the system call. For details see `perldoc -f kill` # If the proc filesystem is available, it's a good test. If not, continue on to system call return 1 if -e "/proc/$$" && -r "/proc/$$" && -r "/proc/$check_pid"; @@ -69,6 +72,9 @@ sub is_pid_running {
MIME-Version: 1.0
In-Reply-To: <rt-4.0.13-29743-1373403655-1864.0-0-0 [...] rt.cpan.org>
X-Mailer: MIME-tools 5.504 (Entity 5.504)
Content-Disposition: inline
X-RT-Interface: Web
References: <rt-4.0.13-29743-1373403655-1864.0-0-0 [...] rt.cpan.org>
Content-Type: text/plain; charset="utf-8"
Message-ID: <rt-4.0.13-26040-1373403782-323.86817-0-0 [...] rt.cpan.org>
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
X-RT-Encrypt: 0
X-RT-Sign: 0
Content-Length: 1277
Download (untitled) / with headers
text/plain 1.2k
sub pid_info_hash { my ( $self, $pid ) = @_; + $pid = int $pid; + return if !$pid || $pid < 0; + my @outp = $self->_raw_ps( 'u', '-p', $pid ); chomp @outp; my %info; @@ -133,7 +141,7 @@ sub pid_file { } } - return 1 if $rc == 1; + return 1 if defined $rc && $rc == 1; return 0 if defined $rc && $rc == 0; return; } @@ -173,7 +181,8 @@ sub pid_file_no_unlink { } # write only if it does not exist: - sysopen( my $pid_fh, $pid_file, Fcntl::O_WRONLY() | Fcntl::O_EXCL() | Fcntl::O_CREAT() ) || do { + my $pid_fh = _sysopen($pid_file); + if ( !$pid_fh ) { return 0 if $passes >= $retry_conf->[0]; if ( ref( $retry_conf->[$passes] ) eq 'CODE' ) { $retry_conf->[$passes]->( $self, $pid_file, $passes ); @@ -182,7 +191,7 @@ sub pid_file_no_unlink { sleep( $retry_conf->[$passes] ) if $retry_conf->[$passes]; } goto EXISTS; - }; + } print {$pid_fh} int( abs($newpid) ); close $pid_fh; @@ -190,6 +199,12 @@ sub pid_file_no_unlink { return 1; } +sub _sysopen { + my ($pid_file) = @_; + sysopen( my $pid_fh, $pid_file, Fcntl::O_WRONLY() | Fcntl::O_EXCL() | Fcntl::O_CREAT() ) || return; + return $pid_fh; +} +
MIME-Version: 1.0
In-Reply-To: <rt-4.0.13-29743-1373403655-1864.0-0-0 [...] rt.cpan.org>
X-Mailer: MIME-tools 5.504 (Entity 5.504)
Content-Disposition: inline
X-RT-Interface: Web
References: <rt-4.0.13-29743-1373403655-1864.0-0-0 [...] rt.cpan.org>
Content-Type: text/plain; charset="utf-8"
Message-ID: <rt-4.0.13-21746-1373404323-309.86817-0-0 [...] rt.cpan.org>
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
X-RT-Encrypt: 0
X-RT-Sign: 0
Content-Length: 71
* moved sysopen call to an internal functions to make it easier to test
MIME-Version: 1.0
In-Reply-To: <rt-4.0.13-21746-1373404323-309.86817-0-0 [...] rt.cpan.org>
X-Mailer: MIME-tools 5.504 (Entity 5.504)
Content-Disposition: inline
X-RT-Interface: Web
References: <rt-4.0.13-29743-1373403655-1864.0-0-0 [...] rt.cpan.org> <rt-4.0.13-21746-1373404323-309.86817-0-0 [...] rt.cpan.org>
Content-Type: text/plain; charset="utf-8"
Message-ID: <rt-4.0.14-17386-1375234643-913.86817-0-0 [...] rt.cpan.org>
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
X-RT-Encrypt: 0
X-RT-Sign: 0
Content-Length: 36
Done in v0.91, just uploaded to CPAN


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.