X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FPing.pm;h=5f2545fccab69590a3579fdd80e6c77e65bcac5a;hb=3226bbec67a495e52de65a4d7ece19d720e5f94d;hp=91077ddad1c5494ecaf32ac0d79eb5106194979f;hpb=a3b937379002b6cdebf8b709a243e9491dac49a1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index 91077dd..5f2545f 100644
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -1,14 +1,6 @@
 package Net::Ping;
 
-# Author:   mose@ccsn.edu (Russell Mosemann)
-#
-# Authors of the original pingecho():
-#           karrer@bernina.ethz.ch (Andreas Karrer)
-#           pmarquess@bfsec.bt.co.uk (Paul Marquess)
-#
-# Copyright (c) 1996 Russell Mosemann.  All rights reserved.  This
-# program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# $Id: Ping.pm,v 1.5 2001/11/19 09:44:18 rob Exp $
 
 require 5.002;
 require Exporter;
@@ -23,7 +15,7 @@ use Carp;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = 2.02;
+$VERSION = 2.06;
 
 # Constants
 
@@ -129,7 +121,7 @@ sub new
 
 # Description: Ping a host name or IP number with an optional timeout.
 # First lookup the host, and return undef if it is not found.  Otherwise
-# perform the specific ping method based on the protocol.  Return the 
+# perform the specific ping method based on the protocol.  Return the
 # result of the ping.
 
 sub ping
@@ -300,20 +292,21 @@ sub ping_tcp
     my ($saddr,             # sockaddr_in with port and ip
         $ret                # The return value
         );
-                            
+
     socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
         croak("tcp socket error - $!");
     $saddr = sockaddr_in($self->{"port_num"}, $ip);
 
     $SIG{'ALRM'} = sub { die };
     alarm($timeout);        # Interrupt connect() if we have to
-            
+
     $ret = 0;               # Default to unreachable
-    eval <<'EOM' ;
-        return unless connect($self->{"fh"}, $saddr);
+    eval {
+        die $! unless connect($self->{"fh"}, $saddr);
         $ret = 1;
-EOM
+    };
     alarm(0);
+    $ret = 1 if $@ =~ /connection refused/i;
     $self->{"fh"}->close();
     return($ret);
 }
@@ -386,7 +379,7 @@ sub ping_udp
         }
     }
     return($ret);
-}   
+}
 
 # Description:  Close the connection unless we are using the tcp
 # protocol, since it will already be closed.
@@ -406,6 +399,8 @@ __END__
 
 Net::Ping - check a remote host for reachability
 
+$Id: Ping.pm,v 1.5 2001/11/19 09:44:18 rob Exp $
+
 =head1 SYNOPSIS
 
     use Net::Ping;
@@ -423,8 +418,10 @@ Net::Ping - check a remote host for reachability
         sleep(1);
     }
     $p->close();
-    
+
     $p = Net::Ping->new("tcp", 2);
+    # Try connecting to the www port instead of the echo port
+    $p->{port_num} = getservbyname("http", "tcp");
     while ($stop_time > time())
     {
         print "$host not reachable ", scalar(localtime()), "\n"
@@ -432,7 +429,7 @@ Net::Ping - check a remote host for reachability
         sleep(300);
     }
     undef($p);
-    
+
     # For backward compatibility
     print "$host is alive.\n" if pingecho($host);
 
@@ -547,4 +544,26 @@ routines to pack and unpack ICMP packets.  It would be better for a
 separate module to be written which understands all of the different
 kinds of ICMP packets.
 
+=head1 AUTHOR(S)
+
+  Original pingecho():
+    Andreas Karrer (karrer@bernina.ethz.ch)
+    Paul Marquess (pmarquess@bfsec.bt.co.uk)
+
+  Net::Ping base code:
+    Russell Mosemann (mose@ns.ccsn.edu)
+
+  Compatibility porting so ping_tcp()
+  can work with most remote systems:
+    Rob Brown (rob@roobik.com)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001 Rob Brown. All rights reserved.
+
+Copyright (c) 1996 Russell Mosemann.  All rights reserved.
+
+This program is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself.
+
 =cut