|
 |
4dad76 |
From bc26d2e6b287cc6693f41e1a2d48b0dd77d2e427 Mon Sep 17 00:00:00 2001
|
|
|
4dad76 |
From: Tony Cook <tony@develop-help.com>
|
|
|
4dad76 |
Date: Tue, 18 Jun 2019 14:59:00 +1000
|
|
|
4dad76 |
Subject: [PATCH] (perl #133936) make send() a bit saner
|
|
|
4dad76 |
MIME-Version: 1.0
|
|
|
4dad76 |
Content-Type: text/plain; charset=UTF-8
|
|
|
4dad76 |
Content-Transfer-Encoding: 8bit
|
|
|
4dad76 |
|
|
|
4dad76 |
This undoes some of the effect of f1000aa2d in that TO will always
|
|
|
4dad76 |
be supplied to CORE::send() if it's supplied, otherwise whether
|
|
|
4dad76 |
TO is supplied to CORE::send() is based on whether the socket is
|
|
|
4dad76 |
connected.
|
|
|
4dad76 |
|
|
|
4dad76 |
On Linux you appear to be able to sendto() to a different address on
|
|
|
4dad76 |
a connected UDP socket, but this doesn't appear to be portable,
|
|
|
4dad76 |
failing on darwin, and presumably on other BSDs.
|
|
|
4dad76 |
|
|
|
4dad76 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
4dad76 |
---
|
|
|
4dad76 |
dist/IO/lib/IO/Socket.pm | 25 +++++++++++++++++--------
|
|
|
4dad76 |
dist/IO/t/io_udp.t | 11 ++++++++---
|
|
|
4dad76 |
2 files changed, 25 insertions(+), 11 deletions(-)
|
|
|
4dad76 |
|
|
|
4dad76 |
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
|
|
|
4dad76 |
index 345ffd475d..28fa1ec149 100644
|
|
|
4dad76 |
--- a/dist/IO/lib/IO/Socket.pm
|
|
|
4dad76 |
+++ b/dist/IO/lib/IO/Socket.pm
|
|
|
4dad76 |
@@ -277,13 +277,22 @@ sub send {
|
|
|
4dad76 |
@_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
|
|
|
4dad76 |
my $sock = $_[0];
|
|
|
4dad76 |
my $flags = $_[2] || 0;
|
|
|
4dad76 |
- my $peer = $_[3] || $sock->peername;
|
|
|
4dad76 |
+ my $peer;
|
|
|
4dad76 |
|
|
|
4dad76 |
- croak 'send: Cannot determine peer address'
|
|
|
4dad76 |
- unless(defined $peer);
|
|
|
4dad76 |
+ if ($_[3]) {
|
|
|
4dad76 |
+ # the caller explicitly requested a TO, so use it
|
|
|
4dad76 |
+ # this is non-portable for "connected" UDP sockets
|
|
|
4dad76 |
+ $peer = $_[3];
|
|
|
4dad76 |
+ }
|
|
|
4dad76 |
+ elsif (!defined getpeername($sock)) {
|
|
|
4dad76 |
+ # we're not connected, so we require a peer from somewhere
|
|
|
4dad76 |
+ $peer = $sock->peername;
|
|
|
4dad76 |
+
|
|
|
4dad76 |
+ croak 'send: Cannot determine peer address'
|
|
|
4dad76 |
+ unless(defined $peer);
|
|
|
4dad76 |
+ }
|
|
|
4dad76 |
|
|
|
4dad76 |
- my $type = $sock->socktype;
|
|
|
4dad76 |
- my $r = $type == SOCK_DGRAM || $type == SOCK_RAW
|
|
|
4dad76 |
+ my $r = $peer
|
|
|
4dad76 |
? send($sock, $_[1], $flags, $peer)
|
|
|
4dad76 |
: send($sock, $_[1], $flags);
|
|
|
4dad76 |
|
|
|
4dad76 |
@@ -526,9 +535,9 @@ C<FLAGS> is optional and defaults to C<0>, and
|
|
|
4dad76 |
|
|
|
4dad76 |
=item *
|
|
|
4dad76 |
|
|
|
4dad76 |
-after a successful send with C<TO>, further calls to send() without
|
|
|
4dad76 |
-C<TO> will send to the same address, and C<TO> will be used as the
|
|
|
4dad76 |
-result of peername().
|
|
|
4dad76 |
+after a successful send with C<TO>, further calls to send() on an
|
|
|
4dad76 |
+unconnected socket without C<TO> will send to the same address, and
|
|
|
4dad76 |
+C<TO> will be used as the result of peername().
|
|
|
4dad76 |
|
|
|
4dad76 |
=back
|
|
|
4dad76 |
|
|
|
4dad76 |
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
|
|
|
4dad76 |
index 571e4303bb..2adc6a4a69 100644
|
|
|
4dad76 |
--- a/dist/IO/t/io_udp.t
|
|
|
4dad76 |
+++ b/dist/IO/t/io_udp.t
|
|
|
4dad76 |
@@ -89,9 +89,14 @@ is($buf, 'FOObar');
|
|
|
4dad76 |
ok($udpa->recv($buf = "", 8), "recv it");
|
|
|
4dad76 |
is($buf, "fromctoa", "check value received");
|
|
|
4dad76 |
|
|
|
4dad76 |
- ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
|
|
|
4dad76 |
- ok($udpb->recv($buf = "", 8), "recv it");
|
|
|
4dad76 |
- is($buf, "fromctob", "check value received");
|
|
|
4dad76 |
+ SKIP:
|
|
|
4dad76 |
+ {
|
|
|
4dad76 |
+ $^O eq "linux"
|
|
|
4dad76 |
+ or skip "This is non-portable, known to 'work' on Linux", 3;
|
|
|
4dad76 |
+ ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
|
|
|
4dad76 |
+ ok($udpb->recv($buf = "", 8), "recv it");
|
|
|
4dad76 |
+ is($buf, "fromctob", "check value received");
|
|
|
4dad76 |
+ }
|
|
|
4dad76 |
}
|
|
|
4dad76 |
|
|
|
4dad76 |
exit(0);
|
|
|
4dad76 |
--
|
|
|
4dad76 |
2.20.1
|
|
|
4dad76 |
|