Make the new Socket implementation of inet_pton consistent with the existing Socket6 implementation of inet_pton.

Fix for release-blocking ticket [perl #72884]

> |https://rt.cpan.org/Ticket/Display.html?id=52497|4411113f|NJH/IO-Socket-Multicast6-0.03.tar.gz   |

I'll describe what's happening here, and leave it to everyone else to decide
which of the interacting events is the bug, or where the fix might be.

So the *entire* change is this:

commit 4411113f31b3f00171bb335092b02104d29d7cd7
Author: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date:   Fri Mar 27 13:19:16 2009 +0100

    Add inet_pton and inet_ntop to the list of functions exported by Socket

diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm
index 6b268ef..7d130ba 100644
--- a/ext/Socket/Socket.pm
+++ b/ext/Socket/Socket.pm
@@ -198,6 +198,7 @@ use XSLoader ();
 @ISA = qw(Exporter);
 @EXPORT = qw(
        inet_aton inet_ntoa
+       inet_pton inet_ntop
        sockaddr_family
        pack_sockaddr_in unpack_sockaddr_in
        pack_sockaddr_un unpack_sockaddr_un

and test fails like this:

$  /home/nick/Sandpit/snap5.9.x-v5.11.4-85-g95c9bfa/bin/perl5.11.4 -Mblib t/35mcastsend.t
1..11
Constant subroutine IO::Socket::Multicast6::AF_INET6 redefined at /home/nick/Sandpit/snap5.9.x-v5.11.4-85-g95c9bfa/lib/perl5/5.11.4/Exporter.pm line 64.
 at /home/nick/.cpan/build/IO-Socket-Multicast6-0.03-CqGAYT/blib/lib/IO/Socket/Multicast6.pm line 10
Prototype mismatch: sub IO::Socket::Multicast6::AF_INET6 () vs none at /home/nick/Sandpit/snap5.9.x-v5.11.4-85-g95c9bfa/lib/perl5/5.11.4/Exporter.pm line 64.
 at /home/nick/.cpan/build/IO-Socket-Multicast6-0.03-CqGAYT/blib/lib/IO/Socket/Multicast6.pm line 10
Constant subroutine IO::Socket::Multicast6::PF_INET6 redefined at /home/nick/Sandpit/snap5.9.x-v5.11.4-85-g95c9bfa/lib/perl5/5.11.4/Exporter.pm line 64.
 at /home/nick/.cpan/build/IO-Socket-Multicast6-0.03-CqGAYT/blib/lib/IO/Socket/Multicast6.pm line 10
Prototype mismatch: sub IO::Socket::Multicast6::PF_INET6 () vs none at /home/nick/Sandpit/snap5.9.x-v5.11.4-85-g95c9bfa/lib/perl5/5.11.4/Exporter.pm line 64.
 at /home/nick/.cpan/build/IO-Socket-Multicast6-0.03-CqGAYT/blib/lib/IO/Socket/Multicast6.pm line 10
ok 1 - use IO::Socket::Multicast6;
ok 2 - Create IPv4 multicast socket
ok 3 - Combined IPv4 destination address and port
ok 4 - Separate IPv4 destination address and port
Bad arg length for Socket::pack_sockaddr_in, length is 16, should be 4 at t/35mcastsend.t line 26.

The warnings aren't actually really relevant. The "problem"s are:

IO::Socket::Multicast6 isa IO::Socket::INET6
IO::Socket::INET6 isa IO::Socket

so they chose to inherit all behaviour from IO::Socket. In turn

IO::Socket isa IO::Handle isa Exporter.

IO::Socket chooses to export everything that Socket does:

sub import {
    my $pkg = shift;
    if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
	Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
    } else {
	my $callpkg = caller;
	Exporter::export 'Socket', $callpkg, @_;
    }
}

So, this means that all those choices and delegation of behaviour (and
responsibility) means that all those modules export whatever Socket exports.
OO modules.

So, now they also export inet_pton and inet_ntop.

The test is careful to only import what it needs:

use strict;
use Socket6 qw/ inet_pton pack_sockaddr_in6/;
use Socket qw/  pack_sockaddr_in /;
use Test::More tests => 11;

in particular, it wants inet_pton from Socket6, and only pack_sockaddr_in
from Socket. So at that point, main::inet_pton is Socket6::inet_pton

Then it does this, correctly in a BEGIN block:

BEGIN { use_ok( 'IO::Socket::Multicast6' ); }

The side effect of this is to import all exports from IO::Socket::Multicast6.
Which, from the above chain of inheritance, is @Socket::EXPORT.

So at this point, main::inet_pton is rebound to Socket::inet_pton

And the test fails, because they differ, and it expected (and wanted)
Socket6::inet_pton(). Socket6::inet_pton() returns 4 bytes for AF_INET, 16
bytes for AF_INET6. Socket::inet_pton() returns 16 for both.
Socket::pack_sockaddr_in() wants 4 bytes.

Now, to add to the fun:

    use IO::Socket::Multicast6 ();

and

    use IO::Socket::Multicast6;

of course mean different things. The former suppresses all exports.
It turns out that with Test::More::isa_ok() has no way of doing the former:

$ cat use_ok.pl

use warnings;
use strict;

use Test::More tests => 3;

package clash;

BEGIN { main::use_ok 'Socket' };

package crunch;

BEGIN { main::use_ok 'Socket', () };

package biff;

BEGIN { main::use_ok 'Socket', 'sockaddr_family' };

package main;

sub dump_lowercase_keys {
    my $package = shift;

    print "For package $package:\n";

    no strict 'refs';
    print "    $_\n" foreach sort grep {!tr/A-Z//} keys %{"${package}::"};

    print "\n";
}

dump_lowercase_keys $_ foreach qw (clash crunch biff);
__END__

$ perl use_ok.pl
1..3
ok 1 - use Socket;
ok 2 - use Socket;
ok 3 - use Socket;
For package clash:
    inet_aton
    inet_ntoa
    pack_sockaddr_in
    pack_sockaddr_un
    sockaddr_family
    sockaddr_in
    sockaddr_un
    unpack_sockaddr_in
    unpack_sockaddr_un

For package crunch:
    inet_aton
    inet_ntoa
    pack_sockaddr_in
    pack_sockaddr_un
    sockaddr_family
    sockaddr_in
    sockaddr_un
    unpack_sockaddr_in
    unpack_sockaddr_un

For package biff:
    sockaddr_family

So, there's no clean way to rewrite that test with use_ok to suppress imports.

So, to summarise, it's due to

A cascade of modules blindly exporting everything that Socket exports
Socket::inet_pton() and Socket6::inet_pton() differing in behaviour
A test that fails to realise that it's importing everything via use_ok

This one ranks as blocker because:

    Socket::inet_pton() and Socket::inet_ntop() are not in any stable release

    Hence we have the option to change them if we do it *NOW*.

I think that the right fix is the appended patch. This makes the new Socket
implementation of inet_pton consistent with the existing Socket6
implementation of inet_pton.

2 files changed, 3 insertions, 2 deletions

diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm
index ac7866a91c..48ec5166cc 100644
--- a/ext/Socket/Socket.pm
+++ b/ext/Socket/Socket.pm
@@ -1,7 +1,7 @@
 package Socket;
 
 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = "1.85";
+$VERSION = "1.86";
 
 =head1 NAME
 
diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
index 339b771847..2d469ed354 100644
--- a/ext/Socket/Socket.xs
+++ b/ext/Socket/Socket.xs
@@ -503,7 +503,8 @@ inet_pton(af, host)
 
         ST(0) = sv_newmortal();
         if (ok) {
-                sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
+                sv_setpvn( ST(0), (char *)&ip_address,
+                           af == AF_INET6 ? sizeof(ip_address) : sizeof(struct in_addr) );
         }
 #else
         ST(0) = (SV *)not_here("inet_pton");