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