In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/1d9630e7857d6fbae6fddd261fbb80c9c9a8cfd6?hp=84ab3b690861c92bea535c991537bdde20c93750>
- Log ----------------------------------------------------------------- commit 1d9630e7857d6fbae6fddd261fbb80c9c9a8cfd6 Author: Tony Cook <[email protected]> Date: Mon Mar 18 16:02:33 2019 +1100 (perl #133936) document differences between IO::Socket::* and builtin commit 229dff1ea726e744f983d06b20f0a1803a7b6e9f Author: Tony Cook <[email protected]> Date: Mon Mar 18 15:48:04 2019 +1100 bump $IO::VERSION commit f1000aa2d58fbed2741dbb2887b668f872ef0cb8 Author: Tony Cook <[email protected]> Date: Mon Mar 18 15:05:32 2019 +1100 (perl #133936) ensure TO is honoured for UDP $sock->send() ----------------------------------------------------------------------- Summary of changes: 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 | 52 +++++++++++++++++++++++++++++++++++++------ dist/IO/lib/IO/Socket/INET.pm | 2 +- dist/IO/lib/IO/Socket/UNIX.pm | 2 +- dist/IO/t/io_udp.t | 31 ++++++++++++++++++++++---- 11 files changed, 81 insertions(+), 20 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 1bf57ab826..345ffd475d 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); @@ -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 @@ -433,9 +434,6 @@ corresponding built-in functions: bind listen accept - send - recv - peername (getpeername) sockname (getsockname) shutdown @@ -516,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 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 ); 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); -- Perl5 Master Repository
