in reply to Re^5: old file descriptors not being cleaned up
in thread old file descriptors not being cleaned up

Hello again.

I've cleaned up your sub somewhat and provided my own interpretation of a main program to get it to run. The arguments to ping I present are for the version on my system, provided as part of iputils-100214 on Linux (Mandriva in this case).

Here's what I got for output:

debug mping my pid is 28139 5 file descriptors: 0 1 2 3 4 spawned ping, pid 28141, fileno 3 spawned ping, pid 28142, fileno 5 spawned ping, pid 28143, fileno 6 spawned 3 ping commands starting read loop 1 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 end read loop 1 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 starting read loop 2 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 end read loop 2 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 starting read loop 3 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 end read loop 3 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 starting read loop 4 there are 3 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 7 done reading from pid 28141 fd `3`, closing close 28141 status: fd: `3`; rv: `1`; $!: ``; $?: 0 end read loop 4 there are 2 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 starting read loop 5 there are 2 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 6 done reading from pid 28143 fd `6`, closing close 28143 status: fd: `6`; rv: `1`; $!: ``; $?: 0 end read loop 5 there are 1 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 starting read loop 6 there are 1 pings active fd status from /proc/28139/fd: 0 1 2 3 4 5 done reading from pid 28142 fd `5`, closing close 28142 status: fd: `5`; rv: `1`; $!: ``; $?: 0 end read loop 6 there are 0 pings active fd status from /proc/28139/fd: 0 1 2 3 4 status for www.google.com: 0 status for www.slashdot.org: 0 status for localhost: 0

And here's the code I used to get that:

#!/usr/local/bin/perl use strict; use warnings; use Carp; use Fcntl; use constant { DEBUG => 1 }; my $to_ping = [ qw( localhost www.google.com www.slashdot.org ) ]; my $resref = mping( $to_ping, 'ping', '-s 100', '-c 5', '-w 5' ); my %res = %$resref; for ( keys %res ) { print "status for $_: " . $res{$_}{'status'} . "\n +" }; sub mping { my $mypid = $$; if ( DEBUG ) { print "debug mping\nmy pid is $mypid\n"; my @ls = `ls -1 /proc/$mypid/fd`; chomp @ls; printf "%s file descriptors:\n", scalar @ls; print join " ", sort { $a <=> $b } @ls; print "\n\n"; } my @hosts = @{$_[0]}; @hosts or die "no hosts to mping"; my ( $pingcmd, $pingsize, $pingnumber, $pingtimeout ) = @_[1,2,3,4 +]; croak "invalid mping arguments" unless $pingcmd and $pingnumber an +d $pingsize; my ( @pings, %results ); for ( my $i = 0; $i <= $#hosts; $i++ ) { $pings[$i][0] = $hosts[$i]; my $pid = open $pings[$i][1], "-|", "$pingcmd $hosts[$i] $ping +size $pingnumber" or die "Error executing $pingcmd: $!\n"; my $old_flags = fcntl( $pings[$i][1], F_GETFL, 0 ) or die "can't get flags: $!"; fcntl( $pings[$i][1], F_SETFL, $old_flags | O_NONBLOCK ) or die "can't set non blocking: $!"; $pings[$i][2] = $pid; ( printf "spawned ping, pid $pings[$i][2], fileno %s\n", filen +o $pings[$i][1] ) if DEBUG; print "$pingcmd, $hosts[$i], $pingsize, $pingnumber failure\n" + unless $pid; } ( printf "spawned %s ping commands\n", scalar @pings ) if DEBUG; my ( $start, $j ) = ( time, 1); ### READ while ( @pings ) { if ( DEBUG ) { print "starting read loop $j\n"; printf "there are %s pings active\n", scalar @pings; print "fd status from /proc/$mypid/fd:\n"; my @ls = `ls -1 /proc/$mypid/fd`; chomp @ls; print join " ", sort { $a <=> $b } @ls; print "\n"; } for ( my $i = $#pings; $i >= 0; $i-- ) { my $buf; my $len = sysread $pings[$i][1], $buf, 580; if (not defined $len) { # loop print "error reading $i: $!\n\n" if DEBUG > 2; } elsif ($len > 0) { # read, loop print "still reading $i\n" if DEBUG > 1; } elsif ($len == 0) { my $fileno = fileno ( $pings[$i][1] ); my $rv = close $pings[$i][1]; if ( DEBUG ) { printf "done reading from pid $pings[$i][2] fd `%s +`, closing\n", $fileno; printf "close $pings[$i][2] status: fd: `%s`; rv: +`$rv`; \$!: `$!`; \$?: $?\n", $fileno; } $results{ $pings[$i][0] }{ 'status' } = $? >> 8; splice @pings, $i, 1; } else { die; } } sleep 2; if ( DEBUG ) { print "end read loop $j\n"; printf "there are %s pings active\n", scalar @pings; print "fd status from /proc/$mypid/fd:\n"; my @ls = `ls -1 /proc/$mypid/fd`; chomp @ls; print join " ", sort {$a <=> $b} @ls; print "\n"; } $j++; } return \%results; }

Now, ignoring for the moment that I'd use Net::Ping which has been a core module for several years, let's try to figure out why my system opens one file handle per pipe and yours seems to open three. I have done a little searching on Google and Alta Vista and I've yet to find anything peculiar about Solaris 10 and pipes. I am curious, though, about whether your environment might behave a bit better if you opened the pipes to ping without invoking a shell. Since Perl 5.8.0 you can use a longer syntax with a list of arguments to your piped command similar to the list syntax of system().

In essence, changing this:

my $pid = open $pings[$i][1], "-|", "$pingcmd $hosts[$i] $ping +size $pingnumber" or die "Error executing $pingcmd: $!\n";
to this:
my $pid = ( open $pings[$i][1], "-|", $pingcmd, $hosts[$i], $ +pingsize, $pingnumber ) or die "Error executing $pingcmd: $!\n";
may make some difference if there's a vagary in your shell causing the problem. I have no idea if that's the case, but it's worth a shot since it's such a simple edit.

Replies are listed 'Best First'.
Re^7: old file descriptors not being cleaned up
by wagnerc (Sexton) on Dec 17, 2010 at 22:33 UTC
    Thanks for the reply. I changed the spawn code to a list but it didn't make any difference.
    my @cmd = split " ", "$pingcmd $hosts[$i] $pingsize $pingnumber"; $pid = open $pings[$i][1], "-|", @cmd or die "Error executing $cmd[0]: $!\n";;
    I also tried this as a list and a string but it made no difference either. "$pingcmd $hosts[$i] $pingsize $pingnumber 2>/dev/null </dev/null"

    The reason I'm not using Net::Ping is that u have to be root to make ICMP echo requests. Net::Ping::External just does the same thing I'm doing now. I also need to ping lots of hosts at once.

      Well, the redirection would have to be done using the shell, so making that a list wouldn't help anything.

      I am wondering if using kill to send a SIGTERM signal to the spawned program instead of just closing the pipe may help. It shouldn't be necessary, but it does seem you're suffering from something odd Solaris is doing with the files of the spawned program. Perhaps sending a signal (other than SIGKILL or something that can't be handled, preferably SIGTERM as already mentioned) would get the spawned program to close its own open files as it should.

      I see the draw of using an external suid program that is already developed and maintained by someone else rather than developing your program to run partially as root. I might make a different decision, but I certainly won't argue with yours. So back to trying to fix the problems with your version we go.

      You mention Net::Ping::External, which I hadn't thought about. It does do basically what your program does, but it uses the specific redirections 1>$devnull 2>$devnull as part of its command call. It does this in this particular way regardless of system, actually. The redirections are stated the same way, and although the location of the null device is left as a variable it is one with the '/dev/null' value assigned just the line before. I have no idea whether that will help, but it's a simple enough change to try.

      One thing that has occurred to me is that in your example code as posted I didn't notice you doing anything with the data read from the pipe. Are you actually using the read data? If not, system would be a cleaner solution than the piped open. You'd still have the status returned by ping.