From vinsworldcom@gmail.com

Created by vinsworldcom@gmail.com

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

+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-&gt;{'device'} $!";
+ }
+ if ($self->{'tos'}) {
+ setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+ or croak "error configuring tos to $self-&gt;{'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-&gt;{'device'} $!";
+ }
+ if ($self->{'tos'}) {
+ setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+ or croak "error configuring tos to $self-&gt;{'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____

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)

From @jkeenan

On Tue Nov 27 12​:16​:24 2012, VinsWorldcom wrote​:

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​:

Steve Peters​: Your posting at
https://rt.cpan.org/Public/Bug/Display.html?id=80479#txn-1191096
indicates you were working on v2.40 of Net​::Ping. We now have v2.41 in
blead. Does that mean that the feature request in RT #115932 has been
met? (Trying to see if this ticket is closeable.)

Thank you very much.
Jim Keenan

The RT System itself - Status changed from 'new' to 'open'

From vinsworldcom@gmail.com

Jim,

I'm not Steve Peters - I submitted the original request for IPv6 support
with a 95% complete patch (didn't include ICMPv6 support - arguably a
pretty important feature). Anyway, I didn't pursue any further as I maxed
out on my coding expertise and the suggestion from Steve seemed to indicate
reworking the module structure (at least the new() method) and since I
wasn't an owner / maintainer, I figured I'd leave it to the "professionals".

Does v2.41 include IPv6 support - as that was my initial "feature request"?

cheers.

On Sun, May 26, 2013 at 7​:56 PM, James E Keenan via RT <
perlbug-followup@​perl.org> wrote​:

On Tue Nov 27 12​:16​:24 2012, VinsWorldcom wrote​:

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​:

Steve Peters​: Your posting at
https://rt.cpan.org/Public/Bug/Display.html?id=80479#txn-1191096
indicates you were working on v2.40 of Net​::Ping. We now have v2.41 in
blead. Does that mean that the feature request in RT #115932 has been
met? (Trying to see if this ticket is closeable.)

Thank you very much.
Jim Keenan

From @rjbs

* Vince <vinsworldcom@​gmail.com> [2013-05-28T06​:46​:59]

Does v2.41 include IPv6 support - as that was my initial "feature request"?

If it does, the changelog says nothing about it.

That said, [rt.cpan.org #80479] exists and is open. I'm not sure a bug against
core is needed.

--
rjbs

From @rjbs

I'm marking this as a blocker… for 5.21.1.

We can get this patched early in the 5.21 series and once we know it's good, make a CPAN release. I'd rather not make this change so soon before 5.20. I apologize for the delay.

--
rjbs

From @tonycoz

On Wed Feb 26 16​:06​:01 2014, rjbs wrote​:

I'm marking this as a blocker… for 5.21.1.

We can get this patched early in the 5.21 series and once we know it's
good, make a CPAN release. I'd rather not make this change so soon
before 5.20. I apologize for the delay.

Net​::Ping has changed extensively enough since that patch was produced it doesn't come close to applying anymore.

Tony

As per the original CPAN ticket referred to when the complaint was raised, looks like Net::Ping now has IPv6 support: https://rt.cpan.org/Public/Bug/Display.html?id=80479

Perhaps this ticket can be closed?

As per the original CPAN ticket referred to when the complaint was raised, looks like Net::Ping now has IPv6 support: https://rt.cpan.org/Public/Bug/Display.html?id=80479

Perhaps this ticket can be closed?

The Perl 5 core distribution now has Net::Ping version 2.71. So I think it would be good to put this issue out of its misery and request that any new problems be reported in new issues or to the upstream maintainer.

Thank you very much.
Jim Keenan