view release on metacpan or search on metacpan
- Fixed POD mistake. (GH PR#338. Sebastian Paaske Tørholm)
6.43 2019-11-26 13:54:43Z
- Continue trying different Authentication challenge schemes if
credentials are wrong (Roman Galeev, Julien Fiegehenn)
6.42 2019-11-20 17:40:52Z
- Add retry handling for a stale nonce with digest authentication (marmotil
and Frank Maas) (GH#40, GH#313, GH#321)
- Add the patch method to LWP::UserAgent. (GH#334) (Chase Whitener)
- Fix docs to match keep_alive => undef behavior, add some trivial tests
(GH#333) (Ville Skyttä)
- Documentation grammar fixes (GH#331) (Ville Skyttä)
6.41 2019-10-28 14:42:06Z
- Allow mirroring to files called '0' (GH#329) (Mark Fowler)
6.40 2019-10-24 12:55:45Z
- Let Digest authentication act on nonce expiry (GH#313) (Frank Maas)
- Make file arg for mirror mandatory #304 (GH#326) (Julien Fiegehenn)
- Doc fix: fields starting with ":" have to be quoted (GH#324) (Slaven
bin/lwp-download view on Meta::CPAN
'a' => \$opt{a},
's' => \$opt{s}
) or HelpMessage();
my $url = URI->new(decode(locale => shift) || HelpMessage());
my $argfile = encode(locale_fs => decode(locale => shift));
HelpMessage() if defined($argfile) && !length($argfile);
my $ua = LWP::UserAgent->new(
agent => "lwp-download/$LWP::UserAgent::VERSION ",
keep_alive => 1,
env_proxy => 1,
);
my $file; # name of file we download into
my $length; # total number of bytes to download
my $flength; # formatted length
my $size = 0; # number of bytes received
my $start_t; # start time of download
my $last_dur; # time of last callback
bin/lwp-dump view on Meta::CPAN
--max-length <n>
--method <str>
--parse-head
--request
EOT
}
my $ua = LWP::UserAgent->new(
parse_head => $opt{'parse-head'} || 0,
keep_alive => 1,
env_proxy => 1,
agent => $opt{agent} || "lwp-dump/$LWP::UserAgent::VERSION ",
);
my $req = HTTP::Request->new($opt{method} || 'GET' => decode(locale => $url));
my $res = $ua->simple_request($req);
$res->remove_header(grep /^Client-/, $res->header_field_names)
unless $opt{'keep-client-headers'}
or ($res->header("Client-Warning") || "") eq "Internal response";
lib/LWP/Authen/Ntlm.pm view on Meta::CPAN
$request, $arg, $size) = @_;
my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
$request->uri, $proxy);
unless(defined $user and defined $pass) {
return $response;
}
if (!$ua->conn_cache()) {
warn "The keep_alive option must be enabled for NTLM authentication to work. NTLM authentication aborted.\n";
return $response;
}
my($domain, $username) = split(/\\/, $user);
ntlm_domain($domain);
ntlm_user($username);
ntlm_password($pass);
my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
lib/LWP/Protocol/http.pm view on Meta::CPAN
if ( ($host =~ /:/) && ($host !~ /^\[/) ) {
$host = "[$host]";
}
local($^W) = 0; # IO::Socket::INET can be noisy
my $sock = $self->socket_class->new(PeerAddr => $host,
PeerPort => $port,
LocalAddr => $self->{ua}{local_address},
Proto => 'tcp',
Timeout => $timeout,
KeepAlive => !!$self->{ua}{conn_cache},
SendTE => $self->{ua}{send_te},
$self->_extra_sock_opts($host, $port),
);
unless ($sock) {
# IO::Socket::INET leaves additional error messages in $@
my $status = "Can't connect to $host:$port";
if ($@ =~ /\bconnect: (.*)/ ||
$@ =~ /\b(Bad hostname)\b/ ||
$@ =~ /\b(nodename nor servname provided, or not known)\b/ ||
lib/LWP/UserAgent.pm view on Meta::CPAN
my $show_progress = delete $cnf{show_progress};
my $max_size = delete $cnf{max_size};
my $max_redirect = delete $cnf{max_redirect};
$max_redirect = 7 unless defined $max_redirect;
my $env_proxy = exists $cnf{env_proxy} ? delete $cnf{env_proxy} : $ENV{PERL_LWP_ENV_PROXY};
my $no_proxy = exists $cnf{no_proxy} ? delete $cnf{no_proxy} : [];
Carp::croak(qq{no_proxy must be an arrayref, not $no_proxy!}) if ref $no_proxy ne 'ARRAY';
my $cookie_jar = delete $cnf{cookie_jar};
my $conn_cache = delete $cnf{conn_cache};
my $keep_alive = delete $cnf{keep_alive};
Carp::croak("Can't mix conn_cache and keep_alive")
if $conn_cache && $keep_alive;
my $protocols_allowed = delete $cnf{protocols_allowed};
my $protocols_forbidden = delete $cnf{protocols_forbidden};
my $requests_redirectable = delete $cnf{requests_redirectable};
$requests_redirectable = ['GET', 'HEAD']
unless defined $requests_redirectable;
my $cookie_jar_class = delete $cnf{cookie_jar_class};
$cookie_jar_class = 'HTTP::Cookies'
and gopher. If it tries accessing any other kind of URL (like an "ftp:"
or "mailto:" or "news:" URL), then it won't actually try connecting, but
instead will immediately return an error code 500, with a message like
"Access to 'ftp' URIs has been disabled".
=item *
C<< use LWP::ConnCache; $browser->conn_cache(LWP::ConnCache->new()); >>
This tells the browser object to try using the HTTP/1.1 "Keep-Alive"
feature, which speeds up requests by reusing the same socket connection
for multiple requests to the same server.
=item *
C<< $browser->agent( 'SomeName/1.23 (more info here maybe)' ) >>
This changes how the browser object will identify itself in
the default "User-Agent" line is its HTTP requests. By default,
t/base/ua.t view on Meta::CPAN
}
$ENV{PERL_LWP_ENV_PROXY} = 1;
$ua = LWP::UserAgent->new();
is($ua->proxy('http'), "http://example.com", "\$ua->proxy('http')");
$ua = LWP::UserAgent->new(env_proxy => 0);
is($ua->proxy('http'), undef, "\$ua->proxy('http')");
$ua = LWP::UserAgent->new();
is($ua->conn_cache, undef, "\$ua->conn_cache");
$ua = LWP::UserAgent->new(keep_alive => undef);
is($ua->conn_cache, undef, "\$ua->conn_cache");
$ua = LWP::UserAgent->new(keep_alive => 0);
is($ua->conn_cache, undef, "\$ua->conn_cache");
$ua = LWP::UserAgent->new(keep_alive => 1);
is($ua->conn_cache->total_capacity, 1, "\$ua->conn_cache->total_capacity");
done_testing();
t/local/httpsub.t view on Meta::CPAN
use Test::More;
use HTTP::Request ();
use LWP::UserAgent ();
use LWP::Protocol ();
plan tests => 2;
LWP::Protocol::implementor(http => 'myhttp');
my $ua = LWP::UserAgent->new(keep_alive => 1);
$ua->proxy('http' => "http://proxy.activestate.com");
my $req = HTTP::Request->new(GET => 'http://gisle:aas@www.activestate.com');
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'activeState: got a response');
ok($res->as_string, 'activeState: has content');
exit;
{
xt/author/live/jigsaw/auth-b.t view on Meta::CPAN
my @try = (['foo', 'bar'], ['', ''], ['guest', ''], ['guest', 'guest']);
sub get_basic_credentials {
my ($self, $realm, $uri, $proxy) = @_;
my $p = shift @try;
return @$p;
}
}
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $req = HTTP::Request->new(GET => "https://jigsaw.w3.org/HTTP/Basic/");
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
is($res->code, 401, 'Got a 401 response');
$req->authorization_basic('guest', 'guest');
is($req->authorization_basic(), 'guest:guest', 'authorization_basic: set properly');
$res = $ua->simple_request($req);
isa_ok($res, 'HTTP::Response', 'simple_request: Got a proper response');
is($res->code, 200, '200 response with basic auth');
like($res->content, qr/Your browser made it!/, 'good content with basic auth');
$ua = MyUA->new(keep_alive => 1);
$req = HTTP::Request->new(GET => "https://jigsaw.w3.org/HTTP/Basic/");
$res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
like($res->content, qr/Your browser made it!/, 'good content');
is($res->header("Client-Response-Num"), 5, 'Client-Response-Num is 5');
xt/author/live/jigsaw/auth-d.t view on Meta::CPAN
sub get_basic_credentials {
my ($self, $realm, $uri, $proxy) = @_;
my $p = shift @try;
return @$p;
}
}
SKIP: {
skip 'LIVE_JIGSAW_TESTS not enabled', 3 if $ENV{NO_JIGSAW};
my $ua = MyUA->new(keep_alive => 1);
my $req = HTTP::Request->new(GET => "https://jigsaw.w3.org/HTTP/Digest/");
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
like($res->content, qr/Your browser made it!/, 'Proper response content');
is($res->header("Client-Response-Num"), 5, 'Client-Response-Num is 5');
}
xt/author/live/jigsaw/chunk.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use Test::RequiresInternet ('jigsaw.w3.org' => 443);
use HTTP::Request ();
use LWP::UserAgent ();
plan tests => 8;
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $req = HTTP::Request->new(GET => "https://jigsaw.w3.org/HTTP/ChunkedScript");
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
ok($res->is_success, 'response success');
is($res->content_type, 'text/plain', 'Content-Type: text/plain');
is($res->header('Client-Transfer-Encoding'), "chunked", 'Client-Transfer-Encoding: chunked');
for my $cref ( ${$res->content_ref} ) {
xt/author/live/jigsaw/md5-get.t view on Meta::CPAN
use Test::RequiresInternet ('jigsaw.w3.org' => 443);
use Digest::MD5 qw( md5_base64 );
use LWP::UserAgent ();
my $tests = 5;
plan tests => $tests;
SKIP: {
skip 'LIVE_JIGSAW_TESTS not enabled', $tests if $ENV{NO_JIGSAW};
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $res = $ua->get(
"https://jigsaw.w3.org/HTTP/h-content-md5.html",
"TE" => "deflate",
);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
is($res->header('Content-MD5'), md5_base64($res->content).'==', 'Content-MD5 header matches content');
my $etag = $res->header("etag");
$res = $ua->get(
xt/author/live/jigsaw/md5.t view on Meta::CPAN
use HTTP::Request ();
use LWP::UserAgent ();
my $tests = 5;
plan tests => $tests;
SKIP: {
skip 'LIVE_JIGSAW_TESTS not enabled', $tests if $ENV{NO_JIGSAW};
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $req = HTTP::Request->new(GET => "https://jigsaw.w3.org/HTTP/h-content-md5.html");
$req->header("TE", "deflate");
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
is($res->header('Content-MD5'), md5_base64($res->content).'==', 'Content-MD5 header matches content');
my $etag = $res->header("etag");
xt/author/live/jigsaw/neg-get.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use Test::RequiresInternet ('jigsaw.w3.org' => 443);
use LWP::UserAgent ();
plan tests => 2;
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $res = $ua->get(
"https://jigsaw.w3.org/HTTP/neg",
Connection => "close",
);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
is($res->code, 300, 'response code: 300');
xt/author/live/jigsaw/neg.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use Test::RequiresInternet ('jigsaw.w3.org' => 443);
use HTTP::Request ();
use LWP::UserAgent ();
plan tests => 2;
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $req = HTTP::Request->new(GET => "https://jigsaw.w3.org/HTTP/neg");
$req->header(Connection => "close");
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
is($res->code, 300, 'response code: 300');
xt/author/live/jigsaw/redirect-post.t view on Meta::CPAN
use Test::More;
use Test::RequiresInternet ('jigsaw.w3.org' => 443);
use HTTP::Request ();
use LWP::UserAgent ();
use JSON::PP qw( encode_json );
use Encode qw( encode_utf8 );
plan tests => 10;
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $data = {foo => 'bar', baz => 'quux'};
my $encoded_data = encode_utf8(encode_json($data));
# 307 not redirectable.
my $req = HTTP::Request->new('POST', "https://jigsaw.w3.org/HTTP/300/Go_307", undef, undef);
my $res = $ua->request($req);
isa_ok($res, 'HTTP::Response', 'request: Got a proper response');
is($res->code, 307, 'Got a 307 response');
xt/author/live/jigsaw/te.t view on Meta::CPAN
use warnings;
use Test::More;
use Test::RequiresInternet ('jigsaw.w3.org' => 443);
use HTTP::Request ();
use LWP::UserAgent ();
SKIP: {
skip 'LIVE_JIGSAW_TESTS not enabled', 3 if $ENV{NO_JIGSAW};
my $ua = LWP::UserAgent->new(keep_alive => 1);
my $content;
my @te = (
undef, q{}, 'deflate', 'gzip', 'trailers, deflate;q=0.4, identity;q=0.1',
);
for my $te (@te) {
my $req
= HTTP::Request->new(GET => 'https://jigsaw.w3.org/HTTP/TE/foo.txt');
xt/author/net/cache-timeouts.t view on Meta::CPAN
my $timeout_script = ($net::cgidir || '') . '/timeout';
note 'This script tests whether the timeout used for cached connections';
note 'respects the timeout of the user agent.';
note '';
note 'Case one: Does timeout get set?';
note 'Case two: User agent changes its timeout';
note 'Case three: Multiple user agents share the same cache';
note 'Case four: Check that timeout was applied';
my $request = HTTP::Request->new('GET', "http://$netloc$script", [ 'Connection' => 'Keep-Alive' ]);
$ua->timeout(10);
$ua2->timeout(12);
# First we have to do a test hit.
my $response = $ua->request($request);
if (! $response->is_success) {
plan skip_all => "Target webserver http://$netloc is down";
exit 0;
}
elsif ($response->header('Connection') !~ m/keep-alive/i) {
plan skip_all => 'To run this test, the target webserver must support persistent connections.';
exit 0;
}
plan tests => 8;
note 'Case one: Does timeout get set?';
my @connections = $cache->get_connections();
is(scalar @connections, 1, "One connection cached");
ok( $connections[0] && $connections[0]->timeout() == 10,
view all matches for this distributionview release on metacpan - search on metacpan