develooper Front page | perl.perl5.porters | Postings from November 2012

[perl #115932] Net::Ping IPv6 support - with patch

From:
Vince
Date:
November 29, 2012 21:15
Subject:
[perl #115932] Net::Ping IPv6 support - with patch
Message ID:
rt-3.6.HEAD-17500-1354047384-1144.115932-75-0@perl.org
# New Ticket Created by  Vince 
# Please include the string:  [perl #115932]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=115932 >


This is a bug report for perl from vinsworldcom@gmail.com,
generated with the help of perlbug 1.39 running under perl 5.16.1.


-----------------------------------------------------------------
[Please describe your issue here]

There is currently no IPv6 support in Net::Ping relying on IPv4 only
routines like sockaddr_in and inet_ntoa/aton.  I've created a patch to
support IPv6.  It's 95% complete.  I'm having issues calculating the
ICMPv6 checksum.

As you may know, the ICMPv6 checksum is different than ICMPv4 in that
ICMPv6 uses a pseudo-header (much like TCP/UDP) for checksum
calculation.  How to find the source address if the user does not call
bind() before actually sending the packet?

Other than that, IPv4 remains the default and all tests result in the
same output for me as they did before the patch.  IPv6 ping now also
works, only not with ICMPv6 as transport (due to aforementioned checksum
issue).

I'd like some help getting that last ICMPv6 checksum part resolved and
get this IPv6 support added to Net::Ping.

The original bug was submitted via CPAN at:

https://rt.cpan.org/Public/Bug/Display.html?id=80479

and the patch is included with that bug report and follows:


____START:  PATCH____
--- Ping.pm	Mon Jun 08 12:30:57 2009
+++ Ping.pm	Mon Oct 29 16:05:42 2012
@@ -5,18 +5,23 @@

 use strict;
 use vars qw(@ISA @EXPORT $VERSION
-            $def_timeout $def_proto $def_factor
+            $def_timeout $def_proto $def_factor $def_family
             $max_datasize $pingstring $hires $source_verify $syn_forking);
 use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
-use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR
-               inet_aton inet_ntoa sockaddr_in );
+use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW AF_INET IPPROTO_TCP
PF_INET SOL_SOCKET SO_ERROR
+               inet_ntoa sockaddr_in );
 use POSIX qw( ENOTCONN ECONNREFUSED ECONNRESET EINPROGRESS
EWOULDBLOCK EAGAIN WNOHANG );
 use FileHandle;
 use Carp;

+my $AF_INET6 = eval { Socket::AF_INET6() };
+my $AF_UNSPEC = eval { Socket::AF_UNSPEC() };
+my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() };
+my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() };
+
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.36";
+$VERSION = "2.39";

 sub SOL_IP { 0; };
 sub IP_TOS { 1; };
@@ -26,6 +31,7 @@
 $def_timeout = 5;           # Default timeout to wait for a reply
 $def_proto = "tcp";         # Default protocol to use for pinging
 $def_factor = 1.2;          # Default exponential backoff rate.
+$def_family = AF_INET;      # Default family.
 $max_datasize = 1024;       # Maximum data bytes in a packet
 # The data we exchange with the server for the stream protocol
 $pingstring = "pingschwingping!\n";
@@ -87,6 +93,7 @@
       $data_size,         # Optional additional bytes of data
       $device,            # Optional device to use
       $tos,               # Optional ToS to set
+      $family,            # Optional address family
       ) = @_;
   my  $class = ref($this) || $this;
   my  $self = {};
@@ -110,6 +117,20 @@

   $self->{"tos"} = $tos;

+  if ($family) {
+    if ($family =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
+      if ($family =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
+        $self->{"family"} = AF_INET;
+      } else {
+        $self->{"family"} = $AF_INET6;
+      }
+    } else {
+      croak('Family must be "ipv4" or "ipv6"')
+    }
+  } else {
+    $self->{"family"} = $def_family;
+  }
+
   $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")
@@ -135,17 +156,6 @@
     $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 - $!");
-    if ($self->{'device'}) {
-      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(),
pack("Z*", $self->{'device'}))
-        or croak "error binding to device $self->{'device'} $!";
-    }
-    if ($self->{'tos'}) {
-      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
-        or croak "error configuring tos to $self->{'tos'} $!";
-    }
   }
   elsif ($self->{"proto"} eq "icmp")
   {
@@ -154,16 +164,6 @@
       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 - $!");
-    if ($self->{'device'}) {
-      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(),
pack("Z*", $self->{'device'}))
-        or croak "error binding to device $self->{'device'} $!";
-    }
-    if ($self->{'tos'}) {
-      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
-        or croak "error configuring tos to $self->{'tos'} $!";
-    }
   }
   elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
   {
@@ -202,9 +202,8 @@
 }

 # Description: Set the local IP address from which pings will be sent.
-# For ICMP and UDP pings, this calls bind() on the already-opened socket;
-# for TCP pings, just saves the address to be used when the socket is
-# opened.  Returns non-zero if successful; croaks on error.
+# For ICMP, UDP and TCP pings, just saves the address to be used when
+# the socket is opened.  Returns non-zero if successful; croaks on error.
 sub bind
 {
   my ($self,
@@ -217,16 +216,14 @@
   croak("already bound") if defined($self->{"local_addr"}) &&
     ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");

-  $ip = inet_aton($local_addr);
+  $ip = $self->_resolv($local_addr);
   croak("nonexistent local address $local_addr") unless defined($ip);
-  $self->{"local_addr"} = $ip; # Only used if proto is tcp
+  $self->{"local_addr"} = $ip;

-  if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
-  {
-  CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
-    croak("$self->{'proto'} bind error - $!");
-  }
-  elsif (($self->{"proto"} ne "tcp") && ($self->{"proto"} ne "syn"))
+  if (($self->{"proto"} ne "udp") &&
+      ($self->{"proto"} ne "icmp") &&
+      ($self->{"proto"} ne "tcp") &&
+      ($self->{"proto"} ne "syn"))
   {
     croak("Unknown protocol \"$self->{proto}\" in bind()");
   }
@@ -356,17 +353,32 @@
   my ($self,
       $host,              # Name or IP number of host to ping
       $timeout,           # Seconds after which ping times out
+      $family,            # Address family
       ) = @_;
   my ($ip,                # Packed IP number of $host
       $ret,               # The return value
       $ping_time,         # When ping began
       );

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

-  $ip = inet_aton($host);
+  if ($family) {
+    if ($family =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
+      if ($family =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
+        $self->{"family_local"} = AF_INET;
+      } else {
+        $self->{"family_local"} = $AF_INET6;
+      }
+    } else {
+      croak('Family must be "ipv4" or "ipv6"')
+    }
+  } else {
+    $self->{"family_local"} = $self->{"family"};
+  }
+
+  $ip = $self->_resolv($host);
   return () unless defined($ip);      # Does host exist?

   # Dispatch to the appropriate routine.
@@ -392,7 +404,7 @@
     croak("Unknown protocol \"$self->{proto}\" in ping()");
   }

-  return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
+  return wantarray ? ($ret, &time() - $ping_time, $ip->{addr}) : $ret;
 }

 # Uses Net::Ping::External to do an external ping.
@@ -404,12 +416,15 @@

   eval { require Net::Ping::External; }
     or croak('Protocol "external" not supported on your system:
Net::Ping::External not found');
-  return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
+  return Net::Ping::External::ping(ip => $ip->{"addr_in"}, timeout =>
$timeout);
 }

-use constant ICMP_ECHOREPLY   => 0; # ICMP packet types
-use constant ICMP_UNREACHABLE => 3; # ICMP packet types
+use constant ICMP_ECHOREPLY     => 0; # ICMP packet types
+use constant ICMPv6_ECHOREPLY   => 129; # ICMP packet types
+use constant ICMP_UNREACHABLE   => 3; # ICMP packet types
+use constant ICMPv6_UNREACHABLE => 1; # ICMP packet types
 use constant ICMP_ECHO        => 8;
+use constant ICMPv6_ECHO      => 128;
 use constant ICMP_STRUCT      => "C2 n3 A"; # Structure of a minimal
ICMP packet
 use constant SUBCODE          => 0; # No ICMP subcode for ECHO and ECHOREPLY
 use constant ICMP_FLAGS       => 0; # No special flags for send or recv
@@ -443,15 +458,45 @@
       $from_msg           # ICMP message
       );

+  socket($self->{"fh"}, $ip->{"family"}, SOCK_RAW, $self->{"proto_num"}) ||
+    croak("icmp socket error - $!");
+
+  if (defined $self->{"local_addr"} &&
+      !CORE::bind($self->{"fh"}, _pack_sockaddr_in(0,
$self->{"local_addr"}))) {
+    croak("icmp bind error - $!");
+  }
+
+  if ($self->{'device'}) {
+    setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(),
pack("Z*", $self->{'device'}))
+      or croak "error binding to device $self->{'device'} $!";
+  }
+  if ($self->{'tos'}) {
+    setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+      or croak "error configuring tos to $self->{'tos'} $!";
+  }
+
   $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"});
+  if ($ip->{"family"} == AF_INET) {
+    $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+  } else {
+                                          # how to get SRC
+    my $pseudo_header = pack('a16a16Nnn', $ip->{"addr_in"},
$ip->{"addr_in"}, 8+length($self->{"data"}), "\0", 0x003a);
+    $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMPv6_ECHO, SUBCODE,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+    $msg = $pseudo_header.$msg
+  }
   $checksum = Net::Ping->checksum($msg);
-  $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
-              $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+  if ($ip->{"family"} == AF_INET) {
+    $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+  } else {
+    $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMPv6_ECHO, SUBCODE,
+                $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
+  }
   $len_msg = length($msg);
-  $saddr = sockaddr_in(ICMP_PORT, $ip);
+  $saddr = _pack_sockaddr_in(ICMP_PORT, $ip);
   $self->{"from_ip"} = undef;
   $self->{"from_type"} = undef;
   $self->{"from_subcode"} = undef;
@@ -477,11 +522,14 @@
       $from_pid = -1;
       $from_seq = -1;
       $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
-      ($from_port, $from_ip) = sockaddr_in($from_saddr);
+      ($from_port, $from_ip) = _unpack_sockaddr_in($from_saddr);
       ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2));
       if ($from_type == ICMP_ECHOREPLY) {
         ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
           if length $recv_msg >= 28;
+      } elsif ($from_type == ICMPv6_ECHOREPLY) {
+        ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
+          if length $recv_msg >= 28;
       } else {
         ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4))
           if length $recv_msg >= 56;
@@ -490,12 +538,12 @@
       $self->{"from_type"} = $from_type;
       $self->{"from_subcode"} = $from_subcode;
       if (($from_pid == $self->{"pid"}) && # Does the packet check out?
-          (! $source_verify || (inet_ntoa($from_ip) eq inet_ntoa($ip))) &&
+          (! $source_verify || (_inet_ntoa($from_ip) eq _inet_ntoa($ip))) &&
           ($from_seq == $self->{"seq"})) {
-        if ($from_type == ICMP_ECHOREPLY) {
+        if (($from_type == ICMP_ECHOREPLY) || ($from_type ==
ICMPv6_ECHOREPLY)) {
           $ret = 1;
 	  $done = 1;
-        } elsif ($from_type == ICMP_UNREACHABLE) {
+        } elsif (($from_type == ICMP_UNREACHABLE) || ($from_type ==
ICMPv6_UNREACHABLE)) {
           $done = 1;
         }
       }
@@ -510,7 +558,7 @@
   my ($self) = @_;
   my $ip = $self->{"from_ip"} || "";
   $ip = "\0\0\0\0" unless 4 == length $ip;
-  return (inet_ntoa($ip),($self->{"from_type"} || 0),
($self->{"from_subcode"} || 0));
+  return (_inet_ntoa($ip),($self->{"from_type"} || 0),
($self->{"from_subcode"} || 0));
 }

 # Description:  Do a checksum on the message.  Basically sum all of
@@ -577,15 +625,15 @@
       ) = @_;
   my ($saddr);            # Packed IP and Port

-  $saddr = sockaddr_in($self->{"port_num"}, $ip);
+  $saddr = _pack_sockaddr_in($self->{"port_num"}, $ip);

   my $ret = 0;            # Default to unreachable

   my $do_socket = sub {
-    socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
+    socket($self->{"fh"}, $ip->{"family"}, SOCK_STREAM,
$self->{"proto_num"}) ||
       croak("tcp socket error - $!");
     if (defined $self->{"local_addr"} &&
-        !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
+        !CORE::bind($self->{"fh"}, _pack_sockaddr_in(0,
$self->{"local_addr"}))) {
       croak("tcp bind error - $!");
     }
     if ($self->{'device'}) {
@@ -598,7 +646,7 @@
     }
   };
   my $do_connect = sub {
-    $self->{"ip"} = $ip;
+    $self->{"ip"} = $ip->{"addr_in"};
     # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error
through $?,
     # we'll get (10061 & 255) = 77, so we cannot check it in the
parent process.
     return ($ret = connect($self->{"fh"}, $saddr) || ($! ==
ECONNREFUSED && !$self->{"econnrefused"}));
@@ -674,7 +722,7 @@

     # Unset O_NONBLOCK property on filehandle
     $self->socket_blocking_mode($self->{"fh"}, 1);
-    $self->{"ip"} = $ip;
+    $self->{"ip"} = $ip->{"addr_in"};
     return $ret;
   };

@@ -838,7 +886,7 @@
   }

   croak "tried to switch servers while stream pinging"
-    if $self->{"ip"} ne $ip;
+    if $self->{"ip"} ne $ip->{"addr_in"};

   return $self->tcp_echo($timeout, $pingstring);
 }
@@ -850,11 +898,26 @@
 {
   my ($self,
       $host,              # Host or IP address
-      $timeout            # Seconds after which open times out
+      $timeout,           # Seconds after which open times out
+      $family
       ) = @_;

+  if ($family) {
+    if ($family =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
+      if ($family =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
+        $self->{"family_local"} = AF_INET;
+      } else {
+        $self->{"family_local"} = $AF_INET6;
+      }
+    } else {
+      croak('Family must be "ipv4" or "ipv6"')
+    }
+  } else {
+    $self->{"family_local"} = $self->{"family"};
+  }
+
   my ($ip);               # Packed IP number of the host
-  $ip = inet_aton($host);
+  $ip = $self->_resolv($host);
   $timeout = $self->{"timeout"} unless $timeout;

   if($self->{"proto"} eq "stream") {
@@ -897,10 +960,28 @@
       $from_ip            # Packed IP number of sender
       );

-  $saddr = sockaddr_in($self->{"port_num"}, $ip);
+  $saddr = _pack_sockaddr_in($self->{"port_num"}, $ip);
   $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
   $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any

+  socket($self->{"fh"}, $ip->{"family"}, SOCK_DGRAM,
+         $self->{"proto_num"}) ||
+           croak("udp socket error - $!");
+
+  if (defined $self->{"local_addr"} &&
+      !CORE::bind($self->{"fh"}, _pack_sockaddr_in(0,
$self->{"local_addr"}))) {
+    croak("udp bind error - $!");
+  }
+
+  if ($self->{'device'}) {
+    setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(),
pack("Z*", $self->{'device'}))
+      or croak "error binding to device $self->{'device'} $!";
+  }
+  if ($self->{'tos'}) {
+    setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+      or croak "error configuring tos to $self->{'tos'} $!";
+  }
+
   if ($self->{"connected"}) {
     if ($self->{"connected"} ne $saddr) {
       # Still connected to wrong destination.
@@ -921,7 +1002,7 @@
   if ($flush) {
     # Need to socket() again to flush the descriptor
     # This will disconnect from the old saddr.
-    socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
+    socket($self->{"fh"}, $ip->{"family"}, SOCK_DGRAM,
            $self->{"proto_num"});
   }
   # Connect the socket if it isn't already connected
@@ -970,7 +1051,7 @@
         }
         $done = 1;
       } else {
-        ($from_port, $from_ip) = sockaddr_in($from_saddr);
+        ($from_port, $from_ip) = _unpack_sockaddr_in($from_saddr,
$ip->{"family"});
         if (!$source_verify ||
             (($from_ip eq $ip) &&        # Does the packet check out?
              ($from_port == $self->{"port_num"}) &&
@@ -1020,15 +1101,15 @@
   }

   my $fh = FileHandle->new();
-  my $saddr = sockaddr_in($self->{"port_num"}, $ip);
+  my $saddr = _pack_sockaddr_in($self->{"port_num"}, $ip);

   # Create TCP socket
-  if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
+  if (!socket ($fh, $ip->{"family"}, SOCK_STREAM, $self->{"proto_num"})) {
     croak("tcp socket error - $!");
   }

   if (defined $self->{"local_addr"} &&
-      !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
+      !CORE::bind($fh, _pack_sockaddr_in(0, $self->{"local_addr"}))) {
     croak("tcp bind error - $!");
   }

@@ -1089,15 +1170,15 @@
       }
     } else {
       # Child process
-      my $saddr = sockaddr_in($self->{"port_num"}, $ip);
+      my $saddr = _pack_sockaddr_in($self->{"port_num"}, $ip);

       # Create TCP socket
-      if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM,
$self->{"proto_num"})) {
+      if (!socket ($self->{"fh"}, $ip->{"family"}, SOCK_STREAM,
$self->{"proto_num"})) {
         croak("tcp socket error - $!");
       }

       if (defined $self->{"local_addr"} &&
-          !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
+          !CORE::bind($self->{"fh"}, _pack_sockaddr_in(0,
$self->{"local_addr"}))) {
         croak("tcp bind error - $!");
       }

@@ -1247,7 +1328,7 @@
           }
           # Everything passed okay, return the answer
           return wantarray ?
-            ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
+            ($entry->[0], &time() - $entry->[3], _inet_ntoa($entry->[1]))
             : $entry->[0];
         } else {
           warn "Corrupted SYN entry: unknown fd [$fd] ready!";
@@ -1283,7 +1364,7 @@
     # Host passed as arg
     if (my $entry = $self->{"good"}->{$host}) {
       delete $self->{"good"}->{$host};
-      return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
+      return ($entry->[0], &time() - $entry->[3], _inet_ntoa($entry->[1]));
     }
   }

@@ -1327,7 +1408,7 @@
               # And wait for the next winner
               next;
             }
-            return ($entry->[0], &time() - $entry->[3],
inet_ntoa($entry->[1]));
+            return ($entry->[0], &time() - $entry->[3],
_inet_ntoa($entry->[1]));
           }
         } else {
           # Should never happen
@@ -1388,6 +1469,184 @@
    return $self->{port_num};
 }

+########################################################
+# DNS hostname resolution
+# return:
+#   $h->{name}    = host - as passed in
+#   $h->{host}    = host - as passed in without :port
+#   $h->{port}    = OPTIONAL - if :port, then value of port
+#   $h->{addr}    = resolved numeric address
+#   $h->{addr_in} = aton/pton result
+#   $h->{family}  = AF_INET/6
+############################
+sub _resolv {
+  my ($self,
+      $name,
+      ) = @_;
+
+  my %h;
+  $h{name} = $name;
+  my $family = $self->{"family"};
+
+  if (defined($self->{"family_local"})) {
+    $family = $self->{"family_local"}
+  }
+
+# START - host:port
+  my $cnt = 0;
+
+  # Count ":"
+  $cnt++ while ($name =~ m/:/g);
+
+  # 0 = hostname or IPv4 address
+  if ($cnt == 0) {
+    $h{host} = $name
+  # 1 = IPv4 address with port
+  } elsif ($cnt == 1) {
+    ($h{host}, $h{port}) = split /:/, $name
+  # >=2 = IPv6 address
+  } elsif ($cnt >= 2) {
+    #IPv6 with port - [2001::1]:port
+    if ($name =~ /^\[.*\]:\d{1,5}$/) {
+      ($h{host}, $h{port}) = split /:([^:]+)$/, $name # split after last :
+    # IPv6 without port
+    } else {
+      $h{host} = $name
+    }
+  }
+
+  # Clean up host
+  $h{host} =~ s/\[//g;
+  $h{host} =~ s/\]//g;
+  # Clean up port
+  if (defined($h{port}) && (($h{port} !~ /^\d{1,5}$/) || ($h{port} <
1) || ($h{port} > 65535))) {
+    croak("Invalid port `$h{port}' in `$name'");
+  }
+# END - host:port
+
+  # address check
+  # new way
+  if ($Socket::VERSION >= 1.94) {
+    my %hints = (
+      family   => $AF_UNSPEC,
+      protocol => IPPROTO_TCP,
+      flags => $AI_NUMERICHOST
+    );
+
+    # numeric address, return
+    my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
+    if (defined($getaddr[0])) {
+      $h{addr} = $h{host};
+      $h{family} = $getaddr[0]->{family};
+      if ($h{family} == AF_INET) {
+        (undef, $h{addr_in}, undef, undef) =
Socket::unpack_sockaddr_in $getaddr[0]->{addr};
+      } else {
+        (undef, $h{addr_in}, undef, undef) =
Socket::unpack_sockaddr_in6 $getaddr[0]->{addr};
+      }
+      return \%h
+    }
+  # old way
+  } else {
+    # numeric address, return
+    my $ret = gethostbyname($h{host});
+    if (defined($ret) && (_inet_ntoa($ret) eq $h{host})) {
+      $h{addr} = $h{host};
+      $h{addr_in} = $ret;
+      $h{family} = AF_INET;
+      return \%h
+    }
+  }
+
+  # resolve
+  # new way
+  if ($Socket::VERSION >= 1.94) {
+    my %hints = (
+      family   => $family,
+      protocol => IPPROTO_TCP
+    );
+
+    my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
+    if (defined($getaddr[0])) {
+      my ($err, $address) = Socket::getnameinfo($getaddr[0]->{addr},
$NI_NUMERICHOST);
+      if (defined($address)) {
+        $h{addr} = $address;
+        $h{addr} =~ s/\%(.)*$//; # remove %ifID if IPv6
+        $h{family} = $getaddr[0]->{family};
+        if ($h{family} == AF_INET) {
+          (undef, $h{addr_in}, undef, undef) =
Socket::unpack_sockaddr_in $getaddr[0]->{addr};
+        } else {
+          (undef, $h{addr_in}, undef, undef) =
Socket::unpack_sockaddr_in6 $getaddr[0]->{addr};
+        }
+        return \%h
+      } else {
+        croak("getnameinfo($getaddr[0]->{addr}) failed - $err");
+      }
+    } else {
+      my $error = sprintf "getaddrinfo($h{host},,%s) failed - $err",
($family == AF_INET) ? "AF_INET" : "AF_INET6";
+      croak("$error");
+    }
+  # old way
+  } else {
+    if ($family == $AF_INET6) {
+      croak("Socket >= 1.94 required for IPv6 - found Socket
$Socket::VERSION");
+    }
+
+    my @gethost = gethostbyname($h{host});
+    if (defined($gethost[4])) {
+      $h{addr} = inet_ntoa($gethost[4]);
+      $h{addr_in} = $gethost[4];
+      $h{family} = AF_INET;
+      return \%h
+    } else {
+      croak("gethostbyname($h{host}) failed - $^E");
+    }
+  }
+}
+
+sub _pack_sockaddr_in {
+  my ($port,
+      $addr,
+      ) = @_;
+
+  if ($addr->{"family"} == AF_INET) {
+    return Socket::pack_sockaddr_in($port, $addr->{"addr_in"});
+  } else {
+    return Socket::pack_sockaddr_in6($port, $addr->{"addr_in"});
+  }
+}
+
+sub _unpack_sockaddr_in {
+  my ($addr,
+      $family,
+      ) = @_;
+
+  my ($port, $host);
+  if ($family == AF_INET) {
+    ($port, $host) = Socket::unpack_sockaddr_in($addr);
+  } else {
+    ($port, $host) = Socket::unpack_sockaddr_in6($addr);
+  }
+  return $port, $host
+}
+
+sub _inet_ntoa {
+  my ($addr
+      ) = @_;
+
+  my $ret;
+  if ($Socket::VERSION >= 1.94) {
+    my ($err, $address) = Socket::getnameinfo($addr, $NI_NUMERICHOST);
+    if (defined($address)) {
+      $ret = $address;
+    } else {
+      croak("getnameinfo($addr) failed - $err");
+    }
+  } else {
+    $ret = inet_ntoa($addr)
+  }
+
+  return $ret
+}

 1;
 __END__
@@ -1509,7 +1768,7 @@

 =over 4

-=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [,
$tos ]]]]]);
+=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [,
$tos [, $family ]]]]]]);

 Create a new ping object.  All of the parameters are optional.  $proto
 specifies the protocol to use when doing a ping.  The current choices
@@ -1533,7 +1792,33 @@

 If $tos is given, this ToS is configured into the socket.

-=item $p->ping($host [, $timeout]);
+If $family is given, this is the address family to use.
+
+=over 4
+
+Valid values for IPv4:
+
+=over 4
+
+4, v4, ip4, ipv4, AF_INET (constant)
+
+=back
+
+=back
+
+=over 4
+
+Valid values for IPv6:
+
+=over 4
+
+6, v6, ip6, ipv6, AF_INET6 (constant)
+
+=back
+
+=back
+
+=item $p->ping($host [, $timeout [, $family]]);

 Ping the remote host and wait for a response.  $host can be either the
 hostname or the IP number of the remote host.  The optional timeout
@@ -1545,7 +1830,7 @@
 purposes, undef and 0 and can be treated as the same case.  In array
 context, the elapsed time as well as the string form of the ip the
 host resolved to are also returned.  The elapsed time value will
-be a float, as retuned by the Time::HiRes::time() function, if hires()
+be a float, as returned by the Time::HiRes::time() function, if hires()
 has been previously called, otherwise it is returned as an integer.

 =item $p->source_verify( { 0 | 1 } );
____END:  PATCH____

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=library
    severity=wishlist
    module=Net::Ping
---
Site configuration information for perl 5.16.1:

Configured by strawberry-perl at Thu Aug  9 07:50:39 2012.

Summary of my perl5 (revision 5 version 16 subversion 1) configuration:

  Platform:
    osname=MSWin32, osvers=4.0, archname=MSWin32-x64-multi-thread
    uname='Win32 strawberry-perl 5.16.1.1 #1 Thu Aug  9 07:49:27 2012 x64'
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags =' -s -O2 -DWIN32 -DWIN64 -DCONSERVATIVE
-DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS
-fno-strict-aliasing -mms-bitfields',
    optimize='-s -O2',
    cppflags='-DWIN32'
    ccversion='', gccversion='4.6.3', gccosandvers=''
    intsize=4, longsize=4, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='double', nvsize=8,
Off_t='long long', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='g++', ldflags ='-s -L"C:\strawberry\perl\lib\CORE"
-L"C:\strawberry\c\lib"'
    libpth=C:\strawberry\c\lib C:\strawberry\c\x86_64-w64-mingw32\lib
    libs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32
-lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
    perllibs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool
-lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid
-lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
    libc=, so=dll, useshrplib=true, libperl=libperl516.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-mdll -s
-L"C:\strawberry\perl\lib\CORE" -L"C:\strawberry\c\lib"'

Locally applied patches:


---
@INC for perl 5.16.1:
    C:/strawberry/perl/site/lib
    C:/strawberry/perl/vendor/lib
    C:/strawberry/perl/lib
    .

---
Environment for perl 5.16.1:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=C:\usr\bin;C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program
Files\Dell\Dell Wireless WLAN Card;C:\Program Files\WIDCOMM\Bluetooth
Software\;C:\Program Files\WIDCOMM\Bluetooth
Software\syswow64;C:\Program Files (x86)\Common Files\Roxio
Shared\DLLShared\;C:\Program Files (x86)\Common Files\Roxio
Shared\10.0\DLLShared\;C:\Program Files\Dell\DW WLAN
Card;C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin;C:\Users\vincen_m\bin
    PERL_BADLANG (unset)
    SHELL (unset)




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About