1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More;
7use IO::Async::Test;
8use IO::Async::Loop;
9
10use Net::Async::HTTP;
11
12eval {
13   require IO::Async::SSL;
14   IO::Async::SSL->VERSION( '0.12' );
15} or plan skip_all => "No IO::Async::SSL";
16
17my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
18
19my $loop = IO::Async::Loop->new();
20testing_loop( $loop );
21
22my $http = Net::Async::HTTP->new(
23   user_agent => "", # Don't put one in request headers
24);
25
26$loop->add( $http );
27
28my $redir_url;
29
30my $port;
31$loop->SSL_listen(
32   host    => "127.0.0.1",
33   service => 0,
34   socktype => "stream",
35
36   SSL_key_file  => "t/privkey.pem",
37   SSL_cert_file => "t/server.pem",
38
39   on_listen => sub {
40      $port = shift->sockport;
41   },
42
43   on_stream => sub {
44      my ( $stream ) = @_;
45
46      $stream->configure(
47         on_read => sub {
48            my ( $self, $buffref ) = @_;
49            return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s;
50
51            my $header = $1;
52
53            my $response = ( $header =~ m{^GET /redir} )
54               ? "HTTP/1.1 301 Moved Permanently$CRLF" .
55                 "Content-Length: 0$CRLF" .
56                 "Location: $redir_url$CRLF" .
57                 "Connection: Keep-Alive$CRLF" .
58                 "$CRLF"
59               : "HTTP/1.1 200 OK$CRLF" .
60                 "Content-Type: text/plain$CRLF" .
61                 "Content-Length: 2$CRLF" .
62                 "Connection: Keep-Alive$CRLF" .
63                 "$CRLF" .
64                 "OK";
65
66            $self->write( $response );
67
68            return 1;
69         },
70      );
71
72      $loop->add( $stream );
73   },
74
75   on_listen_error => sub { die "Test failed early - $_[-1]" },
76   on_resolve_error => sub { die "Test failed early - $_[-1]" },
77   on_ssl_error     => sub { die "Test failed early - $_[-1]" },
78);
79
80wait_for { defined $port };
81
82$redir_url = "https://127.0.0.1:$port/moved";
83
84my $response;
85
86$http->do_request(
87   uri => URI->new( "https://127.0.0.1:$port/redir" ),
88
89   SSL_verify_mode => 0,
90
91   on_response => sub {
92      $response = $_[0];
93   },
94
95   on_error => sub { die "Test failed early - $_[-1]" },
96);
97
98wait_for { defined $response };
99
100is( $response->content_type, "text/plain", '$response->content_type' );
101is( $response->content, "OK", '$response->content' );
102
103# require_SSL
104{
105   $http->configure( require_SSL => 1 );
106
107   $redir_url = "http://127.0.0.1:$port/moved_to_plaintext";
108
109   my $f = $http->GET( "https://127.0.0.1:$port/redir" );
110
111   wait_for_future( $f );
112
113   ok( $f->failure, '->GET on http with require_SSL fails' );
114   like( scalar $f->failure, qr/require_SSL/, 'require_SSL failure' );
115}
116
117done_testing;
118