On Wed Jun 26 09:05:31 2013, PEVANS wrote:
Show quoted text
The IO::Async::Listener fixes in IO-Async 0.61 have made this possible. This now works.
See updated t/81cross-https.t in this patch.
--
Paul Evans
=== modified file 'Build.PL'
--- Build.PL 2013-03-03 00:31:45 +0000
+++ Build.PL 2014-03-26 17:50:41 +0000
@@ -8,7 +8,7 @@
requires => {
'HTTP::Request' => 0,
'IO::Async' => '0.54',
- 'IO::Async::Listener' => 0,
+ 'IO::Async::Listener' => '0.61',
},
build_requires => {
'HTTP::Response' => 0,
=== modified file 'lib/Net/Async/HTTP/Server.pm'
--- lib/Net/Async/HTTP/Server.pm 2013-12-30 02:43:38 +0000
+++ lib/Net/Async/HTTP/Server.pm 2014-03-26 17:50:41 +0000
@@ -8,6 +8,7 @@
use strict;
use warnings;
use base qw( IO::Async::Listener );
+IO::Async::Listener->VERSION( '0.61' );
our $VERSION = '0.06';
@@ -69,6 +70,16 @@
=cut
+sub _init
+{
+ my $self = shift;
+ my ( $params ) = @_;
+
+ $params->{handle_class} = "Net::Async::HTTP::Server::Protocol";
+
+ $self->SUPER::_init( $params );
+}
+
sub configure
{
my $self = shift;
@@ -90,14 +101,10 @@
$self->SUPER::_add_to_loop( @_ );
}
-sub on_stream
+sub on_accept
{
my $self = shift;
- my ( $stream ) = @_;
-
- my $conn = Net::Async::HTTP::Server::Protocol->new(
- transport => $stream,
- );
+ my ( $conn ) = @_;
$self->add_child( $conn );
=== modified file 'lib/Net/Async/HTTP/Server/Protocol.pm'
--- lib/Net/Async/HTTP/Server/Protocol.pm 2014-01-16 17:26:50 +0000
+++ lib/Net/Async/HTTP/Server/Protocol.pm 2014-03-26 17:50:41 +0000
@@ -1,13 +1,13 @@
# 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, 2013 -- leonerd@leonerd.org.uk
+# (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk
package Net::Async::HTTP::Server::Protocol;
use strict;
use warnings;
-use base qw( IO::Async::Protocol::Stream );
+use base qw( IO::Async::Stream );
our $VERSION = '0.06';
=== modified file 'lib/Net/Async/HTTP/Server/Request.pm'
--- lib/Net/Async/HTTP/Server/Request.pm 2013-12-30 02:43:38 +0000
+++ lib/Net/Async/HTTP/Server/Request.pm 2014-03-26 17:50:41 +0000
@@ -326,7 +326,7 @@
sub stream
{
my $self = shift;
- return $self->{conn}->transport;
+ return $self->{conn};
}
=head1 AUTHOR
=== modified file 't/01respond.t'
--- t/01respond.t 2013-02-21 22:06:29 +0000
+++ t/01respond.t 2014-03-26 17:50:41 +0000
@@ -42,7 +42,7 @@
sub connect_client
{
my ( $S1, $S2 ) = IO::Async::OS->socketpair( undef, "stream" );
- $server->on_stream( IO::Async::Stream->new( handle => $S2 ) );
+ $server->on_accept( Net::Async::HTTP::Server::Protocol->new( handle => $S2 ) );
return $S1;
}
=== modified file 't/02respond-chunked.t'
--- t/02respond-chunked.t 2013-02-16 23:08:03 +0000
+++ t/02respond-chunked.t 2014-03-26 17:50:41 +0000
@@ -27,7 +27,7 @@
sub connect_client
{
my ( $S1, $S2 ) = IO::Async::OS->socketpair( undef, "stream" );
- $server->on_stream( IO::Async::Stream->new( handle => $S2 ) );
+ $server->on_accept( Net::Async::HTTP::Server::Protocol->new( handle => $S2 ) );
return $S1;
}
=== modified file 't/03respond-code.t'
--- t/03respond-code.t 2013-02-16 21:06:25 +0000
+++ t/03respond-code.t 2014-03-26 17:50:41 +0000
@@ -27,7 +27,7 @@
sub connect_client
{
my ( $S1, $S2 ) = IO::Async::OS->socketpair( undef, "stream" );
- $server->on_stream( IO::Async::Stream->new( handle => $S2 ) );
+ $server->on_accept( Net::Async::HTTP::Server::Protocol->new( handle => $S2 ) );
return $S1;
}
=== modified file 't/04close.t'
--- t/04close.t 2013-12-17 20:35:12 +0000
+++ t/04close.t 2014-03-26 17:50:41 +0000
@@ -29,7 +29,7 @@
sub connect_client
{
my ( $S1, $S2 ) = IO::Async::OS->socketpair( undef, "stream" );
- $server->on_stream( IO::Async::Stream->new( handle => $S2 ) );
+ $server->on_accept( Net::Async::HTTP::Server::Protocol->new( handle => $S2 ) );
return $S1;
}
=== modified file 't/10request-HTTP.t'
--- t/10request-HTTP.t 2013-02-15 23:43:58 +0000
+++ t/10request-HTTP.t 2014-03-26 17:50:41 +0000
@@ -28,7 +28,7 @@
sub connect_client
{
my ( $S1, $S2 ) = IO::Async::OS->socketpair( undef, "stream" );
- $server->on_stream( IO::Async::Stream->new( handle => $S2 ) );
+ $server->on_accept( Net::Async::HTTP::Server::Protocol->new( handle => $S2 ) );
return $S1;
}
=== modified file 't/80cross-http.t'
--- t/80cross-http.t 2013-04-26 18:35:11 +0000
+++ t/80cross-http.t 2014-03-26 17:50:41 +0000
@@ -51,10 +51,7 @@
$host = $socket->sockhost;
$port = $socket->sockport;
},
- on_listen_error => sub { die "Cannot listen - $_[-1]\n" },
-);
-
-wait_for { defined $host and defined $port };
+)->get;
my $response;
=== modified file 't/81cross-https.t'
--- t/81cross-https.t 2013-04-26 18:35:11 +0000
+++ t/81cross-https.t 2014-03-26 17:50:41 +0000
@@ -47,11 +47,10 @@
$loop->add( my $client = Net::Async::HTTP->new );
my ( $host, $port );
-# TODO: Make IO::Async::Listener handle SSL extension
-$loop->listen(
+$server->listen(
addr => { family => "inet", socktype => "stream", ip => "127.0.0.1", port => 0 },
on_listen => sub {
- my $socket = $_[0];
+ my $socket = $_[0]->read_handle;
$host = $socket->sockhost;
$port = $socket->sockport;
},
@@ -59,16 +58,7 @@
extensions => [qw( SSL )],
SSL_key_file => "t/privkey.pem",
SSL_cert_file => "t/server.pem",
-
- on_listen_error => sub { die "Cannot listen - $_[-1]\n" },
- on_ssl_error => sub { die "SSL error - $_[-1]\n" },
-
- on_stream => sub {
- $server->on_stream( @_ );
- },
-);
-
-wait_for { defined $host and defined $port };
+)->get;
my $response;
