IO::Socket::send ignores peer on connected connection-less socket #16891

p5pRT · 2019-03-15T18:52:31Z

Migrated from rt.perl.org#133936 (status was 'pending release')

Searchable as RT133936$

p5pRT · 2019-03-15T18:52:31Z

From chemobejk@gmail.com

This is a bug report for perl from chemobejk@gmail.com,
generated with the help of perlbug 1.41 running under perl 5.28.1.

Copied from https://github.com/Dual-Life/IO/issues/17#issuecomment-473189242

I stumbled over the IO::Socket::send() implementation while investigating
SO question #55161627 (https://stackoverflow.com/questions/55161627/ "Why
does sendto() via Perl Socket->send() ignore the peer address?"):

sub peername {
@_ == 1 or croak 'usage: $sock->peername()';
my($sock) = @_;
${*$sock}{'io_socket_peername'} ||= getpeername($sock);
}
...
sub send {
...
my $peer = $_[3] || $sock->peername;

croak 'send: Cannot determine peer address'
unless(defined $peer);

my $r = defined(getpeername($sock))
? send($sock, $_[1], $flags)
: send($sock, $_[1], $flags, $peer);

# remember who we send to, if it was successful
${*$sock}{'io_socket_peername'} = $peer
if(@_ == 4 && defined $r);

Originally getpeername() wasn't called at all, i.e. the peer address passed
in by the caller was honoured. IO 1.12 (
Dual-Life/IO@9ab5475)
changed this, but only explains the What and not the Why. I have been
unable to find a better version control history entry for this change, i.e.
it is either lost or didn't exist at all.

Modified IO::Socket::send so not to pass 4 arguments to send if the
socket is connected

It could be that this paragraph in the Linux send(2) man page is the reason
behind the change:

If sendto() is used on a connection-mode (SOCK_STREAM, SOCK_SEQPACKET)
socket, the arguments dest_addr and addrlen are ignored **(and the
error
EISCONN may be returned when they are not NULL and 0)**, and the error
ENOTCONN is returned when the socket was not actually connected.

i.e. it would prevent a failure when $socket->send($data, $flags, $peer) is
used on a connected connection-mode socket. But this breaks the behaviour
for connection-less sockets, because $peer gets ignored:

#!/usr/bin/perl
use warnings;
use strict;

use IO::Socket::INET;
use Socket qw(pack_sockaddr_in unpack_sockaddr_in);

my $client = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => 2222,
Proto => 'udp',
) or die "client socket: $!\n";

my $addr = pack_sockaddr_in(3333, inet_aton('127.0.0.1'));

$client->send('ABCD', 0)
or die "IO::Socket::send() no addr: $!\n";
print "default peer port after IO::Socket::send() no addr: ",
(unpack_sockaddr_in($client->peername))[0], "\n";
$client->send('ABCD', 0, $addr)
or die "IO::Socket::send() with addr: $!\n";
print "default peer port after IO::Socket::send() with addr: ",
(unpack_sockaddr_in($client->peername))[0], "\n";
$client->send('ABCD', 0)
or die "IO::Socket::send() no addr/2: $!\n";
print "default peer port after IO::Socket::send() no addr/2: ",
(unpack_sockaddr_in($client->peername))[0], "\n";
send($client, 'ABCD', 0, $addr)
or die "send() with addr: $!\n";

exit 0;

Test run wrapped in strace:

$ strace -e send,sendto,connect,socket perl dummy.pl
socket(AF_INET, SOCK_DGRAM|SOCK_CLOEXEC, IPPROTO_UDP) = 4
connect(4, {sa_family=AF_INET, sin_port=htons(2222),
sin_addr=inet_addr("127.0.0.1")}, 16) = 0
sendto(4, "ABCD", 4, 0, NULL, 0) = 4
default peer port after IO::Socket::send() no addr: 2222
sendto(4, "ABCD", 4, 0, NULL, 0) = 4
default peer port after IO::Socket::send() with addr: 3333
sendto(4, "ABCD", 4, 0, NULL, 0) = 4
default peer port after IO::Socket::send() no addr/2: 3333
sendto(4, "ABCD", 4, 0, {sa_family=AF_INET, sin_port=htons(3333),
sin_addr=inet_addr("127.0.0.1")}, 16) = 4

Furthermore: although $peer is ignored, a successful $socket->send($data,
$flags, $peer) call still caches $peer as new default peername for the
socket!

Wouldn't it make sense to change the implementation to

sub send {
@_ >= 2 && @_ <= 4 or croak('usage: $sock->send(BUF, [FLAGS, [TO]])');
my $sock = $_[0];
my $flags = $_[2] || 0;
my $peer = $_[3] || $sock->peername;

croak('send: Cannot determine peer address')
unless(defined $peer);

my $r = ($sock->socktype == SOCK_DGRAM)
? send($sock, $_[1], $flags, $peer)
: send($sock, $_[1], $flags);

# remember who we send to, if it was successful
${*$sock}{'io_socket_peername'} = $peer
if(@_ == 4 && defined $r);

$r;
}

which would also take care of the performance issue of calling
getpeername() on every invocation. I'm not sure if the code would need to
check for other socket types besides SOCK_DGRAM.

With that implementation I get for my test code:

$ strace -e send,sendto,connect,socket perl dummy.pl
socket(AF_INET, SOCK_DGRAM|SOCK_CLOEXEC, IPPROTO_UDP) = 4
connect(4, {sa_family=AF_INET, sin_port=htons(2222),
sin_addr=inet_addr("127.0.0.1")}, 16) = 0
sendto(4, "ABCD", 4, 0, {sa_family=AF_INET, sin_port=htons(2222),
sin_addr=inet_addr("127.0.0.1")}, 16) = 4
default peer port after IO::Socket::send() no addr: 2222
sendto(4, "ABCD", 4, 0, {sa_family=AF_INET, sin_port=htons(3333),
sin_addr=inet_addr("127.0.0.1")}, 16) = 4
default peer port after IO::Socket::send() with addr: 3333
sendto(4, "ABCD", 4, 0, {sa_family=AF_INET, sin_port=htons(3333),
sin_addr=inet_addr("127.0.0.1")}, 16) = 4
default peer port after IO::Socket::send() no addr/2: 3333
sendto(4, "ABCD", 4, 0, {sa_family=AF_INET, sin_port=htons(3333),
sin_addr=inet_addr("127.0.0.1")}, 16) = 4

Also the IO::Socket documentation should be updated to mention that a
successful $socket->send($data, $flags, $peer) caches $peer as peername,
i.e. as default peer for send() without a peer parameter.

Flags:
category=library
severity=low
module=IO

p5pRT · 2019-03-18T05:06:04Z

From @tonycoz

On Fri, 15 Mar 2019 11:52:31 -0700, chemobejk@gmail.com wrote:

I stumbled over the IO::Socket::send() implementation while
investigating
SO question #55161627 (https://stackoverflow.com/questions/55161627/
"Why
does sendto() via Perl Socket->send() ignore the peer address?"):

Does the attached help for you?

Tony

p5pRT · 2019-03-18T05:06:04Z

From @tonycoz

133936-socket-send.patch

From 4246b37115dad0b0c6f6e0ca2790e37ac96e3578 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 15:05:32 +1100
Subject: [PATCH 1/3] (perl #133936) ensure TO is honoured for UDP
 $sock->send()

---
 dist/IO/lib/IO/Socket.pm |  7 ++++---
 dist/IO/t/io_udp.t       | 31 +++++++++++++++++++++++++++----
 2 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index 1bf57ab826..a34a10b232 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -282,9 +282,10 @@ sub send {
     croak 'send: Cannot determine peer address'
 	 unless(defined $peer);
 
-    my $r = defined(getpeername($sock))
-	? send($sock, $_[1], $flags)
-	: send($sock, $_[1], $flags, $peer);
+    my $type = $sock->socktype;
+    my $r = $type == SOCK_DGRAM || $type == SOCK_RAW
+      ? send($sock, $_[1], $flags, $peer)
+      : send($sock, $_[1], $flags);
 
     # remember who we send to, if it was successful
     ${*$sock}{'io_socket_peername'} = $peer
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
index d7e95a8829..571e4303bb 100644
--- a/dist/IO/t/io_udp.t
+++ b/dist/IO/t/io_udp.t
@@ -15,6 +15,8 @@ BEGIN {
     skip_all($reason) if $reason;
 }
 
+use strict;
+
 sub compare_addr {
     no utf8;
     my $a = shift;
@@ -36,18 +38,18 @@ sub compare_addr {
     "$a[0]$a[1]" eq "$b[0]$b[1]";
 }
 
-plan(7);
+plan(15);
 watchdog(15);
 
 use Socket;
 use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
 
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+my $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
      || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
     or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 ok(1);
 
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+my $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
      || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
     or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 ok(1);
@@ -56,6 +58,7 @@ $udpa->send('BORK', 0, $udpb->sockname);
 
 ok(compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname'));
 
+my $buf;
 my $where = $udpb->recv($buf="", 4);
 is($buf, 'BORK');
 
@@ -69,7 +72,27 @@ $udpb->send('FOObar', @xtra);
 $udpa->recv($buf="", 6);
 is($buf, 'FOObar');
 
-ok(! $udpa->connected);
+{
+    # check the TO parameter passed to $sock->send() is honoured for UDP sockets
+    # [perl #133936]
+    my $udpc = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+      || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+      or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+    pass("created C socket");
+
+    ok($udpc->connect($udpa->sockname), "connect C to A");
+
+    ok($udpc->connected, "connected a UDP socket");
+
+    ok($udpc->send("fromctoa"), "send to a");
+
+    ok($udpa->recv($buf = "", 8), "recv it");
+    is($buf, "fromctoa", "check value received");
+
+    ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
+    ok($udpb->recv($buf = "", 8), "recv it");
+    is($buf, "fromctob", "check value received");
+}
 
 exit(0);
 
-- 
2.11.0


From 5d05f57166c7a09531a887c3b3db60ca95e3152b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 15:48:04 +1100
Subject: [PATCH 2/3] bump $IO::VERSION

---
 dist/IO/IO.pm                 | 2 +-
 dist/IO/lib/IO/Dir.pm         | 2 +-
 dist/IO/lib/IO/File.pm        | 2 +-
 dist/IO/lib/IO/Handle.pm      | 2 +-
 dist/IO/lib/IO/Pipe.pm        | 2 +-
 dist/IO/lib/IO/Poll.pm        | 2 +-
 dist/IO/lib/IO/Seekable.pm    | 2 +-
 dist/IO/lib/IO/Select.pm      | 2 +-
 dist/IO/lib/IO/Socket.pm      | 2 +-
 dist/IO/lib/IO/Socket/INET.pm | 2 +-
 dist/IO/lib/IO/Socket/UNIX.pm | 2 +-
 11 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm
index 44c4df8415..7ccc8cfd02 100644
--- a/dist/IO/IO.pm
+++ b/dist/IO/IO.pm
@@ -7,7 +7,7 @@ use Carp;
 use strict;
 use warnings;
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 XSLoader::load 'IO', $VERSION;
 
 sub import {
diff --git a/dist/IO/lib/IO/Dir.pm b/dist/IO/lib/IO/Dir.pm
index e381880b44..3a14ca8983 100644
--- a/dist/IO/lib/IO/Dir.pm
+++ b/dist/IO/lib/IO/Dir.pm
@@ -18,7 +18,7 @@ use File::stat;
 use File::Spec;
 
 our @ISA = qw(Tie::Hash Exporter);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT_OK = qw(DIR_UNLINK);
 
diff --git a/dist/IO/lib/IO/File.pm b/dist/IO/lib/IO/File.pm
index 137ba54029..cf51d9bf63 100644
--- a/dist/IO/lib/IO/File.pm
+++ b/dist/IO/lib/IO/File.pm
@@ -135,7 +135,7 @@ require Exporter;
 
 our @ISA = qw(IO::Handle IO::Seekable Exporter);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT = @IO::Seekable::EXPORT;
 
diff --git a/dist/IO/lib/IO/Handle.pm b/dist/IO/lib/IO/Handle.pm
index a257024645..85f97732f0 100644
--- a/dist/IO/lib/IO/Handle.pm
+++ b/dist/IO/lib/IO/Handle.pm
@@ -270,7 +270,7 @@ use IO ();	# Load the XS module
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT_OK = qw(
     autoflush
diff --git a/dist/IO/lib/IO/Pipe.pm b/dist/IO/lib/IO/Pipe.pm
index e314c88d0e..c3ceb86233 100644
--- a/dist/IO/lib/IO/Pipe.pm
+++ b/dist/IO/lib/IO/Pipe.pm
@@ -13,7 +13,7 @@ use strict;
 use Carp;
 use Symbol;
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 sub new {
     my $type = shift;
diff --git a/dist/IO/lib/IO/Poll.pm b/dist/IO/lib/IO/Poll.pm
index 7aa1fb7514..3fe0179626 100644
--- a/dist/IO/lib/IO/Poll.pm
+++ b/dist/IO/lib/IO/Poll.pm
@@ -12,7 +12,7 @@ use IO::Handle;
 use Exporter ();
 
 our @ISA = qw(Exporter);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT = qw( POLLIN
 	      POLLOUT
diff --git a/dist/IO/lib/IO/Seekable.pm b/dist/IO/lib/IO/Seekable.pm
index 48f6dbeaf8..2370dcb89a 100644
--- a/dist/IO/lib/IO/Seekable.pm
+++ b/dist/IO/lib/IO/Seekable.pm
@@ -106,7 +106,7 @@ require Exporter;
 our @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
 our @ISA = qw(Exporter);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 sub seek {
     @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
diff --git a/dist/IO/lib/IO/Select.pm b/dist/IO/lib/IO/Select.pm
index 7d68feb7ab..980a7e9c69 100644
--- a/dist/IO/lib/IO/Select.pm
+++ b/dist/IO/lib/IO/Select.pm
@@ -10,7 +10,7 @@ use     strict;
 use warnings::register;
 require Exporter;
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @ISA = qw(Exporter); # This is only so we can do version checking
 
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index a34a10b232..da9e8c94d0 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
 
 our @ISA = qw(IO::Handle);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT_OK = qw(sockatmark);
 
diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm
index 8b4373f261..8688f375b5 100644
--- a/dist/IO/lib/IO/Socket/INET.pm
+++ b/dist/IO/lib/IO/Socket/INET.pm
@@ -14,7 +14,7 @@ use Exporter;
 use Errno;
 
 our @ISA = qw(IO::Socket);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
 
diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm
index ff38af0f63..04b36eaf74 100644
--- a/dist/IO/lib/IO/Socket/UNIX.pm
+++ b/dist/IO/lib/IO/Socket/UNIX.pm
@@ -11,7 +11,7 @@ use IO::Socket;
 use Carp;
 
 our @ISA = qw(IO::Socket);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 IO::Socket::UNIX->register_domain( AF_UNIX );
 
-- 
2.11.0


From f43045fa8e4eb8fc6c36d6e65d9760a73f668401 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 16:02:33 +1100
Subject: [PATCH 3/3] (perl #133936) document difference between
 IO::Socket::send and builtin

---
 dist/IO/lib/IO/Socket.pm | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index da9e8c94d0..e03c268733 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -434,7 +434,6 @@ corresponding built-in functions:
     bind
     listen
     accept
-    send
     recv
     peername (getpeername)
     sockname (getsockname)
@@ -517,6 +516,23 @@ SO_LINGER enabled with a zero timeout, then the peer's close() will generate
 a RST segment, upon receipt of which the local TCP transitions immediately to
 B<CLOSED>, and in that state, connected() I<will> return undef.
 
+=item send(MSG, [, FLAGS [, TO ] ])
+
+Like the built-in L<send()|perlfunc/send>, except that:
+
+=over
+
+=item *
+
+C<FLAGS> is optional and defaults to C<0>, and
+
+=item *
+
+after a successful send with C<TO>, further calls to send() without
+C<TO> will send to the same address.
+
+=back
+
 =item protocol
 
 Returns the numerical number for the protocol being used on the socket, if
-- 
2.11.0

p5pRT · 2019-03-18T05:06:04Z

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

p5pRT · 2019-06-05T06:09:06Z

From @tonycoz

On Sun, 17 Mar 2019 22:06:04 -0700, tonyc wrote:

On Fri, 15 Mar 2019 11:52:31 -0700, chemobejk@gmail.com wrote:

I stumbled over the IO::Socket::send() implementation while
investigating
SO question #55161627 (https://stackoverflow.com/questions/55161627/
"Why
does sendto() via Perl Socket->send() ignore the peer address?"):

Does the attached help for you?

Stefan responded by private email due to the email <-> RT issues.

Updated patch attached.

Tony

p5pRT · 2019-06-05T06:09:06Z

From @tonycoz

133936-socket-send2.patch

From 7fafdcb2a525b4f2815b02a4b9503e44821afc79 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 15:05:32 +1100
Subject: (perl #133936) ensure TO is honoured for UDP $sock->send()

---
 dist/IO/lib/IO/Socket.pm |  7 ++++---
 dist/IO/t/io_udp.t       | 31 +++++++++++++++++++++++++++----
 2 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index 1bf57ab826..a34a10b232 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -282,9 +282,10 @@ sub send {
     croak 'send: Cannot determine peer address'
 	 unless(defined $peer);
 
-    my $r = defined(getpeername($sock))
-	? send($sock, $_[1], $flags)
-	: send($sock, $_[1], $flags, $peer);
+    my $type = $sock->socktype;
+    my $r = $type == SOCK_DGRAM || $type == SOCK_RAW
+      ? send($sock, $_[1], $flags, $peer)
+      : send($sock, $_[1], $flags);
 
     # remember who we send to, if it was successful
     ${*$sock}{'io_socket_peername'} = $peer
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
index d7e95a8829..571e4303bb 100644
--- a/dist/IO/t/io_udp.t
+++ b/dist/IO/t/io_udp.t
@@ -15,6 +15,8 @@ BEGIN {
     skip_all($reason) if $reason;
 }
 
+use strict;
+
 sub compare_addr {
     no utf8;
     my $a = shift;
@@ -36,18 +38,18 @@ sub compare_addr {
     "$a[0]$a[1]" eq "$b[0]$b[1]";
 }
 
-plan(7);
+plan(15);
 watchdog(15);
 
 use Socket;
 use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
 
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+my $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
      || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
     or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 ok(1);
 
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+my $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
      || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
     or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
 ok(1);
@@ -56,6 +58,7 @@ $udpa->send('BORK', 0, $udpb->sockname);
 
 ok(compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname'));
 
+my $buf;
 my $where = $udpb->recv($buf="", 4);
 is($buf, 'BORK');
 
@@ -69,7 +72,27 @@ $udpb->send('FOObar', @xtra);
 $udpa->recv($buf="", 6);
 is($buf, 'FOObar');
 
-ok(! $udpa->connected);
+{
+    # check the TO parameter passed to $sock->send() is honoured for UDP sockets
+    # [perl #133936]
+    my $udpc = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+      || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+      or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+    pass("created C socket");
+
+    ok($udpc->connect($udpa->sockname), "connect C to A");
+
+    ok($udpc->connected, "connected a UDP socket");
+
+    ok($udpc->send("fromctoa"), "send to a");
+
+    ok($udpa->recv($buf = "", 8), "recv it");
+    is($buf, "fromctoa", "check value received");
+
+    ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
+    ok($udpb->recv($buf = "", 8), "recv it");
+    is($buf, "fromctob", "check value received");
+}
 
 exit(0);
 
-- 
2.11.0


From 02113af9e50ac9955009a85eef3c44e251ea3557 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 15:48:04 +1100
Subject: bump $IO::VERSION

---
 dist/IO/lib/IO/Dir.pm         | 2 +-
 dist/IO/lib/IO/File.pm        | 2 +-
 dist/IO/lib/IO/Handle.pm      | 2 +-
 dist/IO/lib/IO/Pipe.pm        | 2 +-
 dist/IO/lib/IO/Poll.pm        | 2 +-
 dist/IO/lib/IO/Seekable.pm    | 2 +-
 dist/IO/lib/IO/Select.pm      | 2 +-
 dist/IO/lib/IO/Socket.pm      | 2 +-
 dist/IO/lib/IO/Socket/INET.pm | 2 +-
 dist/IO/lib/IO/Socket/UNIX.pm | 2 +-
 10 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/dist/IO/lib/IO/Dir.pm b/dist/IO/lib/IO/Dir.pm
index e381880b44..3a14ca8983 100644
--- a/dist/IO/lib/IO/Dir.pm
+++ b/dist/IO/lib/IO/Dir.pm
@@ -18,7 +18,7 @@ use File::stat;
 use File::Spec;
 
 our @ISA = qw(Tie::Hash Exporter);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT_OK = qw(DIR_UNLINK);
 
diff --git a/dist/IO/lib/IO/File.pm b/dist/IO/lib/IO/File.pm
index 137ba54029..cf51d9bf63 100644
--- a/dist/IO/lib/IO/File.pm
+++ b/dist/IO/lib/IO/File.pm
@@ -135,7 +135,7 @@ require Exporter;
 
 our @ISA = qw(IO::Handle IO::Seekable Exporter);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT = @IO::Seekable::EXPORT;
 
diff --git a/dist/IO/lib/IO/Handle.pm b/dist/IO/lib/IO/Handle.pm
index a257024645..85f97732f0 100644
--- a/dist/IO/lib/IO/Handle.pm
+++ b/dist/IO/lib/IO/Handle.pm
@@ -270,7 +270,7 @@ use IO ();	# Load the XS module
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT_OK = qw(
     autoflush
diff --git a/dist/IO/lib/IO/Pipe.pm b/dist/IO/lib/IO/Pipe.pm
index e314c88d0e..c3ceb86233 100644
--- a/dist/IO/lib/IO/Pipe.pm
+++ b/dist/IO/lib/IO/Pipe.pm
@@ -13,7 +13,7 @@ use strict;
 use Carp;
 use Symbol;
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 sub new {
     my $type = shift;
diff --git a/dist/IO/lib/IO/Poll.pm b/dist/IO/lib/IO/Poll.pm
index 7aa1fb7514..3fe0179626 100644
--- a/dist/IO/lib/IO/Poll.pm
+++ b/dist/IO/lib/IO/Poll.pm
@@ -12,7 +12,7 @@ use IO::Handle;
 use Exporter ();
 
 our @ISA = qw(Exporter);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT = qw( POLLIN
 	      POLLOUT
diff --git a/dist/IO/lib/IO/Seekable.pm b/dist/IO/lib/IO/Seekable.pm
index 48f6dbeaf8..2370dcb89a 100644
--- a/dist/IO/lib/IO/Seekable.pm
+++ b/dist/IO/lib/IO/Seekable.pm
@@ -106,7 +106,7 @@ require Exporter;
 our @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
 our @ISA = qw(Exporter);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 sub seek {
     @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
diff --git a/dist/IO/lib/IO/Select.pm b/dist/IO/lib/IO/Select.pm
index 7d68feb7ab..980a7e9c69 100644
--- a/dist/IO/lib/IO/Select.pm
+++ b/dist/IO/lib/IO/Select.pm
@@ -10,7 +10,7 @@ use     strict;
 use warnings::register;
 require Exporter;
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @ISA = qw(Exporter); # This is only so we can do version checking
 
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index a34a10b232..da9e8c94d0 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
 
 our @ISA = qw(IO::Handle);
 
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 our @EXPORT_OK = qw(sockatmark);
 
diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm
index 8b4373f261..8688f375b5 100644
--- a/dist/IO/lib/IO/Socket/INET.pm
+++ b/dist/IO/lib/IO/Socket/INET.pm
@@ -14,7 +14,7 @@ use Exporter;
 use Errno;
 
 our @ISA = qw(IO::Socket);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
 
diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm
index ff38af0f63..04b36eaf74 100644
--- a/dist/IO/lib/IO/Socket/UNIX.pm
+++ b/dist/IO/lib/IO/Socket/UNIX.pm
@@ -11,7 +11,7 @@ use IO::Socket;
 use Carp;
 
 our @ISA = qw(IO::Socket);
-our $VERSION = "1.40";
+our $VERSION = "1.41";
 
 IO::Socket::UNIX->register_domain( AF_UNIX );
 
-- 
2.11.0


From db2b6d50013c9ecde5b1ae0922b7a11e8f551460 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 16:02:33 +1100
Subject: (perl #133936) document differences between IO::Socket::* and builtin

---
 dist/IO/lib/IO/Socket.pm | 43 ++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 40 insertions(+), 3 deletions(-)

diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index da9e8c94d0..345ffd475d 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -434,9 +434,6 @@ corresponding built-in functions:
     bind
     listen
     accept
-    send
-    recv
-    peername (getpeername)
     sockname (getsockname)
     shutdown
 
@@ -517,6 +514,46 @@ SO_LINGER enabled with a zero timeout, then the peer's close() will generate
 a RST segment, upon receipt of which the local TCP transitions immediately to
 B<CLOSED>, and in that state, connected() I<will> return undef.
 
+=item send(MSG, [, FLAGS [, TO ] ])
+
+Like the built-in L<send()|perlfunc/send>, except that:
+
+=over
+
+=item *
+
+C<FLAGS> is optional and defaults to C<0>, and
+
+=item *
+
+after a successful send with C<TO>, further calls to send() without
+C<TO> will send to the same address, and C<TO> will be used as the
+result of peername().
+
+=back
+
+=item recv(BUF, LEN, [,FLAGS])
+
+Like the built-in L<recv()|perlfunc/recv>, except that:
+
+=over
+
+=item *
+
+C<FLAGS> is optional and defaults to C<0>, and
+
+=item *
+
+the cached value returned by peername() is updated with the result of
+recv().
+
+=back
+
+=item peername
+
+Returns the cached peername, possibly set by recv() or send() above.
+If not otherwise set returns (and caches) the result of getpeername().
+
 =item protocol
 
 Returns the numerical number for the protocol being used on the socket, if
-- 
2.11.0

p5pRT · 2019-06-17T00:20:18Z

From @tonycoz

On Tue, 04 Jun 2019 23:09:06 -0700, tonyc wrote:

On Sun, 17 Mar 2019 22:06:04 -0700, tonyc wrote:

On Fri, 15 Mar 2019 11:52:31 -0700, chemobejk@gmail.com wrote:

I stumbled over the IO::Socket::send() implementation while
investigating
SO question #55161627 (https://stackoverflow.com/questions/55161627/
"Why
does sendto() via Perl Socket->send() ignore the peer address?"):

Does the attached help for you?

Stefan responded by private email due to the email <-> RT issues.

Updated patch attached.

Applied as f1000aa, 229dff1 and
1d9630e.

Tony

p5pRT · 2019-06-17T00:20:18Z

@tonycoz - Status changed from 'open' to 'pending release'

p5pRT · 2019-06-18T01:25:59Z

@tonycoz - Status changed from 'pending release' to 'open'

p5pRT · 2019-06-18T01:33:41Z

From @tonycoz

On Sun, 16 Jun 2019 17:20:18 -0700, tonyc wrote:

On Tue, 04 Jun 2019 23:09:06 -0700, tonyc wrote:

On Sun, 17 Mar 2019 22:06:04 -0700, tonyc wrote:

On Fri, 15 Mar 2019 11:52:31 -0700, chemobejk@gmail.com wrote:

I stumbled over the IO::Socket::send() implementation while
investigating
SO question #55161627
(https://stackoverflow.com/questions/55161627/
"Why
does sendto() via Perl Socket->send() ignore the peer address?"):

Does the attached help for you?

Stefan responded by private email due to the email <-> RT issues.

Updated patch attached.

Applied as f1000aa,
229dff1 and
1d9630e.

Tony

Due to #134201 I've re-opened this, my patch was wrong.

UDP sockets can be connected, and on some systems, calling send() with a TO address will fail.

UDP sockets can even be connected to a new address while connected or disconnected by trying to connect to a AF_UNSPEC address.

http://pubs.opengroup.org/onlinepubs/9699919799/functions/connect.html

I'm going to re-work this.

Tony

p5pRT · 2019-06-19T00:58:09Z

From @tonycoz

On Mon, 17 Jun 2019 18:33:41 -0700, tonyc wrote:

On Sun, 16 Jun 2019 17:20:18 -0700, tonyc wrote:

On Tue, 04 Jun 2019 23:09:06 -0700, tonyc wrote:

On Sun, 17 Mar 2019 22:06:04 -0700, tonyc wrote:

On Fri, 15 Mar 2019 11:52:31 -0700, chemobejk@gmail.com wrote:

I stumbled over the IO::Socket::send() implementation while
investigating
SO question #55161627
(https://stackoverflow.com/questions/55161627/
"Why
does sendto() via Perl Socket->send() ignore the peer
address?"):

Does the attached help for you?

Stefan responded by private email due to the email <-> RT issues.

Updated patch attached.

Applied as f1000aa,
229dff1 and
1d9630e.

Tony

Due to #134201 I've re-opened this, my patch was wrong.

UDP sockets can be connected, and on some systems, calling send() with
a TO address will fail.

UDP sockets can even be connected to a new address while connected or
disconnected by trying to connect to a AF_UNSPEC address.

http://pubs.opengroup.org/onlinepubs/9699919799/functions/connect.html

I'm going to re-work this.

Done in bc26d2e.

Tony

p5pRT · 2019-06-19T00:58:09Z

@tonycoz - Status changed from 'open' to 'pending release'

p5pRT closed this Jun 19, 2019

p5pRT added the Severity Low label Oct 19, 2019

Perl / perl5

IO::Socket::send ignores peer on connected connection-less socket #16891

IO::Socket::send ignores peer on connected connection-less socket #16891

p5pRT commented Mar 15, 2019

p5pRT commented Mar 15, 2019

p5pRT commented Mar 18, 2019

p5pRT commented Mar 18, 2019

p5pRT commented Mar 18, 2019

p5pRT commented Jun 5, 2019

p5pRT commented Jun 5, 2019

p5pRT commented Jun 17, 2019

p5pRT commented Jun 17, 2019

p5pRT commented Jun 18, 2019

p5pRT commented Jun 18, 2019

p5pRT commented Jun 19, 2019

p5pRT commented Jun 19, 2019

Perl / perl5

Join GitHub today

IO::Socket::send ignores peer on connected connection-less socket #16891

IO::Socket::send ignores peer on connected connection-less socket #16891

Comments

p5pRT commented Mar 15, 2019

p5pRT commented Mar 15, 2019

From chemobejk@gmail.com

p5pRT commented Mar 18, 2019

From @tonycoz

p5pRT commented Mar 18, 2019

From @tonycoz

p5pRT commented Mar 18, 2019

p5pRT commented Jun 5, 2019

From @tonycoz

p5pRT commented Jun 5, 2019

From @tonycoz

p5pRT commented Jun 17, 2019

From @tonycoz

p5pRT commented Jun 17, 2019

p5pRT commented Jun 18, 2019

p5pRT commented Jun 18, 2019

From @tonycoz

p5pRT commented Jun 19, 2019

From @tonycoz

p5pRT commented Jun 19, 2019