1use strict; 2use warnings; 3use Test::More; 4use Try::Tiny; 5 6# Bail out early if network tests are not requested 7 8BEGIN { 9 my ($filename) = 'test.config'; 10 diag("Reading configuration from '$filename' on $^O"); 11 12 open my $config, '<', $filename 13 or fail("Cannot open '$filename': $!"); 14 15 my $network_tests; 16 17 while (my $entry = <$config>) { 18 19 $entry =~ s/^\s+//; 20 $entry =~ s/\s+\z//; 21 22 my ($key, $val) = split /[ \t]+/, $entry, 2; 23 diag("$key : $val"); 24 25 if ($key eq 'network_tests') { 26 $network_tests = $val; 27 } 28 } 29 30 unless ($network_tests) { 31 plan skip_all => "Network tests disabled"; 32 } 33} 34 35# Make sure prerequisites are there 36 37BEGIN { 38 use_ok('Net::SSL'); 39 use_ok('LWP::UserAgent'); 40 use_ok('LWP::Protocol::https'); 41 use_ok('HTTP::Request'); 42} 43 44use constant METHOD => 'HEAD'; 45use constant URL => 'https://rt.cpan.org/'; 46use constant PROXY_ADDR_PORT => 'localhost:3128'; 47 48test_connect_through_proxy(PROXY_ADDR_PORT); 49 50test_connect(METHOD, URL); 51 52done_testing; 53 54sub test_connect_through_proxy { 55 my ($proxy) = @_; 56 57 my $test_name = 'connect through proxy'; 58 Net::SSL::send_useragent_to_proxy(0); 59 60 my $no_proxy; 61 62 try { 63 live_connect({ chobb => 'schoenmaker'}); 64 } 65 catch { 66 if (/^proxy connect failed: proxy connect to $proxy failed: /) { 67 pass("$test_name - no proxy available"); 68 } 69 else { 70 fail("$test_name - untrapped error"); 71 diag($_); 72 } 73 $no_proxy = 1; 74 }; 75 76 pass($test_name); 77 78 SKIP: { 79 if ($no_proxy) { 80 skip(sprintf('no proxy found at %s', PROXY_ADDR_PORT), 1); 81 } 82 83 Net::SSL::send_useragent_to_proxy(1); 84 85 try { 86 live_connect( {chobb => 'schoenmaker'} ); 87 } 88 catch { 89 TODO: { 90 local $TODO = "caller stack walk broken (CPAN bug #4759)"; 91 is($_, '', "can forward useragent string to proxy"); 92 } 93 }; 94 } 95 96 return; 97} 98 99sub test_connect { 100 my ($method, $url) = @_; 101 102 diag('[RT #73755] Cheat by disabling LWP::UserAgent host verification'); 103 104 my $ua = LWP::UserAgent->new( 105 agent => "Crypt-SSLeay $Crypt::SSLeay::VERSION tester", 106 ssl_opts => { verify_hostname => 0 }, 107 ); 108 109 my $req = HTTP::Request->new; 110 111 $req->method($method); 112 $req->uri($url); 113 114 my $test_name = "$method $url"; 115 my $res; 116 117 try { 118 $res = $ua->request($req); 119 } 120 catch { 121 fail($test_name); 122 diag("Error: '$_'"); 123 }; 124 125 if ($res->is_success) { 126 pass($test_name); 127 } 128 else { 129 fail($test_name); 130 diag("HTTP status = ", $res->status_line); 131 diag("This may not be the fault of the module, $url may be down"); 132 } 133 134 return; 135} 136 137sub live_connect { 138 my $hr = shift; 139 140 local $ENV{HTTPS_PROXY} = PROXY_ADDR_PORT; 141 142 my $socket = Net::SSL->new( 143 PeerAddr => 'rt.cpan.org', 144 PeerPort => 443, 145 Timeout => 10, 146 ); 147 148 return defined $socket; 149} 150 151