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

diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index 40da9f3..5f2545f 100644
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -1,20 +1,13 @@
 package Net::Ping;
 
-# Author:   mose@ccsn.edu (Russell Mosemann)
-#
-# Authors of the original pingecho():
-#           karrer@bernina.ethz.ch (Andreas Karrer)
-#           Paul.Marquess@btinternet.com (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.
-
-use 5.005_64;
+# $Id: Ping.pm,v 1.5 2001/11/19 09:44:18 rob Exp $
+
+require 5.002;
 require Exporter;
 
 use strict;
-our(@ISA, @EXPORT, $VERSION, $def_timeout, $def_proto, $max_datasize);
+use vars qw(@ISA @EXPORT $VERSION
+            $def_timeout $def_proto $max_datasize);
 use FileHandle;
 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
                inet_aton sockaddr_in );
@@ -22,7 +15,7 @@ use Carp;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = 2.02;
+$VERSION = 2.06;
 
 # Constants
 
@@ -105,7 +98,7 @@ sub new
     }
     elsif ($self->{"proto"} eq "icmp")
     {
-        croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
+        croak("icmp ping requires root privilege") if $>;
         $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
                     croak("Can't get icmp protocol by name");
         $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
@@ -128,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
@@ -299,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);
 }
@@ -385,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.
@@ -405,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;
@@ -424,6 +420,8 @@ Net::Ping - check a remote host for reachability
     $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"
@@ -442,11 +440,7 @@ hosts on a network.  A ping object is first created with optional
 parameters, a variable number of hosts may be pinged multiple
 times and then the connection is closed.
 
-You may choose one of three different protocols to use for the
-ping. The "udp" protocol is the default. Note that a live remote host
-may still fail to be pingable by one or more of these protocols. For
-example, www.microsoft.com is generally alive but not pingable.
-
+You may choose one of three different protocols to use for the ping.
 With the "tcp" protocol the ping() method attempts to establish a
 connection to the remote host's echo port.  If the connection is
 successfully established, the remote host is considered reachable.  No
@@ -550,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