From a47c957eb249620d8832b0114ba1f367eb8f338a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Tue, 25 Jun 2019 16:59:13 +0200 Subject: [PATCH] Fix changing packet destination sent from a UDP IO::Socket object --- ...ment-differences-between-IO-Socket-a.patch | 78 +++++++++++++ ...ure-TO-is-honoured-for-UDP-sock-send.patch | 107 ++++++++++++++++++ ....0-perl-133936-make-send-a-bit-saner.patch | 93 +++++++++++++++ perl.spec | 13 +++ 4 files changed, 291 insertions(+) create mode 100644 perl-5.31.0-perl-133936-document-differences-between-IO-Socket-a.patch create mode 100644 perl-5.31.0-perl-133936-ensure-TO-is-honoured-for-UDP-sock-send.patch create mode 100644 perl-5.31.0-perl-133936-make-send-a-bit-saner.patch diff --git a/perl-5.31.0-perl-133936-document-differences-between-IO-Socket-a.patch b/perl-5.31.0-perl-133936-document-differences-between-IO-Socket-a.patch new file mode 100644 index 0000000..fcdce36 --- /dev/null +++ b/perl-5.31.0-perl-133936-document-differences-between-IO-Socket-a.patch @@ -0,0 +1,78 @@ +From 1d9630e7857d6fbae6fddd261fbb80c9c9a8cfd6 Mon Sep 17 00:00:00 2001 +From: Tony Cook +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ř +--- + 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, and in that state, connected() I return undef. + ++=item send(MSG, [, FLAGS [, TO ] ]) ++ ++Like the built-in L, except that: ++ ++=over ++ ++=item * ++ ++C is optional and defaults to C<0>, and ++ ++=item * ++ ++after a successful send with C, further calls to send() without ++C will send to the same address, and C will be used as the ++result of peername(). ++ ++=back ++ ++=item recv(BUF, LEN, [,FLAGS]) ++ ++Like the built-in L, except that: ++ ++=over ++ ++=item * ++ ++C 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 + diff --git a/perl-5.31.0-perl-133936-ensure-TO-is-honoured-for-UDP-sock-send.patch b/perl-5.31.0-perl-133936-ensure-TO-is-honoured-for-UDP-sock-send.patch new file mode 100644 index 0000000..dbe89b9 --- /dev/null +++ b/perl-5.31.0-perl-133936-ensure-TO-is-honoured-for-UDP-sock-send.patch @@ -0,0 +1,107 @@ +From f1000aa2d58fbed2741dbb2887b668f872ef0cb8 Mon Sep 17 00:00:00 2001 +From: Tony Cook +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ř +--- + 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 + diff --git a/perl-5.31.0-perl-133936-make-send-a-bit-saner.patch b/perl-5.31.0-perl-133936-make-send-a-bit-saner.patch new file mode 100644 index 0000000..7e6826d --- /dev/null +++ b/perl-5.31.0-perl-133936-make-send-a-bit-saner.patch @@ -0,0 +1,93 @@ +From bc26d2e6b287cc6693f41e1a2d48b0dd77d2e427 Mon Sep 17 00:00:00 2001 +From: Tony Cook +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ř +--- + 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 is optional and defaults to C<0>, and + + =item * + +-after a successful send with C, further calls to send() without +-C will send to the same address, and C will be used as the +-result of peername(). ++after a successful send with C, further calls to send() on an ++unconnected socket without C will send to the same address, and ++C 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 + diff --git a/perl.spec b/perl.spec index 499222a..498caf9 100644 --- a/perl.spec +++ b/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 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 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 %patch28 -p1 %patch29 -p1 +%patch30 -p1 +%patch31 -p1 +%patch32 -p1 %patch200 -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 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 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 Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ %{nil} @@ -5033,6 +5045,7 @@ popd - Fix subroutine protypes to track reference aliases (RT#134072) - Improve retrieving a scalar value of a variable modified in a signal handler (RT#134035) +- Fix changing packet destination sent from a UDP IO::Socket object (RT#133936) * Tue Jun 11 2019 Jitka Plesnikova - 4:5.30.0-439 - Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm