This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Minor change to make -w clean
[perl5.git] / lib / Net / Ping.pm
CommitLineData
a0d0e21e
LW
1package Net::Ping;
2
3# Authors: karrer@bernina.ethz.ch (Andreas Karrer)
4# pmarquess@bfsec.bt.co.uk (Paul Marquess)
5
6require Exporter;
7
8@ISA = qw(Exporter);
9@EXPORT = qw(ping pingecho);
8e07c86e 10$VERSION = 1.00;
a0d0e21e 11
8e07c86e
AD
12use Socket 'PF_INET', 'AF_INET', 'SOCK_STREAM';
13require Carp ;
a0d0e21e 14
8e07c86e
AD
15use strict ;
16
17$Net::Ping::tcp_proto = (getprotobyname('tcp'))[2];
18$Net::Ping::echo_port = (getservbyname('echo', 'tcp'))[2];
19
20# keep -w happy
21$Net::Ping::tcp_proto = $Net::Ping::tcp_proto ;
22$Net::Ping::echo_port = $Net::Ping::echo_port ;
a0d0e21e
LW
23
24sub ping {
8e07c86e 25 Carp::croak "ping not implemented yet. Use pingecho()";
a0d0e21e
LW
26}
27
28
29sub pingecho {
30
8e07c86e 31 Carp::croak "usage: pingecho host [timeout]"
a0d0e21e
LW
32 unless @_ == 1 || @_ == 2 ;
33
8e07c86e
AD
34 my ($host, $timeout) = @_;
35 my ($saddr, $ip);
36 my ($ret) ;
a0d0e21e 37 local (*PINGSOCK);
a0d0e21e
LW
38
39 # check if $host is alive by connecting to its echo port, within $timeout
40 # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found
41
42 $timeout = 5 unless $timeout;
43
44 if ($host =~ /^\s*((\d+\.){3}\d+)\s*$/)
45 { $ip = pack ('C4', split (/\./, $1)) }
46 else
47 { $ip = (gethostbyname($host))[4] }
48
49 return 0 unless $ip; # "no such host"
50
8e07c86e 51 $saddr = pack('S n a4 x8', AF_INET, $Net::Ping::echo_port, $ip);
a0d0e21e
LW
52 $SIG{'ALRM'} = sub { die } ;
53 alarm($timeout);
8e07c86e
AD
54
55 $ret = 0;
56 eval <<'EOM' ;
57 return unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $Net::Ping::tcp_proto) ;
58 return unless connect(PINGSOCK, $saddr) ;
59 $ret=1 ;
a0d0e21e 60EOM
a0d0e21e
LW
61 alarm(0);
62 close(PINGSOCK);
8e07c86e 63 $ret;
a0d0e21e
LW
64}
65
661;
8e07c86e
AD
67__END__
68
69=cut
70
71=head1 NAME
72
73Net::Ping, pingecho - check a host for upness
74
75=head1 SYNOPSIS
76
77 use Net::Ping;
78 print "'jimmy' is alive and kicking\n" if pingecho('jimmy', 10) ;
79
80=head1 DESCRIPTION
81
82This module contains routines to test for the reachability of remote hosts.
83Currently the only routine implemented is pingecho().
84
85pingecho() uses a TCP echo (I<not> an ICMP one) to determine if the
86remote host is reachable. This is usually adequate to tell that a remote
87host is available to rsh(1), ftp(1), or telnet(1) onto.
88
89=head2 Parameters
90
91=over 5
92
93=item hostname
94
95The remote host to check, specified either as a hostname or as an IP address.
96
97=item timeout
98
99The timeout in seconds. If not specified it will default to 5 seconds.
100
101=back
102
103=head1 WARNING
104
105pingecho() uses alarm to implement the timeout, so don't set another alarm
106while you are using it.
107
108