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