import version 1.04

1 files changed, 298 insertions, 0 deletions

diff --git a/t/00-all.t b/t/00-all.t
new file mode 100755
index 0000000..eddfb7c
--- /dev/null
+++ b/t/00-all.t
@@ -0,0 +1,298 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use LWPx::ParanoidAgent;
+use Time::HiRes qw(time);
+use Test::More tests => 29;
+use Net::DNS;
+use IO::Socket::INET;
+
+my ($t1, $td);
+my $delta = sub { printf " %.03f secs\n", $td; };
+
+my $ua = LWPx::ParanoidAgent->new;
+ok((ref $ua) =~ /LWPx::ParanoidAgent/);
+
+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);
+
+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/);
+
+# 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.  bradfitz.com isn't blocked
+$res = $ua->get("http://bradfitz.com/");
+print $res->status_line, "\n";
+ok(  $res->is_success);
+
+# SSL should still work, assuming it would work before.
+SKIP:
+{
+    my $has_ssleay = eval { require Crypt::SSLeay; 1;   };
+    my $has_iossl  = eval { require IO::Socket::SSL; 1; };
+
+    skip "Crypt::SSLeay or IO::Socket::SSL not installed", 1 unless $has_ssleay || $has_iossl;
+
+    $res = $ua->get("https://pause.perl.org/pause/query");
+    ok(  $res->is_success && $res->content =~ /Login|PAUSE|Edit/);
+}
+
+# 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);
+
+# redirect with tarpitting
+print "4 second redirect tarpit (tolerance 2)...\n";
+$ua->timeout(2);
+$res = $ua->get("$HELPER_SERVER/redir-4/http://www.danga.com/");
+ok(! $res->is_success);
+
+# lots of slow redirects adding up to a lot of time
+print "Three 1-second redirect tarpits (tolerance 2)...\n";
+$ua->timeout(2);
+$t1 = time();
+$res = $ua->get("$HELPER_SERVER/redir-1/$HELPER_SERVER/redir-1/$HELPER_SERVER/redir-1/http://www.danga.com/");
+$td = time() - $t1;
+$delta->();
+ok($td < 2.5);
+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");
+
+# dying in a tarpit
+print "5 second tarpit (tolerance 2)...\n";
+$ua->timeout(2);
+$res = $ua->get("$HELPER_SERVER/1.5");
+ok(!  $res->is_success);
+
+# making it out of a tarpit.
+print "3 second tarpit (tolerance 4)...\n";
+$ua->timeout(4);
+$res = $ua->get("$HELPER_SERVER/1.3");
+ok(  $res->is_success);
+
+kill 9, $child_pid;
+
+
+sub web_server_mode {
+    my $ssock = IO::Socket::INET->new(Listen    => 5,
+                                      LocalAddr => $HELPER_IP,
+                                      LocalPort => $HELPER_PORT,
+                                      ReuseAddr => 1,
+                                      Proto     => 'tcp')
+        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;