libwww-perl

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    - 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'

lwptut.pod  view on Meta::CPAN

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 distribution
 view release on metacpan -  search on metacpan

( run in 1.156 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )