use 5.014;
# Test MUA::Mockable behavior with CONNECT proxies. Heavily based on
# https://metacpan.org/source/SRI/Mojolicious-7.26/t/mojo/websocket_proxy_tls.t
use Test::Most;
use FindBin qw($Bin);
BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
use Mojo::IOLoop;
use Mojo::Server::Daemon;
use Mojo::UserAgent::Mockable;
use Path::Tiny;
my $daemon = get_daemon();
my $port = $daemon->ports->[0];
my $proxy = get_proxy();
my $dir = Path::Tiny->tempdir;
# User agent with valid certificates
my $ua = Mojo::UserAgent::Mockable->new(
ioloop => Mojo::IOLoop->singleton,
ca => qq($Bin/certs/ca.crt),
cert => qq($Bin/certs/client.crt),
key => qq($Bin/certs/client.key),
mode => 'record',
file => qq{$dir/proxy-test.out},
);
my @transactions;
$ua->on(
start => sub {
my $tx = $_[1];
$tx->once( finish => sub { push @transactions, $tx; } );
}
);
# Non-blocking proxy request
$ua->proxy->https("http://foo:bar\@127.0.0.1:$proxy");
my $url = qq{https://127.0.0.1:$port/};
my $tx = $ua->get($url);
my $recorded_number = $tx->res->body;
ok $recorded_number, q{Got a number};
$ua = undef;
my $connect_seen;
for my $tx (@transactions) {
if (sprintf ('%s %s', $tx->req->method, $tx->req->url) eq qq{CONNECT $url}) {
$connect_seen = 1;
}
}
ok $connect_seen, q{Proxy CONNECT request seen};
$ua = Mojo::UserAgent::Mockable->new(
ca => qq($Bin/certs/ca.crt),
cert => qq($Bin/certs/client.crt),
key => qq($Bin/certs/client.key),
mode => 'playback',
file => qq{$dir/proxy-test.out},
);
$ua->server->app->log->level('fatal');
lives_ok { $tx = $ua->get(qq{https://127.0.0.1:$port/}) } q{GET request did not die in playback mode};
my $playback_number = $tx->res->body;
is $playback_number, $recorded_number, q{Number same as recorded};
done_testing;
sub get_daemon {
my $app = Mojolicious->new();
$app->routes->get( '/' => sub { shift->render( text => 1 + int rand(1000) ) } );
$app->log->level('fatal');
# Web server with valid certificates
my $daemon = Mojo::Server::Daemon->new( app => $app, silent => 1 );
my $listen =
'https://127.0.0.1'
. qq{?cert=$Bin/certs/server.crt}
. qq{&key=$Bin/certs/server.key}
. qq{&ca=$Bin/certs/ca.crt};
$daemon->listen( [$listen])->start;
return $daemon;
}
sub get_proxy {
# Connect proxy server for testing
my ( %buffer, $connected, $read, $sent );
my $nf = "HTTP/1.1 501 FOO\x0d\x0a" . "Content-Length: 0\x0d\x0a" . "Connection: close\x0d\x0a\x0d\x0a";
my $ok = "HTTP/1.1 200 OK\x0d\x0aConnection: keep-alive\x0d\x0a\x0d\x0a";
my $dummy = Mojo::IOLoop::Server->generate_port;
my $id = Mojo::IOLoop->server(
{ address => '127.0.0.1' } => sub {
my ( $loop, $stream, $id ) = @_;
# Connection to client
$stream->on(
read => sub {
my ( $stream, $chunk ) = @_;
# Write chunk from client to server
my $server = $buffer{$id}{connection};
# say qq{}, encode_base64($chunk), q{} if $server;
return Mojo::IOLoop->stream($server)->write($chunk) if $server;
# Read connect request from client
my $buffer = $buffer{$id}{client} .= $chunk;
if ( $buffer =~ /\x0d?\x0a\x0d?\x0a$/ ) {
$buffer{$id}{client} = '';
if ( $buffer =~ /CONNECT (\S+):(\d+)?/ ) {
$connected = "$1:$2";
my $fail = $2 == $dummy;
# Connection to server
$buffer{$id}{connection} = Mojo::IOLoop->client(
{ address => $1, port => $fail ? $port : $2 } => sub {
my ( $loop, $err, $stream ) = @_;
# Connection to server failed
if ($err) {
Mojo::IOLoop->remove($id);
return delete $buffer{$id};
}
# Start forwarding data in both directions
Mojo::IOLoop->stream($id)->write( $fail ? $nf : $ok );
$stream->on(
read => sub {
my ( $stream, $chunk ) = @_;
$read += length $chunk;
$sent += length $chunk;
# say qq{}, encode_base64($chunk), q{};
Mojo::IOLoop->stream($id)->write($chunk);
}
);
# Server closed connection
$stream->on(
close => sub {
Mojo::IOLoop->remove($id);
delete $buffer{$id};
}
);
}
);
}
# Invalid request from client
else { Mojo::IOLoop->remove($id) }
}
}
);
# Client closed connection
$stream->on(
close => sub {
my $buffer = delete $buffer{$id};
Mojo::IOLoop->remove( $buffer->{connection} ) if $buffer->{connection};
}
);
}
);
my $proxy = Mojo::IOLoop->acceptor($id)->port;
return $proxy;
}