[Bps-public-commit] LWP-UserAgent-Paranoid branch, master, updated. 0.96-5-g29c9160
Alex Vandiver
alexmv at bestpractical.com
Tue Mar 17 02:02:22 EDT 2015
The branch, master has been updated
via 29c916056cbdd94d5c2a72df0d27b1996bdd8190 (commit)
via 7db21f19e464ec9313aacdec73eaa9c7e014731d (commit)
via d6508db1d1a888a2f8f7fcd952b75bf0b4dc5c34 (commit)
via c66b3313e303be4b170ca17950769ad1017acf34 (commit)
via 16b58175b1548187a1e50ce1a8248e1264eb2ef7 (commit)
from 26216dad8cd8e77ea68f894879bdc1569105f7e1 (commit)
Summary of changes:
Changes | 7 +
MANIFEST | 4 +
META.yml | 6 +-
README | 22 ++-
inc/Module/Install.pm | 22 +--
inc/Module/Install/Base.pm | 2 +-
inc/Module/Install/Can.pm | 2 +-
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Makefile.pm | 4 +-
inc/Module/Install/Metadata.pm | 6 +-
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 2 +-
lib/LWP/UserAgent/Paranoid.pm | 39 +++--
lib/LWP/UserAgent/Paranoid/Compat.pm | 98 +++++++++++++
t/compat/00-all.t | 268 +++++++++++++++++++++++++++++++++++
t/compat/40-largefiles.t | 33 +++++
t/compat/40-slowserver.t | 82 +++++++++++
17 files changed, 566 insertions(+), 35 deletions(-)
create mode 100644 lib/LWP/UserAgent/Paranoid/Compat.pm
create mode 100755 t/compat/00-all.t
create mode 100644 t/compat/40-largefiles.t
create mode 100644 t/compat/40-slowserver.t
- Log -----------------------------------------------------------------
commit 16b58175b1548187a1e50ce1a8248e1264eb2ef7
Author: Thomas Sibley <tsibley at cpan.org>
Date: Sat Jun 21 16:28:39 2014 -0700
Update copyright statement to include new code since version 0.94
diff --git a/README b/README
index 804ba2b..9a676ed 100644
--- a/README
+++ b/README
@@ -86,7 +86,8 @@ AUTHOR
Thomas Sibley <tsibley at cpan.org>
LICENSE AND COPYRIGHT
- This software is Copyright (c) 2013 by Best Practical Solutions
+ This software is primarily Copyright (c) 2013 by Best Practical
+ Solutions, with parts of it Copyright (c) 2014 by Thomas Sibley.
This is free software, licensed under:
diff --git a/lib/LWP/UserAgent/Paranoid.pm b/lib/LWP/UserAgent/Paranoid.pm
index 1a8895f..d489ef9 100644
--- a/lib/LWP/UserAgent/Paranoid.pm
+++ b/lib/LWP/UserAgent/Paranoid.pm
@@ -173,7 +173,8 @@ Thomas Sibley <tsibley at cpan.org>
=head1 LICENSE AND COPYRIGHT
-This software is Copyright (c) 2013 by Best Practical Solutions
+This software is primarily Copyright (c) 2013 by Best Practical Solutions,
+with parts of it Copyright (c) 2014-2015 by Thomas Sibley.
This is free software, licensed under:
commit c66b3313e303be4b170ca17950769ad1017acf34
Author: Thomas Sibley <tsibley at cpan.org>
Date: Sat Jun 21 16:29:18 2014 -0700
blocked_hosts and whitelisted_hosts methods a la LWPx::ParanoidAgent
No reason we shouldn't proxy these methods to the resolver for an easier
API.
diff --git a/lib/LWP/UserAgent/Paranoid.pm b/lib/LWP/UserAgent/Paranoid.pm
index d489ef9..99bac99 100644
--- a/lib/LWP/UserAgent/Paranoid.pm
+++ b/lib/LWP/UserAgent/Paranoid.pm
@@ -30,7 +30,7 @@ use Carp qw//;
my $response = $ua->get("http://example.com");
# allow requests to localhost and 127.0.0.1
- $ua->resolver->whitelisted_hosts(['localhost', '127.0.0.1']);
+ $ua->whitelisted_hosts('localhost', '127.0.0.1');
=head1 DESCRIPTION
@@ -52,7 +52,12 @@ stalling redirects. The default is 5 seconds.
All new agents are automatically made paranoid of private hostnames and IP
address ranges using L<LWPx::ParanoidHandler>. You may access the
L<Net::DNS::Paranoid> resolver via the L</resolver> method in order to
-customize the blocked or whitelisted hosts.
+customize its behaviour.
+
+For simple whitelisting and blacklisting, you may call L</whitelisted_hosts> or
+L</blocked_hosts>. These methods are proxied to the corresponding methods
+of L<Net::DNS::Paranoid>. The only difference is that you may pass a list to
+this class' methods.
=head1 EVEN MORE PARANOIA
@@ -96,8 +101,14 @@ need to set your own but if you do it should be an L<Net::DNS::Paranoid>
object. This attribute is read-only, so if you want to replace the resolver
you need to call L</new> again to create a new L<LWP::UserAgent::Paranoid>.
-Use the blocking and whitelisting methods on the resolver to customize the
-behaviour.
+Use the blocking and whitelisting methods on the resolver, or this class'
+L</whitelisted_hosts> and L</blocked_hosts>, to customize the behaviour.
+
+=head2 whitelisted_hosts / blocked_hosts
+
+Accepts a single arrayref and proxies to the method of the same name on the
+L</resolver>. For convenience, you may pass a list which will be passed as an
+arrayref to the resolver's method.
=cut
@@ -110,6 +121,11 @@ sub new {
my $resolver = delete $opts{resolver};
$resolver = Net::DNS::Paranoid->new unless $resolver;
+ for my $acl (qw(blocked_hosts whitelisted_hosts)) {
+ next unless $opts{$acl};
+ $resolver->$acl( delete $opts{$acl} );
+ }
+
my $self = $class->SUPER::new(%opts);
$self->request_timeout($timeout);
$self->_elem("resolver", $resolver);
@@ -127,6 +143,9 @@ sub resolver {
return $self->_elem("resolver");
}
+sub blocked_hosts { shift->resolver->blocked_hosts(ref $_[0] ? $_[0] : \@_) }
+sub whitelisted_hosts { shift->resolver->whitelisted_hosts(ref $_[0] ? $_[0] : \@_) }
+
sub __timed_out { Carp::croak("Client timed out request") }
sub __with_timeout {
my $method = shift;
commit d6508db1d1a888a2f8f7fcd952b75bf0b4dc5c34
Author: Thomas Sibley <tsibley at cpan.org>
Date: Mon Mar 16 20:15:29 2015 -0700
Always access our paranoid resolver via a private method
This allows the public resolver method to change in subclasses.
diff --git a/lib/LWP/UserAgent/Paranoid.pm b/lib/LWP/UserAgent/Paranoid.pm
index 99bac99..5dbda87 100644
--- a/lib/LWP/UserAgent/Paranoid.pm
+++ b/lib/LWP/UserAgent/Paranoid.pm
@@ -130,7 +130,7 @@ sub new {
$self->request_timeout($timeout);
$self->_elem("resolver", $resolver);
- LWPx::ParanoidHandler::make_paranoid($self, $self->resolver);
+ LWPx::ParanoidHandler::make_paranoid($self, $self->_resolver);
return $self;
}
@@ -140,11 +140,14 @@ sub resolver {
my $self = shift;
Carp::croak("resolver is read-only; to use a new resolver, create a new user agent")
if @_;
- return $self->_elem("resolver");
+ return $self->_resolver;
+}
+sub _resolver {
+ shift->_elem("resolver");
}
-sub blocked_hosts { shift->resolver->blocked_hosts(ref $_[0] ? $_[0] : \@_) }
-sub whitelisted_hosts { shift->resolver->whitelisted_hosts(ref $_[0] ? $_[0] : \@_) }
+sub blocked_hosts { shift->_resolver->blocked_hosts(ref $_[0] ? $_[0] : \@_) }
+sub whitelisted_hosts { shift->_resolver->whitelisted_hosts(ref $_[0] ? $_[0] : \@_) }
sub __timed_out { Carp::croak("Client timed out request") }
sub __with_timeout {
commit 7db21f19e464ec9313aacdec73eaa9c7e014731d
Author: Thomas Sibley <tsibley at cpan.org>
Date: Sat Aug 9 11:54:25 2014 -0700
LWPx::ParanoidAgent compatibility class
t/compat/ is imported from LWPx-ParanoidAgent and only slightly modified
to accommodate our testing infrastructure. 30-mirror.t was dropped
because of dubious usefulness/correctness. I suspect it hasn't been run
against LWPx-ParanoidAgent in quite a while since there are a number of
manual hoops to jump through to do so. Even if it had, it doesn't seem
to produce the correct result anymore (is_success is not true, as the
response is a "500 read timeout").
t/compat/ is additionally marked for release testing only.
All tests pass for me when running:
env RELEASE_TESTING=1 prove -wlvr t/
diff --git a/lib/LWP/UserAgent/Paranoid/Compat.pm b/lib/LWP/UserAgent/Paranoid/Compat.pm
new file mode 100644
index 0000000..2da6694
--- /dev/null
+++ b/lib/LWP/UserAgent/Paranoid/Compat.pm
@@ -0,0 +1,98 @@
+use strict;
+use warnings;
+no warnings "void";
+
+=head1 NAME
+
+LWP::UserAgent::Paranoid::Compat - LWP::UserAgent::Paranoid drop-in replacement
+for LWPx::ParanoidAgent
+
+=cut
+
+package LWP::UserAgent::Paranoid::Compat;
+use base 'LWP::UserAgent::Paranoid';
+
+=head1 SYNOPSIS
+
+ use LWP::UserAgent::Paranoid::Compat;
+ my $ua = LWP::UserAgent::Paranoid::Compat->new;
+
+ # use $ua the same as LWPx::ParanoidAgent...
+
+=head1 DESCRIPTION
+
+This class is a subclass of L<LWP::UserAgent::Paranoid> and changes the default
+behaviour and interface to match L<LWPx::ParanoidAgent> as closely as possible.
+
+=head2 Differences from L<LWP::UserAgent::Paranoid>
+
+=over
+
+=item * Only HTTP and HTTPS are allowed
+
+=item * Timeout is 15s by default
+
+=item * A C<timeout> constructor param and L</timeout> method are available
+
+=item * The L</resolver> method gets/sets the underlying resolver used by an
+L<Net::DNS::Paranoid> instance instead of acting as the getter of the
+L<Net::DNS::Paranoid> instance itself. The C<resolver> constructor param
+follows suite.
+
+=back
+
+=cut
+
+sub new {
+ my ($class, %opts) = @_;
+
+ # LWPx::ParanoidAgent uses 'timeout' instead of a separate
+ # 'request_timeout' and a default of 15s instead of 5s.
+ $opts{timeout} ||= 15;
+ $opts{request_timeout} ||= $opts{timeout};
+
+ # Resolver is used to set the Net::DNS::Paranoid resolver
+ my $resolver = delete $opts{resolver};
+
+ my $self = $class->SUPER::new(%opts);
+
+ # LWPx::ParanoidAgent limits to http/https by default.
+ $self->protocols_allowed(["http", "https"]);
+ $self->_resolver->resolver($resolver)
+ if $resolver;
+
+ return $self;
+}
+
+sub timeout {
+ my $self = shift;
+ $self->_elem("timeout", @_);
+ $self->request_timeout(@_);
+}
+
+sub resolver {
+ shift->_resolver->resolver(@_);
+}
+
+"The truth is out there.";
+
+=head1 BUGS
+
+All bugs should be reported via
+L<rt.cpan.org|https://rt.cpan.org/Public/Dist/Display.html?Name=LWP-UserAgent-Paranoid>
+or L<bug-LWP-UserAgent-Paranoid at rt.cpan.org>.
+
+=head1 AUTHOR
+
+Thomas Sibley <tsibley at cpan.org>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is primarily Copyright (c) 2013 by Best Practical Solutions,
+with parts of it Copyright (c) 2014-2015 by Thomas Sibley.
+
+This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
+=cut
diff --git a/t/compat/00-all.t b/t/compat/00-all.t
new file mode 100755
index 0000000..a33d033
--- /dev/null
+++ b/t/compat/00-all.t
@@ -0,0 +1,268 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use LWP::UserAgent::Paranoid::Compat;
+use Time::HiRes qw(time);
+use Test::More 'no_plan';
+use Net::DNS;
+use IO::Socket::INET;
+
+my ($t1, $td);
+my $delta = sub { printf " %.03f secs\n", $td; };
+
+my $ua = LWP::UserAgent::Paranoid::Compat->new;
+ok((ref $ua) =~ /LWP::UserAgent::Paranoid::Compat/);
+
+my $mock_resolver = MockResolver->new;
+
+# Record pointing to localhost:
+{
+ my $packet = Net::DNS::Packet->new;
+ $packet->push(answer => Net::DNS::RR->new("localhost-fortest.danga.com. 86400 A 127.0.0.1"));
+ $mock_resolver->set_fake_record("localhost-fortest.danga.com", $packet);
+}
+
+# CNAME to blocked destination:
+{
+ my $packet = Net::DNS::Packet->new;
+ $packet->push(answer => Net::DNS::RR->new("bradlj-fortest.danga.com 300 IN CNAME brad.lj"));
+ $mock_resolver->set_fake_record("bradlj-fortest.danga.com", $packet);
+}
+
+$ua->resolver($mock_resolver);
+
+my ($HELPER_IP, $HELPER_PORT) = ("127.66.74.70", 9001);
+
+unless (bind_local()) {
+ diag "Can't bind to $HELPER_IP. Bailing out";
+ exit;
+}
+
+my $child_pid = fork;
+unless ($child_pid) {
+ web_server_mode();
+}
+END {
+ if ($child_pid) {
+ print STDERR "Killing child pid: $child_pid\n";
+ kill 9, $child_pid;
+ }
+}
+select undef, undef, undef, 0.5;
+
+my $HELPER_SERVER = "http://$HELPER_IP:$HELPER_PORT";
+
+
+$ua->whitelisted_hosts(
+ $HELPER_IP,
+ );
+
+$ua->blocked_hosts(
+ qr/\.lj$/,
+ "1.2.3.6",
+ );
+
+my $res;
+
+# hostnames pointing to internal IPs
+$res = $ua->get("http://localhost-fortest.danga.com/");
+ok(! $res->is_success);
+like($res->status_line, qr/Suspicious DNS results/);
+$ua->resolver(Net::DNS::Resolver->new);
+
+# random IP address forms
+$res = $ua->get("http://0x7f.1/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+$res = $ua->get("http://0x7f.0xffffff/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+$res = $ua->get("http://037777777777/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+$res = $ua->get("http://192.052000001/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+$res = $ua->get("http://0x00.00/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+
+# test the the blocked host above in decimal form is blocked by this non-decimal form:
+$res = $ua->get("http://0x01.02.0x306/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+
+# more blocked spaces
+$res = $ua->get("http://192.0.2.13/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+$res = $ua->get("http://192.88.99.77/");
+ok(! $res->is_success && $res->status_line =~ /blocked/);
+
+if($ENV{ONLINE_TESTS}){
+ # hostnames doing CNAMEs (this one resolves to "brad.lj", which is verboten)
+ my $old_resolver = $ua->resolver;
+ $ua->resolver($mock_resolver);
+ $res = $ua->get("http://bradlj-fortest.danga.com/");
+ ok(! $res->is_success);
+ like($res->status_line, qr/DNS lookup resulted in bad host/);
+ $ua->resolver($old_resolver);
+
+ # black-listed via blocked_hosts
+ $res = $ua->get("http://brad.lj/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # can't do octal in IPs
+ $res = $ua->get("http://012.1.2.1/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # can't do decimal/octal IPs
+ $res = $ua->get("http://167838209/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # checking that port isn't affected
+ $res = $ua->get("http://brad.lj:80/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # this domain is okay.
+ $res = $ua->get("http://google.com");
+ print $res->status_line, "\n";
+ ok($res->is_success);
+
+ # internal. bad. blocked by default by module.
+ $res = $ua->get("http://10.2.3.4/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # okay
+ $res = $ua->get("http://danga.com/temp/");
+ print $res->status_line, "\n";
+ ok( $res->is_success);
+
+ # localhost is blocked, case insensitive
+ $res = $ua->get("http://LOCALhost/temp/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # redirecting to invalid host
+ $res = $ua->get("$HELPER_SERVER/redir/http://10.2.3.4/");
+ print $res->status_line, "\n";
+ ok(! $res->is_success);
+
+ # redirecting a bunch and getting the final good host
+ $res = $ua->get("$HELPER_SERVER/redir/$HELPER_SERVER/redir/$HELPER_SERVER/redir/http://www.danga.com/");
+ ok( $res->is_success && $res->request->uri->host eq "www.danga.com");
+}
+
+kill 9, $child_pid;
+
+sub bind_local {
+ IO::Socket::INET->new(Listen => 5,
+ LocalAddr => $HELPER_IP,
+ LocalPort => $HELPER_PORT,
+ ReuseAddr => 1,
+ Proto => 'tcp')
+}
+
+sub web_server_mode {
+ my $ssock = bind_local
+ or die "Couldn't start webserver: $!\n";
+
+ while (my $csock = $ssock->accept) {
+ exit 0 unless $csock;
+ fork and next;
+
+ my $eat = sub {
+ while (<$csock>) {
+ last if ! $_ || /^\r?\n/;
+ }
+ };
+
+ my $req = <$csock>;
+ print STDERR " ####### GOT REQ: $req" if $ENV{VERBOSE};
+
+ if ($req =~ m!^GET /(\d+)\.(\d+) HTTP/1\.\d+\r?\n?$!) {
+ my ($delay, $count) = ($1, $2);
+ $eat->();
+ print $csock
+ "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\n";
+ for (1..$count) {
+ print $csock "[$_/$count]\n";
+ sleep $delay;
+ }
+ exit 0;
+ }
+
+ if ($req =~ m!^GET /redir/(\S+) HTTP/1\.\d+\r?\n?$!) {
+ my $dest = $1;
+ $eat->();
+ print $csock
+ "HTTP/1.0 302 Found\r\nLocation: $dest\r\nContent-Length: 0\r\n\r\n";
+ exit 0;
+ }
+
+ if ($req =~ m!^GET /redir-(\d+)/(\S+) HTTP/1\.\d+\r?\n?$!) {
+ my $sleep = $1;
+ sleep $sleep;
+ my $dest = $2;
+ $eat->();
+ print $csock
+ "HTTP/1.0 302 Found\r\nLocation: $dest\r\nContent-Length: 0\r\n\r\n";
+ exit 0;
+ }
+
+ print $csock
+ "HTTP/1.0 500 Server Error\r\n" .
+ "Content-Length: 10\r\n\r\n" .
+ "bogus_req\n";
+ exit 0;
+ }
+ exit 0;
+}
+
+package MockResolver;
+use strict;
+use base 'Net::DNS::Resolver';
+
+sub new {
+ my $class = shift;
+ return bless {
+ proxy => Net::DNS::Resolver->new,
+ fake_record => {},
+ }, $class;
+}
+
+sub set_fake_record {
+ my ($self, $host, $packet) = @_;
+ $self->{fake_record}{$host} = $packet;
+}
+
+sub _make_proxy {
+ my $method = shift;
+ return sub {
+ my $self = shift;
+ my $fr = $self->{fake_record};
+ if ($method eq "bgsend" && $fr->{$_[0]}) {
+ $self->{next_fake_packet} = $fr->{$_[0]};
+ Test::More::diag("mock DNS resolver doing fake bgsend() of $_[0]\n")
+ if $ENV{VERBOSE};
+ return "MOCK"; # magic value that'll not be treated as a socket
+ }
+ if ($method eq "bgread" && $_[0] eq "MOCK") {
+ Test::More::diag("mock DNS resolver returning mock packet for bgread.")
+ if $ENV{VERBOSE};
+ return $self->{next_fake_packet};
+ }
+ # No verbose conditional on this one because it shouldn't happen:
+ Test::More::diag("Calling through to Net::DNS::Resolver proxy method '$method'");
+ return $self->{proxy}->$method(@_);
+ };
+}
+
+BEGIN {
+ *search = _make_proxy("search");
+ *query = _make_proxy("query");
+ *send = _make_proxy("send");
+ *bgsend = _make_proxy("bgsend");
+ *bgread = _make_proxy("bgread");
+}
+
+1;
diff --git a/t/compat/40-largefiles.t b/t/compat/40-largefiles.t
new file mode 100644
index 0000000..7ed23c8
--- /dev/null
+++ b/t/compat/40-largefiles.t
@@ -0,0 +1,33 @@
+BEGIN {
+ unless ($ENV{RELEASE_TESTING} || $ENV{ONLINE_TESTS}) {
+ require Test::More;
+ Test::More::plan(skip_all=>'these online tests require env variable ONLINE_TESTS (or RELEASE_TESTING) be set to run');
+ }
+}
+
+use Test::More;
+
+use LWP::UserAgent::Paranoid::Compat;
+
+my @urls = qw(
+ https://raw.github.com/csirtgadgets/LWPx-ParanoidAgent/master/testdata/small.txt
+ https://raw.github.com/csirtgadgets/LWPx-ParanoidAgent/master/testdata/512.txt
+ https://raw.github.com/csirtgadgets/LWPx-ParanoidAgent/master/testdata/19200.txt
+ https://raw.github.com/csirtgadgets/LWPx-ParanoidAgent/master/testdata/20480.txt
+ https://raw.github.com/csirtgadgets/LWPx-ParanoidAgent/master/testdata/40960.txt
+);
+
+my $ua = LWP::UserAgent::Paranoid::Compat->new(
+ ssl_opts => {
+ verify_hostname => 0,
+ SSL_verify_mode => 'SSL_VERIFY_NONE',
+ }
+);
+
+foreach my $url (@urls) {
+ my $res=$ua->get($url);
+ ok($res->status_line !~ m/Can't read entity body/);
+ ok($res->is_success());
+}
+
+done_testing();
diff --git a/t/compat/40-slowserver.t b/t/compat/40-slowserver.t
new file mode 100644
index 0000000..1277219
--- /dev/null
+++ b/t/compat/40-slowserver.t
@@ -0,0 +1,82 @@
+BEGIN {
+ use Config;
+ require Test::More;
+
+ Test::More::plan(skip_all => 'not a threaded perl')
+ unless $Config{usethreads};
+
+ unless ($ENV{RELEASE_TESTING} || $ENV{THREAD_TESTS}) {
+ Test::More::plan(skip_all=>'these online tests require env variable THREAD_TESTS (or RELEASE_TESTING) be set to run');
+ }
+}
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use LWP::UserAgent::Paranoid::Compat;
+use IO::Socket;
+use Data::Dumper;
+
+use constant TIMEOUT => 3;
+use constant WAIT => 3;
+
+my ($server, $host, $port) = make_slow_http_server();
+
+my $start = time;
+my $ua = LWP::UserAgent::Paranoid::Compat->new(timeout => TIMEOUT, whitelisted_hosts => [$host]);
+
+print $ua->get("http://$host:$port/")->status_line(), "\n";
+my $elapsed = time - $start;
+
+ok(($elapsed) <= TIMEOUT(), 'testing timeout...');
+warn "TOTAL ELAPSED: ", $elapsed, "\n";
+
+$server->kill(15);
+
+sub make_slow_http_server {
+ use threads;
+
+ my $serv = IO::Socket::INET->new(Listen => 3)
+ or die $@;
+
+ my $thread = threads->create(sub {
+ $SIG{TERM} = sub { threads->exit() };
+
+ while (1) {
+ my $client = $serv->accept()
+ or next;
+
+ my $buf;
+ while (1) {
+ $client->sysread($buf, 1024, length $buf)
+ or last;
+ if (rindex($buf, "\015\012\015\012") != -1) {
+ last;
+ }
+ }
+
+ $client->syswrite(
+ join(
+ "\015\012",
+ "HTTP/1.1 200 OK",
+ "Connection: close",
+ "Content-Type: text/html",
+ "\015\012"
+ )
+ );
+
+ for (1 .. WAIT()) {
+ $client->syswrite(rand);
+ select undef, undef, undef, 1;
+ }
+
+ $client->close();
+ }
+
+ });
+ $thread->detach();
+
+ return ($thread, $serv->sockhost eq "0.0.0.0" ? "127.0.0.1" : $serv->sockhost, $serv->sockport);
+}
commit 29c916056cbdd94d5c2a72df0d27b1996bdd8190
Author: Thomas Sibley <tsibley at cpan.org>
Date: Mon Mar 16 21:47:15 2015 -0700
Releng for 0.97
diff --git a/Changes b/Changes
index 75b4d3c..ad56f90 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,10 @@
+0.97 Mon Mar 16 21:44:36 PDT 2015
+
+ * Add whitelisted_hosts and blocked_hosts methods which proxy to resolver
+
+ * LWP::UserAgent::Paranoid::Compat for drop-in compatibility with
+ LWPx::ParanoidAgent
+
0.96 Sat Aug 9 12:10:11 PDT 2014
* Change resolver to read-only since setting it after ->new doesn't
actually work. The method will now die if called as a setter, which
diff --git a/MANIFEST b/MANIFEST
index feecc14..e28f8ed 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -9,6 +9,7 @@ inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/LWP/UserAgent/Paranoid.pm
+lib/LWP/UserAgent/Paranoid/Compat.pm
lib/LWP/UserAgent/Paranoid/Test.pm
Makefile.PL
MANIFEST This list of files
@@ -17,3 +18,6 @@ META.yml
README
t/alarm.t
t/basic.t
+t/compat/00-all.t
+t/compat/40-largefiles.t
+t/compat/40-slowserver.t
diff --git a/META.yml b/META.yml
index 5c903e7..97bbdf4 100644
--- a/META.yml
+++ b/META.yml
@@ -11,7 +11,7 @@ configure_requires:
ExtUtils::MakeMaker: 6.36
distribution_type: module
dynamic_config: 1
-generated_by: 'Module::Install version 1.08'
+generated_by: 'Module::Install version 1.14'
license: gplv2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -26,8 +26,8 @@ requires:
LWPx::ParanoidHandler: 0
Net::DNS::Paranoid: 0
Scalar::Util: 0
- Time::HiRes: 1.9716
+ Time::HiRes: '1.9716'
resources:
license: http://opensource.org/licenses/gpl-license.php
repository: https://github.com/bestpractical/lwp-useragent-paranoid.git
-version: 0.96
+version: '0.97'
diff --git a/README b/README
index 9a676ed..15525ce 100644
--- a/README
+++ b/README
@@ -12,7 +12,7 @@ SYNOPSIS
my $response = $ua->get("http://example.com");
# allow requests to localhost and 127.0.0.1
- $ua->resolver->whitelisted_hosts(['localhost', '127.0.0.1']);
+ $ua->whitelisted_hosts('localhost', '127.0.0.1');
DESCRIPTION
This module is a more modern LWPx::ParanoidAgent with cleaner internals
@@ -31,7 +31,12 @@ DESCRIPTION
All new agents are automatically made paranoid of private hostnames and
IP address ranges using LWPx::ParanoidHandler. You may access the
Net::DNS::Paranoid resolver via the "resolver" method in order to
- customize the blocked or whitelisted hosts.
+ customize its behaviour.
+
+ For simple whitelisting and blacklisting, you may call
+ "whitelisted_hosts" or "blocked_hosts". These methods are proxied to the
+ corresponding methods of Net::DNS::Paranoid. The only difference is that
+ you may pass a list to this class' methods.
EVEN MORE PARANOIA
You may also wish to tune standard LWP::UserAgent parameters for greater
@@ -69,8 +74,14 @@ METHODS
to replace the resolver you need to call "new" again to create a new
LWP::UserAgent::Paranoid.
- Use the blocking and whitelisting methods on the resolver to customize
- the behaviour.
+ Use the blocking and whitelisting methods on the resolver, or this
+ class' "whitelisted_hosts" and "blocked_hosts", to customize the
+ behaviour.
+
+ whitelisted_hosts / blocked_hosts
+ Accepts a single arrayref and proxies to the method of the same name on
+ the "resolver". For convenience, you may pass a list which will be
+ passed as an arrayref to the resolver's method.
CAVEATS
The overall request timeout is implemented using SIGALRM. Any $SIG{ALRM}
@@ -87,7 +98,7 @@ AUTHOR
LICENSE AND COPYRIGHT
This software is primarily Copyright (c) 2013 by Best Practical
- Solutions, with parts of it Copyright (c) 2014 by Thomas Sibley.
+ Solutions, with parts of it Copyright (c) 2014-2015 by Thomas Sibley.
This is free software, licensed under:
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 7680c84..ff767fa 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,7 +17,7 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-use 5.005;
+use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.08';
+ $VERSION = '1.14';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -156,10 +156,10 @@ END_DIE
sub autoload {
my $self = shift;
my $who = $self->_caller;
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
+ my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
@@ -239,7 +239,7 @@ sub new {
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
@@ -338,7 +338,7 @@ sub find_extensions {
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
- foreach ( split //, $content ) {
+ foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
@@ -378,6 +378,7 @@ eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
@@ -386,6 +387,7 @@ END_NEW
sub _read {
local *FH;
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
@@ -416,6 +418,7 @@ eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
@@ -425,6 +428,7 @@ END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
@@ -434,7 +438,7 @@ END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
-sub _version ($) {
+sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
@@ -450,12 +454,12 @@ sub _version ($) {
return $l + 0;
}
-sub _cmp ($$) {
+sub _cmp {
_version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
+sub _CLASS {
(
defined $_[0]
and
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 3e63345..4206347 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 93f248d..9929b1b 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -8,7 +8,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index ecc0d53..3d8de76 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index c0978a4..66993af 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -133,7 +133,7 @@ sub makemaker_args {
return $args;
}
-# For mm args that take multiple space-seperated args,
+# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index e4112f8..e547fa0 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -347,7 +347,7 @@ sub name_from {
^ \s*
package \s*
([\w:]+)
- \s* ;
+ [\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
@@ -705,7 +705,7 @@ sub _write_mymeta_data {
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
- # Overwrite the non-configure dependency hashs
+ # Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index e529382..9706e5f 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 2c74308..dbedc00 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.08';
+ $VERSION = '1.14';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
diff --git a/lib/LWP/UserAgent/Paranoid.pm b/lib/LWP/UserAgent/Paranoid.pm
index 5dbda87..99b115e 100644
--- a/lib/LWP/UserAgent/Paranoid.pm
+++ b/lib/LWP/UserAgent/Paranoid.pm
@@ -11,7 +11,7 @@ LWP::UserAgent::Paranoid - A modern LWPx::ParanoidAgent for safer requests
package LWP::UserAgent::Paranoid;
use base 'LWP::UserAgent';
-our $VERSION = "0.96";
+our $VERSION = "0.97";
use Scalar::Util qw/ refaddr /;
use Time::HiRes qw/ alarm /;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list