diff options
| author | gregor herrmann <gregoa@debian.org> | 2021-01-23 21:26:28 +0100 |
|---|---|---|
| committer | gregor herrmann <gregoa@debian.org> | 2021-01-23 21:26:28 +0100 |
| commit | 6692dd280cf89616985f41cc4f7c9f6236d7a41a (patch) | |
| tree | 3d9136ef12e597a991c9cbcefc4b437b7243378a | |
| parent | 0905746cfeefea1cbfb3686d1c7abc050ece6c90 (diff) | |
New upstream version 0.78
42 files changed, 357 insertions, 216 deletions
@@ -1,5 +1,24 @@ Revision history for IO-Async +0.78 2021-01-21 + [CHANGES] + * Warn on attempts to ->connect to INADDR(6)_LOOPBACK as some OSes + (e.g. OpenBSD) do not allow it + * Various fixes for IO::Async::LoopTests to better support + IO::Async::Loop::UV: + + Insert some ->loop_once(0) calls between timing tests to allow + libuv to clear its pending queues + + Allow loops to declare that they cannot perform all-child PID + watch and skip the relevant tests for it if so + * Have $loop->later return a future instance if not passed any code + (RT133240) + + [BUGFIXES] + * Accept more error codes for failure to resolve missing hostname + (RT131109) + * Defend against some undef values at global destruction time + (RT132677) + 0.77 2020-05-13 [CHANGES] * Updated for Metrics::Any 0.05 @@ -1,4 +1,4 @@ -This software is copyright (c) 2020 by Paul Evans <leonerd@leonerd.org.uk>. +This software is copyright (c) 2021 by Paul Evans <leonerd@leonerd.org.uk>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. @@ -12,7 +12,7 @@ b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- -This software is Copyright (c) 2020 by Paul Evans <leonerd@leonerd.org.uk>. +This software is Copyright (c) 2021 by Paul Evans <leonerd@leonerd.org.uk>. This is free software, licensed under: @@ -272,7 +272,7 @@ That's all there is to it! --- The Artistic License 1.0 --- -This software is Copyright (c) 2020 by Paul Evans <leonerd@leonerd.org.uk>. +This software is Copyright (c) 2021 by Paul Evans <leonerd@leonerd.org.uk>. This is free software, licensed under: @@ -4,7 +4,7 @@ "Paul Evans <leonerd@leonerd.org.uk>" ], "dynamic_config" : 1, - "generated_by" : "Module::Build version 0.4224", + "generated_by" : "Module::Build version 0.4231", "license" : [ "perl_5" ], @@ -54,142 +54,142 @@ }, "IO::Async" : { "file" : "lib/IO/Async.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Channel" : { "file" : "lib/IO/Async/Channel.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Debug" : { "file" : "lib/IO/Async/Debug.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::File" : { "file" : "lib/IO/Async/File.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::FileStream" : { "file" : "lib/IO/Async/FileStream.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Function" : { "file" : "lib/IO/Async/Function.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Future" : { "file" : "lib/IO/Async/Future.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Handle" : { "file" : "lib/IO/Async/Handle.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Internals::ChildManager" : { "file" : "lib/IO/Async/Internals/ChildManager.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Listener" : { "file" : "lib/IO/Async/Listener.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Loop" : { "file" : "lib/IO/Async/Loop.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Loop::Poll" : { "file" : "lib/IO/Async/Loop/Poll.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Loop::Select" : { "file" : "lib/IO/Async/Loop/Select.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::LoopTests" : { "file" : "lib/IO/Async/LoopTests.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Metrics" : { "file" : "lib/IO/Async/Metrics.pm" }, "IO::Async::Notifier" : { "file" : "lib/IO/Async/Notifier.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::OS" : { "file" : "lib/IO/Async/OS.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::OS::MSWin32" : { "file" : "lib/IO/Async/OS/MSWin32.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::OS::cygwin" : { "file" : "lib/IO/Async/OS/cygwin.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::OS::linux" : { "file" : "lib/IO/Async/OS/linux.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::PID" : { "file" : "lib/IO/Async/PID.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Process" : { "file" : "lib/IO/Async/Process.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Protocol" : { "file" : "lib/IO/Async/Protocol.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Protocol::LineStream" : { "file" : "lib/IO/Async/Protocol/LineStream.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Protocol::Stream" : { "file" : "lib/IO/Async/Protocol/Stream.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Resolver" : { "file" : "lib/IO/Async/Resolver.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Routine" : { "file" : "lib/IO/Async/Routine.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Signal" : { "file" : "lib/IO/Async/Signal.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Socket" : { "file" : "lib/IO/Async/Socket.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Stream" : { "file" : "lib/IO/Async/Stream.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Test" : { "file" : "lib/IO/Async/Test.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Timer" : { "file" : "lib/IO/Async/Timer.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Timer::Absolute" : { "file" : "lib/IO/Async/Timer/Absolute.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Timer::Countdown" : { "file" : "lib/IO/Async/Timer/Countdown.pm", - "version" : "0.77" + "version" : "0.78" }, "IO::Async::Timer::Periodic" : { "file" : "lib/IO/Async/Timer/Periodic.pm", - "version" : "0.77" + "version" : "0.78" } }, "release_status" : "stable", @@ -199,6 +199,6 @@ ], "x_IRC" : "irc://irc.perl.org/#io-async" }, - "version" : "0.77", - "x_serialization_backend" : "JSON::PP version 4.04" + "version" : "0.78", + "x_serialization_backend" : "JSON::PP version 4.05" } @@ -12,7 +12,7 @@ build_requires: configure_requires: Module::Build: '0.4004' dynamic_config: 1 -generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010' +generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -23,108 +23,108 @@ provides: file: lib/Future/IO/Impl/IOAsync.pm IO::Async: file: lib/IO/Async.pm - version: '0.77' + version: '0.78' IO::Async::Channel: file: lib/IO/Async/Channel.pm - version: '0.77' + version: '0.78' IO::Async::Debug: file: lib/IO/Async/Debug.pm - version: '0.77' + version: '0.78' IO::Async::File: file: lib/IO/Async/File.pm - version: '0.77' + version: '0.78' IO::Async::FileStream: file: lib/IO/Async/FileStream.pm - version: '0.77' + version: '0.78' IO::Async::Function: file: lib/IO/Async/Function.pm - version: '0.77' + version: '0.78' IO::Async::Future: file: lib/IO/Async/Future.pm - version: '0.77' + version: '0.78' IO::Async::Handle: file: lib/IO/Async/Handle.pm - version: '0.77' + version: '0.78' IO::Async::Internals::ChildManager: file: lib/IO/Async/Internals/ChildManager.pm - version: '0.77' + version: '0.78' IO::Async::Listener: file: lib/IO/Async/Listener.pm - version: '0.77' + version: '0.78' IO::Async::Loop: file: lib/IO/Async/Loop.pm - version: '0.77' + version: '0.78' IO::Async::Loop::Poll: file: lib/IO/Async/Loop/Poll.pm - version: '0.77' + version: '0.78' IO::Async::Loop::Select: file: lib/IO/Async/Loop/Select.pm - version: '0.77' + version: '0.78' IO::Async::LoopTests: file: lib/IO/Async/LoopTests.pm - version: '0.77' + version: '0.78' IO::Async::Metrics: file: lib/IO/Async/Metrics.pm IO::Async::Notifier: file: lib/IO/Async/Notifier.pm - version: '0.77' + version: '0.78' IO::Async::OS: file: lib/IO/Async/OS.pm - version: '0.77' + version: '0.78' IO::Async::OS::MSWin32: file: lib/IO/Async/OS/MSWin32.pm - version: '0.77' + version: '0.78' IO::Async::OS::cygwin: file: lib/IO/Async/OS/cygwin.pm - version: '0.77' + version: '0.78' IO::Async::OS::linux: file: lib/IO/Async/OS/linux.pm - version: '0.77' + version: '0.78' IO::Async::PID: file: lib/IO/Async/PID.pm - version: '0.77' + version: '0.78' IO::Async::Process: file: lib/IO/Async/Process.pm - version: '0.77' + version: '0.78' IO::Async::Protocol: file: lib/IO/Async/Protocol.pm - version: '0.77' + version: '0.78' IO::Async::Protocol::LineStream: file: lib/IO/Async/Protocol/LineStream.pm - version: '0.77' + version: '0.78' IO::Async::Protocol::Stream: file: lib/IO/Async/Protocol/Stream.pm - version: '0.77' + version: '0.78' IO::Async::Resolver: file: lib/IO/Async/Resolver.pm - version: '0.77' + version: '0.78' IO::Async::Routine: file: lib/IO/Async/Routine.pm - version: '0.77' + version: '0.78' IO::Async::Signal: file: lib/IO/Async/Signal.pm - version: '0.77' + version: '0.78' IO::Async::Socket: file: lib/IO/Async/Socket.pm - version: '0.77' + version: '0.78' IO::Async::Stream: file: lib/IO/Async/Stream.pm - version: '0.77' + version: '0.78' IO::Async::Test: file: lib/IO/Async/Test.pm - version: '0.77' + version: '0.78' IO::Async::Timer: file: lib/IO/Async/Timer.pm - version: '0.77' + version: '0.78' IO::Async::Timer::Absolute: file: lib/IO/Async/Timer/Absolute.pm - version: '0.77' + version: '0.78' IO::Async::Timer::Countdown: file: lib/IO/Async/Timer/Countdown.pm - version: '0.77' + version: '0.78' IO::Async::Timer::Periodic: file: lib/IO/Async/Timer/Periodic.pm - version: '0.77' + version: '0.78' recommends: IO::Socket::IP: '0' requires: @@ -142,5 +142,5 @@ requires: resources: IRC: irc://irc.perl.org/#io-async license: http://dev.perl.org/licenses/ -version: '0.77' +version: '0.78' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/lib/IO/Async.pm b/lib/IO/Async.pm index 11c5cc3..eab3019 100644 --- a/lib/IO/Async.pm +++ b/lib/IO/Async.pm @@ -12,7 +12,7 @@ use warnings; # It is provided simply to keep CPAN happy: # cpan -i IO::Async -our $VERSION = '0.77'; +our $VERSION = '0.78'; =head1 NAME diff --git a/lib/IO/Async/Channel.pm b/lib/IO/Async/Channel.pm index baa1dc6..512fdc0 100644 --- a/lib/IO/Async/Channel.pm +++ b/lib/IO/Async/Channel.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Notifier ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Debug.pm b/lib/IO/Async/Debug.pm index 47fc9f3..3548b2d 100644 --- a/lib/IO/Async/Debug.pm +++ b/lib/IO/Async/Debug.pm @@ -8,7 +8,7 @@ package IO::Async::Debug; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; our $DEBUG = $ENV{IO_ASYNC_DEBUG} || 0; our $DEBUG_FD = $ENV{IO_ASYNC_DEBUG_FD}; diff --git a/lib/IO/Async/File.pm b/lib/IO/Async/File.pm index a4dddbf..d6ef72d 100644 --- a/lib/IO/Async/File.pm +++ b/lib/IO/Async/File.pm @@ -8,7 +8,7 @@ package IO::Async::File; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Timer::Periodic ); diff --git a/lib/IO/Async/FileStream.pm b/lib/IO/Async/FileStream.pm index b7f3671..bcc000b 100644 --- a/lib/IO/Async/FileStream.pm +++ b/lib/IO/Async/FileStream.pm @@ -8,7 +8,7 @@ package IO::Async::FileStream; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Stream ); diff --git a/lib/IO/Async/Function.pm b/lib/IO/Async/Function.pm index 8f17cc7..38695a6 100644 --- a/lib/IO/Async/Function.pm +++ b/lib/IO/Async/Function.pm @@ -8,7 +8,7 @@ package IO::Async::Function; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Notifier ); use IO::Async::Timer::Countdown; diff --git a/lib/IO/Async/Future.pm b/lib/IO/Async/Future.pm index 84b2ec0..7e8de42 100644 --- a/lib/IO/Async/Future.pm +++ b/lib/IO/Async/Future.pm @@ -8,7 +8,7 @@ package IO::Async::Future; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( Future ); Future->VERSION( '0.05' ); # to respect subclassing diff --git a/lib/IO/Async/Handle.pm b/lib/IO/Async/Handle.pm index 07bad9d..864a177 100644 --- a/lib/IO/Async/Handle.pm +++ b/lib/IO/Async/Handle.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Notifier ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; @@ -497,7 +497,7 @@ sub new_close_future my $self = shift or return; my $future = shift; - @{ $self->{close_futures} } = grep { $_ != $future } @{ $self->{close_futures} }; + @{ $self->{close_futures} } = grep { $_ and $_ != $future } @{ $self->{close_futures} }; }) ); diff --git a/lib/IO/Async/Internals/ChildManager.pm b/lib/IO/Async/Internals/ChildManager.pm index c9e6399..bca19b7 100644 --- a/lib/IO/Async/Internals/ChildManager.pm +++ b/lib/IO/Async/Internals/ChildManager.pm @@ -8,7 +8,7 @@ package IO::Async::Internals::ChildManager; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; # Not a notifier diff --git a/lib/IO/Async/Internals/Connector.pm b/lib/IO/Async/Internals/Connector.pm index 83b774b..79111b8 100644 --- a/lib/IO/Async/Internals/Connector.pm +++ b/lib/IO/Async/Internals/Connector.pm @@ -9,9 +9,9 @@ package # hide from CPAN use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; -use Scalar::Util qw( weaken ); +use Scalar::Util qw( weaken blessed ); use POSIX qw( EINPROGRESS ); use Socket qw( SOL_SOCKET SO_ERROR ); @@ -23,7 +23,10 @@ use IO::Async::OS; use Carp; -use constant CONNECT_EWOULDLBOCK => IO::Async::OS->HAVE_CONNECT_EWOULDBLOCK; +use constant { + CONNECT_EWOULDLBOCK => IO::Async::OS->HAVE_CONNECT_EWOULDBLOCK, + HAVE_SOCKADDR_IN6 => IO::Async::OS->HAVE_SOCKADDR_IN6, +}; # Internal constructor sub new @@ -186,7 +189,36 @@ sub connect ); } elsif( exists $params{addrs} or exists $params{addr} ) { - $peeraddrfuture = $loop->new_future->done( exists $params{addrs} ? @{ $params{addrs} } : ( $params{addr} ) ); + my @addrs = exists $params{addrs} ? @{ $params{addrs} } : ( $params{addr} ); + + # Warn about some common mistakes + foreach my $peer ( @addrs ) { + my ( $p_family, undef, undef, $p_addr ) = IO::Async::OS->extract_addrinfo( $peer ); + + local our @CARP_NOT = qw( IO::Async::Loop IO::Async::Handle ); + + if( $p_family == Socket::AF_INET ) { + carp "Connecting to 0.0.0.0 is non-portable and ill-advised" + if ( Socket::unpack_sockaddr_in $p_addr )[1] eq Socket::INADDR_ANY; + } + elsif( HAVE_SOCKADDR_IN6 and $p_family == Socket::AF_INET6 ) { + carp "Connecting to :: is non-portable and ill-advised" + if ( Socket::unpack_sockaddr_in6 $p_addr )[1] eq Socket::IN6ADDR_ANY; + } + } + + $peeraddrfuture = $loop->new_future->done( @addrs ); + } + elsif( exists $params{peer} ) { + my $peer = delete $params{peer}; + croak "Expected 'peer' to be an IO::Socket or subclass" + unless blessed $peer and $peer->isa( "IO::Socket" ); + + my $p_family = $peer->sockdomain; + + $peeraddrfuture = $loop->new_future->done( + [ $p_family, $peer->socktype, $peer->protocol, IO::Async::OS->make_addr_for_peer( $p_family, $peer->sockname ) ] + ); } else { croak "Expected 'host' and 'service' or 'addrs' or 'addr' arguments"; diff --git a/lib/IO/Async/Listener.pm b/lib/IO/Async/Listener.pm index c7350fa..dc1bf23 100644 --- a/lib/IO/Async/Listener.pm +++ b/lib/IO/Async/Listener.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Handle ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use IO::Async::Handle; use IO::Async::OS; @@ -412,7 +412,7 @@ sub socktype =head2 listen - $listener->listen( %params ) + $listener->listen( %params )->get This method sets up a listening socket and arranges for the acceptor callback to be invoked each time a new connection is accepted on the socket. diff --git a/lib/IO/Async/Loop.pm b/lib/IO/Async/Loop.pm index 0cfac00..f671b0a 100644 --- a/lib/IO/Async/Loop.pm +++ b/lib/IO/Async/Loop.pm @@ -1,14 +1,14 @@ # You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # -# (C) Paul Evans, 2007-2020 -- leonerd@leonerd.org.uk +# (C) Paul Evans, 2007-2021 -- leonerd@leonerd.org.uk package IO::Async::Loop; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; # When editing this value don't forget to update the docs below use constant NEED_API_VERSION => '0.33'; @@ -23,6 +23,9 @@ use constant _CAN_SUBSECOND_ACCURATELY => 0; # Does the loop implementation support IO_ASYNC_WATCHDOG? use constant _CAN_WATCHDOG => 0; +# Does the loop support ->watch_process on PID 0 to observe all exits? +use constant _CAN_WATCH_ALL_PIDS => 1; + # Watchdog configuration constants use constant WATCHDOG_ENABLE => $ENV{IO_ASYNC_WATCHDOG}; use constant WATCHDOG_INTERVAL => $ENV{IO_ASYNC_WATCHDOG_INTERVAL} || 10; @@ -873,6 +876,8 @@ sub detach_signal $loop->later( $code ) + $f = $loop->later + Schedules a code reference to be invoked as soon as the current round of IO operations is complete. @@ -886,6 +891,11 @@ This method is implemented using the C<watch_idle> method, with the C<when> parameter set to C<later>. It will return an ID value that can be passed to C<unwatch_idle> if required. +I<Since version 0.78>: If no C<$code> value is passed, a L<Future> will be +returned instead. This allows for constructs such as: + + await $loop->later; + =cut sub later @@ -893,7 +903,17 @@ sub later my $self = shift; my ( $code ) = @_; - return $self->watch_idle( when => 'later', code => $code ); + return $self->watch_idle( when => 'later', code => $code ) + if $code; + + my $f = $self->new_future; + my $id = $self->watch_idle( when => 'later', code => sub { + $f->done unless $f->is_ready; + } ); + $f->on_cancel( sub { + $self->unwatch_idle( $id ); + } ); + return $f; } =head2 spawn_child @@ -1519,6 +1539,13 @@ This example shows another way to connect to a UNIX socket at F<echo.sock>. ... ); +=item peer => IO + +Shortcut for constructing an address to connect to the given IO handle, which +must be a L<IO::Socket> or subclass, and is presumed to be a local listening +socket (perhaps on C<PF_UNIX> or C<PF_INET>). This is convenient for +connecting to a local filehandle, for example during a unit test or similar. + =item local_addrs => ARRAY =item local_addr => HASH or ARRAY @@ -2939,6 +2966,13 @@ look for exited child processes. If both a PID-specific and an all-process watch are installed, there is no ordering guarantee as to which will be called first. +B<NOTE> that not all loop classes may be able to support the all-child watch. +The basic Select and Poll-based classes provided by this distribution do, and +those built on top of similar OS-specific mechanisms such as Linux's Epoll +probably will, but typically those built on top of other event systems such +as F<glib> or F<libuv> may not be able, as the underlying event system may not +provide the necessary hooks to support it. + =cut sub watch_process diff --git a/lib/IO/Async/Loop/Poll.pm b/lib/IO/Async/Loop/Poll.pm index 6229cf2..8c1dd97 100644 --- a/lib/IO/Async/Loop/Poll.pm +++ b/lib/IO/Async/Loop/Poll.pm @@ -8,7 +8,7 @@ package IO::Async::Loop::Poll; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use constant API_VERSION => '0.49'; use base qw( IO::Async::Loop ); diff --git a/lib/IO/Async/Loop/Select.pm b/lib/IO/Async/Loop/Select.pm index f405109..9cb91f5 100644 --- a/lib/IO/Async/Loop/Select.pm +++ b/lib/IO/Async/Loop/Select.pm @@ -8,7 +8,7 @@ package IO::Async::Loop::Select; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use constant API_VERSION => '0.49'; use base qw( IO::Async::Loop ); diff --git a/lib/IO/Async/LoopTests.pm b/lib/IO/Async/LoopTests.pm index cbe9b0b..91d6e80 100644 --- a/lib/IO/Async/LoopTests.pm +++ b/lib/IO/Async/LoopTests.pm @@ -1,7 +1,7 @@ # You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # -# (C) Paul Evans, 2009-2020 -- leonerd@leonerd.org.uk +# (C) Paul Evans, 2009-2021 -- leonerd@leonerd.org.uk package IO::Async::LoopTests; @@ -28,7 +28,7 @@ use POSIX qw( SIGTERM ); use Socket qw( sockaddr_family AF_UNIX ); use Time::HiRes qw( time ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; # Abstract Units of Time use constant AUT => $ENV{TEST_QUICK_TIMERS} ? 0.1 : 1; @@ -428,58 +428,71 @@ Tests the Loop's ability to handle timer events sub run_tests_timer { - my $done = 0; # New watch/unwatch API cmp_ok( abs( $loop->time - time ), "<", 0.1, '$loop->time gives the current time' ); - $loop->watch_time( after => 2 * AUT, code => sub { $done = 1; } ); + # ->watch_time after + { + my $done; + $loop->watch_time( after => 2 * AUT, code => sub { $done = 1; } ); - is_oneref( $loop, '$loop has refcount 1 after watch_time' ); + is_oneref( $loop, '$loop has refcount 1 after watch_time' ); - time_between { - my $now = time; - $loop->loop_once( 5 * AUT ); + time_between { + my $now = time; + $loop->loop_once( 5 * AUT ); - # poll might have returned just a little early, such that the TimerQueue - # doesn't think anything is ready yet. We need to handle that case. - while( !$done ) { - die "It should have been ready by now" if( time - $now > 5 * AUT ); - $loop->loop_once( 0.1 * AUT ); - } - } 1.5, 2.5, 'loop_once(5) while waiting for watch_time after'; - - $loop->watch_time( at => time + 2 * AUT, code => sub { $done = 2; } ); + # poll might have returned just a little early, such that the TimerQueue + # doesn't think anything is ready yet. We need to handle that case. + while( !$done ) { + die "It should have been ready by now" if( time - $now > 5 * AUT ); + $loop->loop_once( 0.1 * AUT ); + } + } 1.5, 2.5, 'loop_once(5) while waiting for watch_time after'; + } - time_between { - my $now = time; - $loop->loop_once( 5 * AUT ); + # ->watch_time at + { + my $done; + $loop->watch_time( at => time + 2 * AUT, code => sub { $done = 1; } ); - # poll might have returned just a little early, such that the TimerQueue - # doesn't think anything is ready yet. We need to handle that case. - while( !$done ) { - die "It should have been ready by now" if( time - $now > 5 * AUT ); - $loop->loop_once( 0.1 * AUT ); - } - } 1.5, 2.5, 'loop_once(5) while waiting for watch_time at'; + time_between { + my $now = time; + $loop->loop_once( 5 * AUT ); - my $cancelled_fired = 0; - my $id = $loop->watch_time( after => 1 * AUT, code => sub { $cancelled_fired = 1 } ); - $loop->unwatch_time( $id ); - undef $id; + # poll might have returned just a little early, such that the TimerQueue + # doesn't think anything is ready yet. We need to handle that case. + while( !$done ) { + die "It should have been ready by now" if( time - $now > 5 * AUT ); + $loop->loop_once( 0.1 * AUT ); + } + } 1.5, 2.5, 'loop_once(5) while waiting for watch_time at'; + } - $loop->loop_once( 2 * AUT ); + # cancelled timer + { + my $cancelled_fired = 0; + my $id = $loop->watch_time( after => 1 * AUT, code => sub { $cancelled_fired = 1 } ); + $loop->unwatch_time( $id ); + undef $id; - ok( !$cancelled_fired, 'unwatched watch_time does not fire' ); + $loop->loop_once( 2 * AUT ); - $loop->watch_time( after => -1, code => sub { $done = 1 } ); + ok( !$cancelled_fired, 'unwatched watch_time does not fire' ); + } - $done = 0; + # ->watch_after negative time + { + my $done; + $loop->watch_time( after => -1, code => sub { $done = 1 } ); - time_between { - $loop->loop_once while !$done; - } 0, 0.1, 'loop_once while waiting for negative interval timer'; + time_between { + $loop->loop_once while !$done; + } 0, 0.1, 'loop_once while waiting for negative interval timer'; + } + # self-cancellation { my $done; @@ -497,25 +510,6 @@ sub run_tests_timer is( $done, 1, 'Other timers still fire after self-cancelling one' ); } - # Legacy enqueue/requeue/cancel API - $done = 0; - - $loop->enqueue_timer( delay => 2 * AUT, code => sub { $done = 1; } ); - - is_oneref( $loop, '$loop has refcount 1 after enqueue_timer' ); - - time_between { - my $now = time; - $loop->loop_once( 5 * AUT ); - - # poll might have returned just a little early, such that the TimerQueue - # doesn't think anything is ready yet. We need to handle that case. - while( !$done ) { - die "It should have been ready by now" if( time - $now > 5 * AUT ); - $loop->loop_once( 0.1 * AUT ); - } - } 1.5, 2.5, 'loop_once(5) while waiting for timer'; - SKIP: { skip "Unable to handle sub-second timers accurately", 3 unless $loop->_CAN_SUBSECOND_ACCURATELY; @@ -525,7 +519,7 @@ sub run_tests_timer my $count = 0; my $start = time; - $loop->enqueue_timer( delay => $delay, code => sub { $done++ } ); + $loop->watch_timer( delay => $delay, code => sub { $done++ } ); while( !$done ) { $loop->loop_once( 1 ); @@ -536,38 +530,6 @@ sub run_tests_timer is( $count, 1, "One ->loop_once(1) sufficient for a single $delay second timer" ); } } - - $cancelled_fired = 0; - $id = $loop->enqueue_timer( delay => 1 * AUT, code => sub { $cancelled_fired = 1 } ); - $loop->cancel_timer( $id ); - undef $id; - - $loop->loop_once( 2 * AUT ); - - ok( !$cancelled_fired, 'cancelled timer does not fire' ); - - $id = $loop->enqueue_timer( delay => 1 * AUT, code => sub { $done = 2; } ); - $id = $loop->requeue_timer( $id, delay => 2 * AUT ); - - $done = 0; - - time_between { - $loop->loop_once( 1 * AUT ); - - is( $done, 0, '$done still 0 so far' ); - - my $now = time; - $loop->loop_once( 5 * AUT ); - - # poll might have returned just a little early, such that the TimerQueue - # doesn't think anything is ready yet. We need to handle that case. - while( !$done ) { - die "It should have been ready by now" if( time - $now > 5 * AUT ); - $loop->loop_once( 0.1 * AUT ); - } - } 1.5, 2.5, 'requeued timer of delay 2'; - - is( $done, 2, '$done is 2 after requeued timer' ); } =head2 signal @@ -696,6 +658,10 @@ sub run_tests_idle $loop->unwatch_idle( $id ); + # Some loop types (e.g. UV) need to clear a pending queue first and thus the + # first loop_once will take zero time + $loop->loop_once( 0 ); + time_between { $loop->loop_once( 1 * AUT ) } 0.5, 1.5, 'loop_once(1) with unwatched deferral'; is( $called, 2, 'unwatched deferral not called' ); @@ -777,16 +743,20 @@ sub run_tests_process is( ($exitcode & 0x7f), SIGTERM, 'WTERMSIG($exitcode) after SIGTERM' ); } - my %kids; + SKIP: { + my %kids; - $loop->watch_process( 0 => sub { my ( $kid ) = @_; delete $kids{$kid} } ); + $loop->_CAN_WATCH_ALL_PIDS or skip "Loop cannot watch_process for all PIDs", 2; - %kids = map { run_in_child { exit 0 } => 1 } 1 .. 3; + $loop->watch_process( 0 => sub { my ( $kid ) = @_; delete $kids{$kid} } ); - is( scalar keys %kids, 3, 'Waiting for 3 child processes' ); + %kids = map { run_in_child { exit 0 } => 1 } 1 .. 3; - wait_for { !keys %kids }; - ok( !keys %kids, 'All child processes reclaimed' ); + is( scalar keys %kids, 3, 'Waiting for 3 child processes' ); + + wait_for { !keys %kids }; + ok( !keys %kids, 'All child processes reclaimed' ); + } # Legacy API name $kid = run_in_child { exit 2 }; diff --git a/lib/IO/Async/Notifier.pm b/lib/IO/Async/Notifier.pm index 6b251bf..3335205 100644 --- a/lib/IO/Async/Notifier.pm +++ b/lib/IO/Async/Notifier.pm @@ -8,7 +8,7 @@ package IO::Async::Notifier; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; use Scalar::Util qw( weaken ); diff --git a/lib/IO/Async/OS.pm b/lib/IO/Async/OS.pm index e9f46e8..d5ede3d 100644 --- a/lib/IO/Async/OS.pm +++ b/lib/IO/Async/OS.pm @@ -8,7 +8,7 @@ package IO::Async::OS; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; our @ISA = qw( IO::Async::OS::_Base ); @@ -527,6 +527,43 @@ sub _extract_addrinfo_unix =cut +=head2 make_addr_for_peer + + $connectaddr = IO::Async::OS->make_addr_for_peer( $family, $listenaddr ) + +Given the C<sockdomain> and C<sockname> of a listening socket. creates an +address suitable to C<connect()> to it. + +This method will handle specially any C<AF_INET> address bound to +C<INADDR_ANY> or any C<AF_INET6> address bound to C<IN6ADDR_ANY>, as some OSes +do not allow C<connect(2)>ing to those and would instead insist on receiving +C<INADDR_LOOPBACK> or C<IN6ADDR_LOOPBACK> respectively. + +This method is used by the C<< ->connect( peer => $sock ) >> parameter of +handle and loop connect methods. + +=cut + +sub make_addr_for_peer +{ + shift; + my ( $p_family, $p_addr ) = @_; + + if( $p_family == Socket::AF_INET ) { + my @params = Socket::unpack_sockaddr_in $p_addr; + $params[1] = Socket::INADDR_LOOPBACK if $params[1] eq Socket::INADDR_ANY; + return Socket::pack_sockaddr_in @params; + } + if( HAVE_SOCKADDR_IN6 and $p_family == Socket::AF_INET6 ) { + my @params = Socket::unpack_sockaddr_in6 $p_addr; + $params[1] = Socket::IN6ADDR_LOOPBACK if $params[1] eq Socket::IN6ADDR_ANY; + return Socket::pack_sockaddr_in6 @params; + } + + # Most other cases should be fine + return $p_addr; +} + =head1 LOOP IMPLEMENTATION METHODS The following methods are provided on C<IO::Async::OS> because they are likely diff --git a/lib/IO/Async/OS/MSWin32.pm b/lib/IO/Async/OS/MSWin32.pm index ecda8ab..9edef9f 100644 --- a/lib/IO/Async/OS/MSWin32.pm +++ b/lib/IO/Async/OS/MSWin32.pm @@ -8,7 +8,7 @@ package IO::Async::OS::MSWin32; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; our @ISA = qw( IO::Async::OS::_Base ); diff --git a/lib/IO/Async/OS/cygwin.pm b/lib/IO/Async/OS/cygwin.pm index 945fefd..4258fdb 100644 --- a/lib/IO/Async/OS/cygwin.pm +++ b/lib/IO/Async/OS/cygwin.pm @@ -8,7 +8,7 @@ package IO::Async::OS::cygwin; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; our @ISA = qw( IO::Async::OS::_Base ); diff --git a/lib/IO/Async/OS/linux.pm b/lib/IO/Async/OS/linux.pm index 28e1f1a..79482ea 100644 --- a/lib/IO/Async/OS/linux.pm +++ b/lib/IO/Async/OS/linux.pm @@ -8,7 +8,7 @@ package IO::Async::OS::linux; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; our @ISA = qw( IO::Async::OS::_Base ); diff --git a/lib/IO/Async/PID.pm b/lib/IO/Async/PID.pm index 479925c..4f9876c 100644 --- a/lib/IO/Async/PID.pm +++ b/lib/IO/Async/PID.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Notifier ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Process.pm b/lib/IO/Async/Process.pm index fd92be5..c8f0493 100644 --- a/lib/IO/Async/Process.pm +++ b/lib/IO/Async/Process.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Notifier ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Protocol.pm b/lib/IO/Async/Protocol.pm index b8342ab..772fe1c 100644 --- a/lib/IO/Async/Protocol.pm +++ b/lib/IO/Async/Protocol.pm @@ -8,7 +8,7 @@ package IO::Async::Protocol; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Notifier ); diff --git a/lib/IO/Async/Protocol/LineStream.pm b/lib/IO/Async/Protocol/LineStream.pm index 2335d23..4ea49a7 100644 --- a/lib/IO/Async/Protocol/LineStream.pm +++ b/lib/IO/Async/Protocol/LineStream.pm @@ -8,7 +8,7 @@ package IO::Async::Protocol::LineStream; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Protocol::Stream ); diff --git a/lib/IO/Async/Protocol/Stream.pm b/lib/IO/Async/Protocol/Stream.pm index db98494..f6f5206 100644 --- a/lib/IO/Async/Protocol/Stream.pm +++ b/lib/IO/Async/Protocol/Stream.pm @@ -8,7 +8,7 @@ package IO::Async::Protocol::Stream; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Protocol ); diff --git a/lib/IO/Async/Resolver.pm b/lib/IO/Async/Resolver.pm index 22f6d93..c6de4d3 100644 --- a/lib/IO/Async/Resolver.pm +++ b/lib/IO/Async/Resolver.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Function ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; # Socket 2.006 fails to getaddrinfo() AI_NUMERICHOST properly on MSWin32 use Socket 2.007 qw( diff --git a/lib/IO/Async/Routine.pm b/lib/IO/Async/Routine.pm index 4b1f69b..18671e1 100644 --- a/lib/IO/Async/Routine.pm +++ b/lib/IO/Async/Routine.pm @@ -8,7 +8,7 @@ package IO::Async::Routine; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Notifier ); diff --git a/lib/IO/Async/Signal.pm b/lib/IO/Async/Signal.pm index a5749e8..4eac03d 100644 --- a/lib/IO/Async/Signal.pm +++ b/lib/IO/Async/Signal.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Notifier ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Socket.pm b/lib/IO/Async/Socket.pm index 9b194ca..149d608 100644 --- a/lib/IO/Async/Socket.pm +++ b/lib/IO/Async/Socket.pm @@ -8,7 +8,7 @@ package IO::Async::Socket; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Handle ); diff --git a/lib/IO/Async/Stream.pm b/lib/IO/Async/Stream.pm index 42833f0..0d928c1 100644 --- a/lib/IO/Async/Stream.pm +++ b/lib/IO/Async/Stream.pm @@ -8,7 +8,7 @@ package IO::Async::Stream; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use base qw( IO::Async::Handle ); diff --git a/lib/IO/Async/Test.pm b/lib/IO/Async/Test.pm index eeac822..78a0512 100644 --- a/lib/IO/Async/Test.pm +++ b/lib/IO/Async/Test.pm @@ -8,7 +8,7 @@ package IO::Async::Test; use strict; use warnings; -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Exporter 'import'; our @EXPORT = qw( diff --git a/lib/IO/Async/Timer.pm b/lib/IO/Async/Timer.pm index 6271957..f00fd8a 100644 --- a/lib/IO/Async/Timer.pm +++ b/lib/IO/Async/Timer.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Notifier ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Timer/Absolute.pm b/lib/IO/Async/Timer/Absolute.pm index 5fde51a..6869430 100644 --- a/lib/IO/Async/Timer/Absolute.pm +++ b/lib/IO/Async/Timer/Absolute.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Timer ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Timer/Countdown.pm b/lib/IO/Async/Timer/Countdown.pm index 9ddbebf..138ea3e 100644 --- a/lib/IO/Async/Timer/Countdown.pm +++ b/lib/IO/Async/Timer/Countdown.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Timer ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; diff --git a/lib/IO/Async/Timer/Periodic.pm b/lib/IO/Async/Timer/Periodic.pm index b9741c8..07e1b99 100644 --- a/lib/IO/Async/Timer/Periodic.pm +++ b/lib/IO/Async/Timer/Periodic.pm @@ -9,7 +9,7 @@ use strict; use warnings; use base qw( IO::Async::Timer ); -our $VERSION = '0.77'; +our $VERSION = '0.78'; use Carp; @@ -9,8 +9,11 @@ use Test::Fatal; use IO::Async::OS; use Socket qw( - AF_INET AF_INET6 AF_UNIX SOCK_STREAM SOCK_DGRAM SO_TYPE - pack_sockaddr_in pack_sockaddr_in6 pack_sockaddr_un inet_aton inet_pton + SOCK_STREAM SOCK_DGRAM SO_TYPE + AF_INET pack_sockaddr_in unpack_sockaddr_in + AF_INET6 pack_sockaddr_in6 unpack_sockaddr_in6 + AF_UNIX pack_sockaddr_un unpack_sockaddr_un + inet_aton inet_pton inet_ntoa inet_ntop INADDR_ANY ); @@ -135,6 +138,18 @@ is( IO::Async::OS->getsocktypebyname( SOCK_STREAM ), SOCK_STREAM, 'getsocktypeby family => "inet", host => "foobar.com", } ) }, 'extract_addrinfo for inet complains about unrecognised key' ); + + # ->make_addr_for_peer should rewrite 0.0.0.0 to 127.0.0.1 + my ( $port, $host ) = unpack_sockaddr_in( + IO::Async::OS->make_addr_for_peer( AF_INET, pack_sockaddr_in( 567, inet_aton( "0.0.0.0" ) ) ) + ); + is( $port, 567, 'make_addr_for_peer preserves AF_INET port' ); + is( inet_ntoa( $host ), "127.0.0.1", 'make_addr_for_peer rewrites INADDR_ANY to _LOCALHOST' ); + + ( undef, $host ) = unpack_sockaddr_in( + IO::Async::OS->make_addr_for_peer( AF_INET, pack_sockaddr_in( 567, inet_aton( "1.2.3.4" ) ) ) + ); + is( inet_ntoa( $host ), "1.2.3.4", 'make_addr_for_peer preserves AF_INET other host' ); } SKIP: { @@ -149,6 +164,18 @@ SKIP: { } ) ], [ AF_INET6, SOCK_STREAM, 0, $sin6addr ], 'extract_addrinfo( HASH ) with inet6, ip+port' ); + + # ->make_addr_for_peer should rewrite :: to ::1 + my ( $port, $host ) = unpack_sockaddr_in6( + IO::Async::OS->make_addr_for_peer( AF_INET6, pack_sockaddr_in6( 567, inet_pton( AF_INET6, "::" ) ) ) + ); + is( $port, 567, 'make_addr_for_peer preserves AF_INET6 port' ); + is( inet_ntop( AF_INET6, $host ), "::1", 'make_addr_for_peer rewrites IN6ADDR_ANY to _LOCALHOST' ); + + ( undef, $host ) = unpack_sockaddr_in6( + IO::Async::OS->make_addr_for_peer( AF_INET6, pack_sockaddr_in6( 567, inet_pton( AF_INET6, "fe80::1234" ) ) ) + ); + is( inet_ntop( AF_INET6, $host ), "fe80::1234", 'make_addr_for_peer preserves AF_INET6 other host' ); } SKIP: { @@ -162,6 +189,12 @@ SKIP: { } ) ], [ AF_UNIX, SOCK_STREAM, 0, $sunaddr ], 'extract_addrinfo( HASH ) with unix, path' ); + + # ->make_addr_for_peer should leave address undisturbed + my ( $path ) = unpack_sockaddr_un( + IO::Async::OS->make_addr_for_peer( AF_UNIX, pack_sockaddr_un( "/tmp/mysock" ) ) + ); + is( $path, "/tmp/mysock", 'make_addr_for_peer preserves AF_UNIX path' ); } ok( exception { IO::Async::OS->extract_addrinfo( { family => "hohum" } ) }, diff --git a/t/19loop-future.t b/t/19loop-future.t index 25c3e98..c8dd432 100644 --- a/t/19loop-future.t +++ b/t/19loop-future.t @@ -30,6 +30,20 @@ my $loop = IO::Async::Loop->new_builtin; } { + my $future = $loop->later; + my $cancellable_future = $loop->later; + + ok( !$future->is_ready, '$loop->later returns a pending Future' ); + ok( !$cancellable_future->is_ready, 'another $loop->later also returns a pending Future' ); + + $cancellable_future->cancel; + $loop->loop_once; + + ok( $future->is_done, '$loop->later Future is resolved after one loop iteration' ); + ok( $cancellable_future->is_cancelled, '$loop->later Future cancels cleanly' ); +} + +{ my @futures = map { Future->new } 0 .. 2; do { my $id = $_; $loop->later( sub { $futures[$id]->done } ) } for 0 .. 2; diff --git a/t/50resolver.t b/t/50resolver.t index 37354ae..438b8d7 100644 --- a/t/50resolver.t +++ b/t/50resolver.t @@ -339,7 +339,9 @@ SKIP: { is( ( $future->failure )[2], "getaddrinfo", '->failure [2] gives getaddrinfo' ); my $errno = ( $future->failure )[3]; - ok( $errno == Socket::EAI_NONAME || $errno == Socket::EAI_NODATA, '->failure [3] gives EAI_NONAME or EAI_NODATA' ) or + ok( $errno == Socket::EAI_FAIL || $errno == Socket::EAI_AGAIN || # no server available + $errno == Socket::EAI_NONAME || $errno == Socket::EAI_NODATA, # server confirmed no DNS entry + '->failure [3] gives EAI_FAIL or EAI_AGAIN or EAI_NONAME or EAI_NODATA' ) or diag( '$errno is ' . $errno ); } |