view release on metacpan or  search on metacpan

t/02-live.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Try::Tiny;

# Bail out early if network tests are not requested

BEGIN {
    my ($filename) = 'test.config';
    diag("Reading configuration from '$filename' on $^O");

    open my $config, '<', $filename
        or fail("Cannot open '$filename': $!");

    my $network_tests;

    while (my $entry = <$config>) {

        $entry =~ s/^\s+//;
        $entry =~ s/\s+\z//;

        my ($key, $val) = split /[ \t]+/, $entry, 2;
        diag("$key : $val");

        if ($key eq 'network_tests') {
            $network_tests = $val;
        }
    }

    unless ($network_tests) {
        plan skip_all => "Network tests disabled";
    }
}

# Make sure prerequisites are there

BEGIN {
    # Make sure LWP uses us even when IO::Socket::SSL
    # is installed.
    $Net::HTTPS::SSL_SOCKET_CLASS = 'Net::SSL';
    use_ok('HTTP::Request');
    use_ok('LWP::UserAgent');
    use_ok('LWP::Protocol::https');
    use_ok('Net::SSL');
}

use constant METHOD => 'HEAD';
use constant URL => 'https://rt.cpan.org/';
use constant PROXY_ADDR_PORT => 'localhost:3128';

test_connect_through_proxy(PROXY_ADDR_PORT);

test_connect(METHOD, URL);

done_testing;

sub test_connect_through_proxy {
    my ($proxy) = @_;

    my $test_name = 'connect through proxy';
    Net::SSL::send_useragent_to_proxy(0);

    my $no_proxy;

    try {
        live_connect({ chobb => 'schoenmaker'});
    }
    catch {
        if (/^proxy connect failed: proxy connect to $proxy failed: /) {
            pass("$test_name - no proxy available");
        }
        else {
            fail("$test_name - untrapped error");
            diag($_);
        }
        $no_proxy = 1;
    };

    pass($test_name);

    SKIP: {
        if ($no_proxy) {
            skip(sprintf('no proxy found at %s', PROXY_ADDR_PORT), 1);
        }

        Net::SSL::send_useragent_to_proxy(1);

        try {
            live_connect( {chobb => 'schoenmaker'} );
        }
        catch {
            TODO: {
                local $TODO = "caller stack walk broken (CPAN bug #4759)";
                is($_, '', "can forward useragent string to proxy");
            }
        };
    }

    return;
}

sub test_connect {
    my ($method, $url) = @_;

    diag('[RT #73755] Cheat by disabling LWP::UserAgent host verification');

    my $ua  = LWP::UserAgent->new(
        agent => "Crypt-SSLeay $Crypt::SSLeay::VERSION tester",
        ssl_opts => { verify_hostname => 0 },
    );

    my $req = HTTP::Request->new;

    $req->method($method);
    $req->uri($url);

    my $test_name = "$method $url";
    my $res;

    try {
        $res = $ua->request($req);
    }
    catch {
        fail($test_name);
        diag("Error: '$_'");
    };

    if ($res->is_success) {
        pass($test_name) if isa_ok(
            $res->header('Client-SSL-Socket-Class'),
            'Net::SSL',
        );
    }
    else {
        fail($test_name);
        diag("HTTP status = ", $res->status_line);
        diag("This may not be the fault of the module, $url may be down");
    }

    return;
}

sub live_connect {
    my $hr = shift;

    local $ENV{HTTPS_PROXY} = PROXY_ADDR_PORT;

    my $socket = Net::SSL->new(
        PeerAddr => 'rt.cpan.org',
        PeerPort => 443,
        Timeout  => 10,
    );

    return defined $socket;
}