ping.pm

ARM上的如果你对底层感兴趣

package Net::Ping;

# Author:   [e-mail] (Russell Mosemann)
#
# Authors of the original pingecho():
#           [e-mail] (Andreas Karrer)
#           [e-mail] (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.

require 5.002;
require Exporter;

use strict;
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 );
use Carp;

@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
$VERSION = 2.02;

# Constants

$def_timeout = 5;           # Default timeout to wait for a reply
$def_proto = "udp";         # Default protocol to use for pinging
$max_datasize = 1024;       # Maximum data bytes in a packet

# Description:  The pingecho() subroutine is provided for backward
# compatibility with the original Net::Ping.  It accepts a host
# name/IP and an optional timeout in seconds.  Create a tcp ping
# object and try pinging the host.  The result of the ping is returned.

sub pingecho
{
    my ($host,              # Name or IP number of host to ping
        $timeout            # Optional timeout in seconds
        ) = @_;
    my ($p);                # A ping object

    $p = Net::Ping->new("tcp", $timeout);
    $p->ping($host);        # Going out of scope closes the connection
}

# Description:  The new() method creates a new ping object.  Optional
# parameters may be specified for the protocol to use, the timeout in
# seconds and the size in bytes of additional data which should be
# included in the packet.
#   After the optional parameters are checked, the data is constructed
# and a socket is opened if appropriate.  The object is returned.

sub new
{
    my ($this,
        $proto,             # Optional protocol to use for pinging
        $timeout,           # Optional timeout in seconds
        $data_size          # Optional additional bytes of data
        ) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};
    my ($cnt,               # Count through data bytes
        $min_datasize       # Minimum data bytes required
        );

    bless($self, $class);

    $proto = $def_proto unless $proto;          # Determine the protocol
    croak("Protocol for ping must be \"tcp\", \"udp\" or \"icmp\"")
        unless $proto =~ m/^(tcp|udp|icmp)$/;
    $self->{"proto"} = $proto;

    $timeout = $def_timeout unless $timeout;    # Determine the timeout
    croak("Default timeout for ping must be greater than 0 seconds")
        if $timeout <= 0;
    $self->{"timeout"} = $timeout;

    $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
    $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
    croak("Data for ping must be from $min_datasize to $max_datasize bytes")
        if ($data_size < $min_datasize) || ($data_size > $max_datasize);
    $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
    $self->{"data_size"} = $data_size;

    $self->{"data"} = "";                       # Construct data bytes
    for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
    {
        $self->{"data"} .= chr($cnt % 256);
    }

    $self->{"seq"} = 0;                         # For counting packets
    if ($self->{"proto"} eq "udp")              # Open a socket
    {
        $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
            croak("Can't udp protocol by name");
        $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
            croak("Can't get udp echo port by name");
        $self->{"fh"} = FileHandle->new();
        socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
               $self->{"proto_num"}) ||
            croak("udp socket error - $!");
    }
    elsif ($self->{"proto"} eq "icmp")
    {
        croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
        $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
                    croak("Can't get icmp protocol by name");
        $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
        $self->{"fh"} = FileHandle->new();
        socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
            croak("icmp socket error - $!");
    }
    elsif ($self->{"proto"} eq "tcp")           # Just a file handle for now
    {
        $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
            croak("Can't get tcp protocol by name");
        $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
            croak("Can't get tcp echo port by name");
        $self->{"fh"} = FileHandle->new();
    }


    return($self);
}

# 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 
# result of the ping.

sub ping
{
    my ($self,
        $host,              # Name or IP number of host to ping
        $timeout            # Seconds after which ping times out
        ) = @_;
    my ($ip,                # Packed IP number of $host
        $ret                # The return value
        );

    croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
    $timeout = $self->{"timeout"} unless $timeout;
    croak("Timeout must be greater than 0 seconds") if $timeout <= 0;

    $ip = inet_aton($host);
    return(undef) unless defined($ip);      # Does host exist?

    if ($self->{"proto"} eq "udp")
    {
        $ret = $self->ping_udp($ip, $timeout);
    }
    elsif ($self->{"proto"} eq "icmp")
    {
        $ret = $self->ping_icmp($ip, $timeout);
    }
    elsif ($self->{"proto"} eq "tcp")
    {
        $ret = $self->ping_tcp($ip, $timeout);
    }
    else
    {
        croak("Unknown protocol \"$self->{proto}\" in ping()");
    }
    return($ret);
}

sub ping_icmp
{
    my ($self,
        $ip,                # Packed IP number of the host
        $timeout            # Seconds after which ping times out
        ) = @_;

    my $ICMP_ECHOREPLY = 0; # ICMP packet types
    my $ICMP_ECHO = 8;
    my $icmp_struct = "C2 S3 A";  # Structure of a minimal ICMP packet
    my $subcode = 0;        # No ICMP subcode for ECHO and ECHOREPLY
    my $flags = 0;          # No special flags when opening a socket
    my $port = 0;           # No port with ICMP

    my ($saddr,             # sockaddr_in with port and ip
        $checksum,          # Checksum of ICMP packet
        $msg,               # ICMP packet to send
        $len_msg,           # Length of $msg
        $rbits,             # Read bits, filehandles for reading
        $nfound,            # Number of ready filehandles found
        $finish_time,       # Time ping should be finished
        $done,              # set to 1 when we are done
        $ret,               # Return value
        $recv_msg,          # Received message including IP header
        $from_saddr,        # sockaddr_in of sender
        $from_port,         # Port packet was sent from
        $from_ip,           # Packed IP of sender
        $from_type,         # ICMP type
        $from_subcode,      # ICMP subcode
        $from_chk,          # ICMP packet checksum
        $from_pid,          # ICMP packet id
        $from_seq,          # ICMP packet sequence
        $from_msg           # ICMP message
        );

    $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
    $checksum = 0;                          # No checksum for starters
    $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
    $checksum = Net::Ping->checksum($msg);
    $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
    $len_msg = length($msg);
    $saddr = sockaddr_in($port, $ip);
    send($self->{"fh"}, $msg, $flags, $saddr); # Send the message

    $rbits = "";
    vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
    $ret = 0;
    $done = 0;
    $finish_time = time() + $timeout;       # Must be done by this time
    while (!$done && $timeout > 0)          # Keep trying if we have time
    {
        $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
        $timeout = $finish_time - time();   # Get remaining time
        if (!defined($nfound))              # Hmm, a strange error
        {
            $ret = undef;
            $done = 1;
        }
        elsif ($nfound)                     # Got a packet from somewhere
        {
            $recv_msg = "";
            $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
            ($from_port, $from_ip) = sockaddr_in($from_saddr);
            ($from_type, $from_subcode, $from_chk,
             $from_pid, $from_seq, $from_msg) =
                unpack($icmp_struct . $self->{"data_size"},
                       substr($recv_msg, length($recv_msg) - $len_msg,
                              $len_msg));
            if (($from_type == $ICMP_ECHOREPLY) &&
                ($from_ip eq $ip) &&
                ($from_pid == $self->{"pid"}) && # Does the packet check out?
                ($from_seq == $self->{"seq"}))
            {
                $ret = 1;                   # It's a winner
                $done = 1;
            }
        }
        else                                # Oops, timed out
        {
            $done = 1;
        }
    }
    return($ret)
}

# Description:  Do a checksum on the message.  Basically sum all of
# the short words and fold the high order bits into the low order bits.

sub checksum
{
    my ($class,
        $msg            # The message to checksum
        ) = @_;
    my ($len_msg,       # Length of the message
        $num_short,     # The number of short words in the message
        $short,         # One short word
        $chk            # The checksum
        );

    $len_msg = length($msg);
    $num_short = $len_msg / 2;
    $chk = 0;
    foreach $short (unpack("S$num_short", $msg))
    {