1use strict; 2use warnings; 3use HTTP::Request (); 4use LWP::UserAgent (); 5use Test::More; 6 7# Prevent environment from interfering with test: 8delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}; 9delete $ENV{HTTPS_CA_FILE}; 10delete $ENV{HTTPS_CA_DIR}; 11delete $ENV{PERL_LWP_SSL_CA_FILE}; 12delete $ENV{PERL_LWP_SSL_CA_PATH}; 13delete $ENV{PERL_LWP_ENV_PROXY}; 14 15subtest 'proxy settings from the constructor' => sub { 16 plan tests => 4; 17 18 my $ua = LWP::UserAgent->new( 19 proxy => [ 20 ftp => 'http://www.sol.no', 21 ['http', 'https'] => 'http://www.sol2.no', 22 ], 23 no_proxy => ['test.com'], 24 ); 25 26 is($ua->proxy('ftp'), 'http://www.sol.no', q{$ua->proxy("ftp")}); 27 28 is($ua->proxy($_), 'http://www.sol2.no', qq{\$ua->proxy("$_)}) 29 for qw( http https ); 30 31 is_deeply($ua->{no_proxy}, ['test.com'], q{no_proxy set to ['test.com']}); 32}; 33 34my $ua = LWP::UserAgent->new; 35 36my $clone = $ua->clone; 37 38like($ua->agent, qr/^libwww-perl/, '$ua->agent'); 39ok(!defined $ua->proxy(ftp => "http://www.sol.no"), '$ua->proxy(ftp => "http://www.sol.no")'); 40is($ua->proxy("ftp"), "http://www.sol.no", '$ua->proxy("ftp")'); 41 42my @a = $ua->proxy([qw(ftp http wais)], "http://proxy.foo.com"); 43for (@a) { $_ = "undef" unless defined; } 44 45is("@a", "http://www.sol.no undef undef", '$ua->proxy([qw(ftp http wais)], "http://proxy.foo.com")'); 46is($ua->proxy("http"), "http://proxy.foo.com", '$ua->proxy("http")'); 47is(ref($ua->default_headers), "HTTP::Headers", 'ref($ua->default_headers)'); 48 49$ua->default_header("Foo" => "bar", "Multi" => [1, 2]); 50is($ua->default_headers->header("Foo"), "bar", '$ua->default_headers->header("Foo")'); 51is($ua->default_header("Foo"), "bar", '$ua->default_header("Foo")'); 52 53# error on malformed request 54{ 55 my $req = HTTP::Request->new('', 'unknown:www.example.com'); 56 my $res = $ua->simple_request($req); 57 like($res->content(), qr/Method missing/, "simple_request: Method Missing: invalid request"); 58 59 $req = HTTP::Request->new('HAHAHA', 'unknown:www.example.com'); 60 $res = $ua->simple_request($req); 61 like($res->content(), qr/Protocol scheme 'unknown'/, "simple_request: Invalid Protocol: invalid request"); 62 63 $req = HTTP::Request->new('HAHAHA', 'www.example.com'); 64 $res = $ua->simple_request($req); 65 like($res->content(), qr/URL must be absolute/, "simple_request: Invalid Scheme: invalid request"); 66} 67 68# Try it 69$ua->proxy(http => "loopback:"); 70$ua->agent("foo/0.1"); 71is($ua->get("http://www.example.com", x => "y")->content, <<EOT , "Full \$ua->get->content"); 72GET http://www.example.com 73User-Agent: foo/0.1 74Foo: bar 75Multi: 1 76Multi: 2 77X: y 78 79EOT 80 81ok($ua->post("http://www.example.com", {x => "y", f => "ff"})->content, <<EOT); 82POST http://www.example.com 83User-Agent: foo/0.1 84Content-Length: 8 85Content-Type: application/x-www-form-urlencoded 86Foo: bar 87Multi: 1 88Multi: 2 89 90x=y&f=ff 91EOT 92 93ok($ua->put("http://www.example.com", [x => "y", f => "ff"])->content, <<EOT); 94PUT http://www.example.com 95User-Agent: foo/0.1 96Content-Length: 8 97Content-Type: application/x-www-form-urlencoded 98Foo: bar 99Multi: 1 100Multi: 2 101 102x=y&f=ff 103EOT 104 105ok($ua->patch("http://www.example.com", [x => "y", f => "ff"])->content, <<EOT); 106PATCH http://www.example.com 107User-Agent: foo/0.1 108Content-Length: 8 109Content-Type: application/x-www-form-urlencoded 110Foo: bar 111Multi: 1 112Multi: 2 113x=y&f=ff 114EOT 115 116is(ref($clone->{proxy}), 'HASH', 'ref($clone->{proxy})'); 117 118is($ua->proxy(http => undef), "loopback:", '$ua->proxy(http => undef)'); 119is($ua->proxy('http'), undef, "\$ua->proxy('http')"); 120 121my $res = $ua->get("data:text/html,%3Chtml%3E%3Chead%3E%3Cmeta%20http-equiv%3D%22Content-Script-Type%22%20content%3D%22text%2Fjavascript%22%3E%3Cmeta%20http-equiv%3D%22Content-Style-Type%22%20content%3D%22text%2Fcss%22%3E%3C%2Fhead%3E%3C%2Fhtml%3E"); 122ok($res->header("Content-Style-Type", "text/css"), '$res->header("Content-Style-Type", "text/css")'); 123ok($res->header("Content-Script-Type", "text/javascript"), '$res->header("Content-Script-Type", "text/javascript")'); 124 125is(join(":", $ua->ssl_opts), "verify_hostname", '$ua->ssl_opts'); 126is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); 127is($ua->ssl_opts("verify_hostname" => 0), 1, '$ua->ssl_opts("verify_hostname" => 0)'); 128is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); 129is($ua->ssl_opts("verify_hostname" => undef), 0, '$ua->ssl_opts("verify_hostname" => undef)'); 130is($ua->ssl_opts("verify_hostname"), undef, '$ua->ssl_opts("verify_hostname")'); 131is(join(":", $ua->ssl_opts), "", '$ua->ssl_opts'); 132 133$ua = LWP::UserAgent->new(ssl_opts => {}); 134is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); 135 136$ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 }); 137is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); 138 139$ua = LWP::UserAgent->new(ssl_opts => { SSL_ca_file => 'cert.dat'}); 140is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); 141is($ua->ssl_opts("SSL_ca_file"), 'cert.dat', '$ua->ssl_opts("SSL_ca_file")'); 142 143$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 1; 144$ua = LWP::UserAgent->new(); 145is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); 146 147$ua = LWP::UserAgent->new(ssl_opts => {}); 148is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); 149 150$ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 }); 151is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); 152 153$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; 154$ua = LWP::UserAgent->new(); 155is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); 156 157$ua = LWP::UserAgent->new(ssl_opts => {}); 158is($ua->ssl_opts("verify_hostname"), 0, '$ua->ssl_opts("verify_hostname")'); 159 160$ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 }); 161is($ua->ssl_opts("verify_hostname"), 1, '$ua->ssl_opts("verify_hostname")'); 162 163delete @ENV{grep /_proxy$/i, keys %ENV}; # clean out any proxy vars 164 165SKIP: { 166 skip 'case insensitive ENV on Windows makes this fail', 3, if $^O eq 'MSWin32'; 167 $ENV{HTTP_PROXY}= "http://example.com"; 168 $ENV{http_proxy}= "http://otherexample.com"; 169 my @warn; 170 local $SIG{__WARN__}= sub { my ($msg)= @_; $msg=~s/ at .*\z//s; push @warn, $msg }; 171 # test that we get "HTTP_PROXY" when it is set and differs from "http_proxy". 172 $ua = LWP::UserAgent->new; 173 is($ua->proxy('http'), undef); 174 $ua = LWP::UserAgent->new(env_proxy => 1); 175 is($ua->proxy('http'), "http://example.com", q{proxy('http') returns URL}); 176 is($warn[0],"Environment contains multiple differing definitions for 'http_proxy'.\n" 177 ."Using value from 'HTTP_PROXY' (http://example.com) and ignoring 'http_proxy' (http://otherexample.com)"); 178} 179 180# test that if only one of the two is set we can handle either. 181for my $type ('http_proxy', 'HTTP_PROXY') { 182 delete $ENV{HTTP_PROXY}; 183 delete $ENV{http_proxy}; 184 $ENV{$type} = "http://example.com"; 185 $ua = LWP::UserAgent->new; 186 is($ua->proxy('http'), undef, q{proxy('http') returns undef} ); 187 $ua = LWP::UserAgent->new(env_proxy => 1); 188 is($ua->proxy('http'), "http://example.com", q{proxy('http') returns URL}); 189} 190 191$ENV{PERL_LWP_ENV_PROXY} = 1; 192$ua = LWP::UserAgent->new(); 193is($ua->proxy('http'), "http://example.com", "\$ua->proxy('http')"); 194$ua = LWP::UserAgent->new(env_proxy => 0); 195is($ua->proxy('http'), undef, "\$ua->proxy('http')"); 196 197$ua = LWP::UserAgent->new(); 198is($ua->conn_cache, undef, "\$ua->conn_cache"); 199$ua = LWP::UserAgent->new(keep_alive => undef); 200is($ua->conn_cache, undef, "\$ua->conn_cache"); 201$ua = LWP::UserAgent->new(keep_alive => 0); 202is($ua->conn_cache, undef, "\$ua->conn_cache"); 203$ua = LWP::UserAgent->new(keep_alive => 1); 204is($ua->conn_cache->total_capacity, 1, "\$ua->conn_cache->total_capacity"); 205 206done_testing(); 207