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
####
#!/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 and $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] $pingsize $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", fileno $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;
}
####
my $pid = open $pings[$i][1], "-|", "$pingcmd $hosts[$i] $pingsize $pingnumber" or
die "Error executing $pingcmd: $!\n";
####
my $pid = ( open $pings[$i][1], "-|", $pingcmd, $hosts[$i], $pingsize, $pingnumber ) or
die "Error executing $pingcmd: $!\n";