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:
to this:my $pid = open $pings[$i][1], "-|", "$pingcmd $hosts[$i] $ping +size $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.my $pid = ( open $pings[$i][1], "-|", $pingcmd, $hosts[$i], $ +pingsize, $pingnumber ) or die "Error executing $pingcmd: $!\n";
|
|---|
| 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 | |
by mr_mischief (Monsignor) on Dec 18, 2010 at 10:35 UTC |