Fix changing packet destination sent from a UDP IO::Socket object
This commit is contained in:
parent
e7d6451704
commit
a47c957eb2
|
@ -0,0 +1,78 @@
|
||||||
|
From 1d9630e7857d6fbae6fddd261fbb80c9c9a8cfd6 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] (perl #133936) document differences between IO::Socket::* and
|
||||||
|
builtin
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
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.20.1
|
||||||
|
|
|
@ -0,0 +1,107 @@
|
||||||
|
From f1000aa2d58fbed2741dbb2887b668f872ef0cb8 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] (perl #133936) ensure TO is honoured for UDP $sock->send()
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
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.20.1
|
||||||
|
|
|
@ -0,0 +1,93 @@
|
||||||
|
From bc26d2e6b287cc6693f41e1a2d48b0dd77d2e427 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Tue, 18 Jun 2019 14:59:00 +1000
|
||||||
|
Subject: [PATCH] (perl #133936) make send() a bit saner
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This undoes some of the effect of f1000aa2d in that TO will always
|
||||||
|
be supplied to CORE::send() if it's supplied, otherwise whether
|
||||||
|
TO is supplied to CORE::send() is based on whether the socket is
|
||||||
|
connected.
|
||||||
|
|
||||||
|
On Linux you appear to be able to sendto() to a different address on
|
||||||
|
a connected UDP socket, but this doesn't appear to be portable,
|
||||||
|
failing on darwin, and presumably on other BSDs.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
dist/IO/lib/IO/Socket.pm | 25 +++++++++++++++++--------
|
||||||
|
dist/IO/t/io_udp.t | 11 ++++++++---
|
||||||
|
2 files changed, 25 insertions(+), 11 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
|
||||||
|
index 345ffd475d..28fa1ec149 100644
|
||||||
|
--- a/dist/IO/lib/IO/Socket.pm
|
||||||
|
+++ b/dist/IO/lib/IO/Socket.pm
|
||||||
|
@@ -277,13 +277,22 @@ sub send {
|
||||||
|
@_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
|
||||||
|
my $sock = $_[0];
|
||||||
|
my $flags = $_[2] || 0;
|
||||||
|
- my $peer = $_[3] || $sock->peername;
|
||||||
|
+ my $peer;
|
||||||
|
|
||||||
|
- croak 'send: Cannot determine peer address'
|
||||||
|
- unless(defined $peer);
|
||||||
|
+ if ($_[3]) {
|
||||||
|
+ # the caller explicitly requested a TO, so use it
|
||||||
|
+ # this is non-portable for "connected" UDP sockets
|
||||||
|
+ $peer = $_[3];
|
||||||
|
+ }
|
||||||
|
+ elsif (!defined getpeername($sock)) {
|
||||||
|
+ # we're not connected, so we require a peer from somewhere
|
||||||
|
+ $peer = $sock->peername;
|
||||||
|
+
|
||||||
|
+ croak 'send: Cannot determine peer address'
|
||||||
|
+ unless(defined $peer);
|
||||||
|
+ }
|
||||||
|
|
||||||
|
- my $type = $sock->socktype;
|
||||||
|
- my $r = $type == SOCK_DGRAM || $type == SOCK_RAW
|
||||||
|
+ my $r = $peer
|
||||||
|
? send($sock, $_[1], $flags, $peer)
|
||||||
|
: send($sock, $_[1], $flags);
|
||||||
|
|
||||||
|
@@ -526,9 +535,9 @@ 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().
|
||||||
|
+after a successful send with C<TO>, further calls to send() on an
|
||||||
|
+unconnected socket without C<TO> will send to the same address, and
|
||||||
|
+C<TO> will be used as the result of peername().
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
|
||||||
|
index 571e4303bb..2adc6a4a69 100644
|
||||||
|
--- a/dist/IO/t/io_udp.t
|
||||||
|
+++ b/dist/IO/t/io_udp.t
|
||||||
|
@@ -89,9 +89,14 @@ is($buf, 'FOObar');
|
||||||
|
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");
|
||||||
|
+ SKIP:
|
||||||
|
+ {
|
||||||
|
+ $^O eq "linux"
|
||||||
|
+ or skip "This is non-portable, known to 'work' on Linux", 3;
|
||||||
|
+ 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.20.1
|
||||||
|
|
13
perl.spec
13
perl.spec
|
@ -191,6 +191,12 @@ Patch28: perl-5.31.0-perl-134072-allow-foo-bar-to-work-in-main.patch
|
||||||
# handler, RT#134035, fixed after 5.31.0
|
# handler, RT#134035, fixed after 5.31.0
|
||||||
Patch29: perl-5.31.0-perl-134035-ensure-sv_gets-handles-a-signal-handler-.patch
|
Patch29: perl-5.31.0-perl-134035-ensure-sv_gets-handles-a-signal-handler-.patch
|
||||||
|
|
||||||
|
# Fix changing packet destination sent from a UDP IO::Socket object,
|
||||||
|
# RT#133936, fixed after 5.31.0
|
||||||
|
Patch30: perl-5.31.0-perl-133936-ensure-TO-is-honoured-for-UDP-sock-send.patch
|
||||||
|
Patch31: perl-5.31.0-perl-133936-document-differences-between-IO-Socket-a.patch
|
||||||
|
Patch32: perl-5.31.0-perl-133936-make-send-a-bit-saner.patch
|
||||||
|
|
||||||
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
||||||
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
||||||
|
|
||||||
|
@ -2738,6 +2744,9 @@ Perl extension for Version Objects
|
||||||
%patch27 -p1
|
%patch27 -p1
|
||||||
%patch28 -p1
|
%patch28 -p1
|
||||||
%patch29 -p1
|
%patch29 -p1
|
||||||
|
%patch30 -p1
|
||||||
|
%patch31 -p1
|
||||||
|
%patch32 -p1
|
||||||
%patch200 -p1
|
%patch200 -p1
|
||||||
%patch201 -p1
|
%patch201 -p1
|
||||||
|
|
||||||
|
@ -2774,6 +2783,9 @@ perl -x patchlevel.h \
|
||||||
'Fedora Patch27: Prevent from wrapping a width in a numeric format string (RT#133913)' \
|
'Fedora Patch27: Prevent from wrapping a width in a numeric format string (RT#133913)' \
|
||||||
'Fedora Patch28: Fix subroutine protypes to track reference aliases (RT#134072)' \
|
'Fedora Patch28: Fix subroutine protypes to track reference aliases (RT#134072)' \
|
||||||
'Fedora Patch29: Improve retrieving a scalar value of a variable modified in a signal handler (RT#134035)' \
|
'Fedora Patch29: Improve retrieving a scalar value of a variable modified in a signal handler (RT#134035)' \
|
||||||
|
'Fedora Patch30: Fix changing packet destination sent from a UDP IO::Socket object (RT#133936)' \
|
||||||
|
'Fedora Patch31: Fix changing packet destination sent from a UDP IO::Socket object (RT#133936)' \
|
||||||
|
'Fedora Patch32: Fix changing packet destination sent from a UDP IO::Socket object (RT#133936)' \
|
||||||
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
||||||
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||||
%{nil}
|
%{nil}
|
||||||
|
@ -5033,6 +5045,7 @@ popd
|
||||||
- Fix subroutine protypes to track reference aliases (RT#134072)
|
- Fix subroutine protypes to track reference aliases (RT#134072)
|
||||||
- Improve retrieving a scalar value of a variable modified in a signal handler
|
- Improve retrieving a scalar value of a variable modified in a signal handler
|
||||||
(RT#134035)
|
(RT#134035)
|
||||||
|
- Fix changing packet destination sent from a UDP IO::Socket object (RT#133936)
|
||||||
|
|
||||||
* Tue Jun 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.0-439
|
* Tue Jun 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.0-439
|
||||||
- Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm
|
- Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm
|
||||||
|
|
Loading…
Reference in New Issue