net::ping does not work properly when run in multiple threads when a large number of nodes that it tries to ping are unreachable.
In our network we have several thousand nodes of which about half are laptops and are typically not present on the network.
In my testing, the attached script works perfectly if all nodes are present or only a very small percentage are unreachable. If however the list has a large number of unreachable nodes (I gave it 100 unreachable nodes right at the start of the list) then many reachable nodes are reported as unreachable. In my test it reported approximately 60 (reachable) nodes as unreachable before it recovered.
In larger tests with thousands of nodes, of which approximately half are unreachable, the program will report that only at 10-20% of the reachable node are actually reachable.
C:\MSU>perl -V
Summary of my perl5 (revision 5 version 8 subversion 7) configuration:
Platform:
osname=MSWin32, osvers=5.0, archname=MSWin32-x86-multi-thread
uname=''
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cl', ccflags ='-nologo -Gf -W3 -MD -Zi -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DE
S_FCRYPT -DNO_HASH_SEED -DUSE_SITECUSTOMIZE -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO
-DPERL_MSVCRT_READFIX',
optimize='-MD -Zi -DNDEBUG -O1',
cppflags='-DWIN32'
ccversion='12.00.8804', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -libpath:"C:\Perl\lib\CORE" -ma
chine:x86'
libpth=\lib
libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib sh
ell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib od
bc32.lib odbccp32.lib msvcrt.lib
perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.li
b shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.li
b odbc32.lib odbccp32.lib msvcrt.lib
libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
gnulibc_version='undef'
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -libpath:"C:\Perl\lib
\CORE" -machine:x86'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY USE_ITHREADS USE_LARGE_FILES
USE_SITECUSTOMIZE PERL_IMPLICIT_CONTEXT
PERL_IMPLICIT_SYS
Locally applied patches:
ActivePerl Build 815 [211909]
Iin_load_module moved for compatibility with build 806
PerlEx support in CGI::Carp
Less verbose ExtUtils::Install and Pod::Find
instmodsh upgraded from ExtUtils-MakeMaker-6.25
Patch for CAN-2005-0448 from Debian with modifications
Upgrade to Time-HiRes-1.76
25774 Keys of %INC always use forward slashes
25747 Accidental interpolation of $@ in Pod::Html
25362 File::Path::mkpath resets errno
25181 Incorrect (X)HTML generated by Pod::Html
24999 Avoid redefinition warning for MinGW
24699 ICMP_UNREACHABLE handling in Net::Ping
21540 Fix backward-compatibility issues in if.pm
Built under MSWin32
Compiled at Nov 2 2005 08:44:52
@INC:
C:/Perl/lib
C:/Perl/site/lib
use Net::Ping;
use Net::Nslookup;
use threads;
use thread::queue;
#use strict;
#use warnings;
my @RemoteNodes; # Array of remote node names to scan
my $RemoteNodes; # Number of remote nodes to scan
my $RemoteMachine; #
my $IP; #IP address of remote machine
my $threadcount = 4; # Number of threads for reading remote machine registries
my $countdown = $threadcount; #Used to keep track of threads shutting down
#Create queues
my $NodeQ = new Thread::Queue; # Node names to be sacnned
my $DataQ = new Thread::Queue; # Data structures returned by threads for output processing
open (NODELIST, "$ARGV[0]") || die "Unable to open $ARGV[0]\n";
@RemoteNodes=<NODELIST>;
$RemoteNodes = @RemoteNodes;
print "Number of nodes to search = $RemoteNodes\n";
close (NODELIST);
chomp(@RemoteNodes);
# put all of the node names in the NodeQ
foreach $RemoteMachine (@RemoteNodes)
{
$NodeQ->enqueue($RemoteMachine);
}
for (my $i = 0; $i <= $threadcount; $i++)
{
$NodeQ->enqueue("ZZZZZZ");
}
#******************************************************************************
# Set up the threads that will read the remote machine registries
#******************************************************************************
print "Starting threads\n";
my $thread1 = threads->create(processNode, 1);
my $thread2 = threads->create(processNode, 2);
my $thread3 = threads->create(processNode, 3);
my $thread4 = threads->create(processNode, 4);
while ($countdown > 0)
{
# Get a node name from the queue
$result = $DataQ->dequeue;
print "result $result\n";
if ($result eq "ZZZZZZ")
{
$countdown--;
print "ML thread has shutdown, count down = $countdown\n";
}
}
print "ML all queues have stopped\n";
sub processNode
{
my $threadnum = $_[0];
print "In Thread $threadnum - processing\n";
my $RemoteMachine=$NodeQ->dequeue;
$RemoteMachine=~tr/a-z/A-Z/;
#Setup main loop and loop until we are told to quit
my $quit = 0;
my $p = Net::Ping->new();
if ($RemoteMachine eq "ZZZZZZ")
{
$quit = 1;
}
while ($quit == 0)
{
if ($p->ping($RemoteMachine)) # if remote machine responds to PING then
{
$return = ",answered ping,$threadnum";
}
else
{
$return = ",did not respond to ping,$threadnum";
}
$DataQ->enqueue("$RemoteMachine$return");
$RemoteMachine = $NodeQ->dequeue;
$RemoteMachine=~tr/a-z/A-Z/;
if ($RemoteMachine eq "ZZZZZZ")
{
$quit = 1;
$DataQ->enqueue("ZZZZZZ");
}
}
$p->close();
print "exiting thread $threadnum\n";
}
