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;
@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
-$VERSION = 2.02;
+$VERSION = 2.06;
# Constants
# 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
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);
}
}
}
return($ret);
-}
+}
# Description: Close the connection unless we are using the tcp
# protocol, since it will already be closed.
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;
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"
sleep(300);
}
undef($p);
-
+
# For backward compatibility
print "$host is alive.\n" if pingecho($host);
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