Plack-Middleware-Greylist

 view release on metacpan or  search on metacpan

t/01-greylist.t  view on Meta::CPAN

    # Capture log messages
    enable sub($app) {
        sub($env) {
            $env->{'psgix.logger'} = sub {
                push @logs, $_[0];
            };
            return $app->($env);
        };
    };

    # Trust the "X-Forwarded-For" header
    enable "ReverseProxy";

    enable "Greylist",
      default_rate => 5,
      retry_after  => 120,
      file         => $file,
      cache_config => { init_file => 1, unlink_on_exit => 1 },
      greylist     => \%greylist;

    sub($env) {

t/01-greylist.t  view on Meta::CPAN


subtest "rate limiting (netblock)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        for my $suff ( 1 .. 5 ) {
            my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.${suff}";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.10";
        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs, [ { level => "warn", message => "Rate limiting 172.16.0.10 after 6/5 for 172.16.0.0/24" } ], "logs";

      };

};

subtest "rate limiting (shared blocks)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        for my $suff ( 1 .. 5 ) {
            my $req = HEAD "/", "X-Forwarded-For" => "13.96.0.${suff}";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $req = HEAD "/", "X-Forwarded-For" => "13.104.0.1";
        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs, [ { level => "warn", message => "Rate limiting 13.104.0.1 after 6/5 for 13.104.0.0/14" } ], "logs";

      };

};

subtest "whitelisted" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "172.16.1.1";

        for ( 1 .. 6 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        is \@logs, [], "no warnings logged";

      };

};

subtest "greylist (lower limit)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "107.20.17.110";

        for ( 1 .. 3 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        {
            my $res = $cb->($req);
            is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";
        }

        is \@logs, [ { level => "warn", message => "Rate limiting 107.20.17.110 after 4/3 for 107.20.0.0/14" } ], "logs";

        {
            my $res = $cb->( HEAD "/", "X-Forwarded-For" => "107.20.17.111" );
            is $res->code, HTTP_OK, "request ok (different IP in same block)";
        }

      };

};

subtest "greylist (blocked)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "13.67.224.13";

        for ( 1 .. 2 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_FORBIDDEN, "forbidden";
        }

        is \@logs,
          [
            { level => "warn", message => "Rate limiting 13.67.224.13 after 1/0 for 13.64.0.0/11" },
            { level => "warn", message => "Rate limiting 13.67.224.13 after 2/0 for 13.64.0.0/11" },

t/01-greylist.t  view on Meta::CPAN

};

subtest "greylist (higher limit)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "66.249.64.1";

        for ( 1 .. 10 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs, [ { level => "warn", message => "Rate limiting 66.249.64.1 after 11/10 for 66.249.64.0/19" } ], "logs";

t/02-rate-codes.t  view on Meta::CPAN

    # Capture log messages
    enable sub($app) {
        sub($env) {
            $env->{'psgix.logger'} = sub {
                push @logs, $_[0];
            };
            return $app->($env);
        };
    };

    # Trust the "X-Forwarded-For" header
    enable "ReverseProxy";

    enable "Greylist",
      default_rate => 5,
      retry_after  => 120,
      file         => $file,
      cache_config => { init_file => 1, unlink_on_exit => 1 },
      greylist     => \%greylist;

    sub($env) {

t/02-rate-codes.t  view on Meta::CPAN

};

subtest "whitelisted" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "172.16.1.1";

        for ( 1 .. 6 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        is \@logs, [], "no warnings logged";

      };

};

subtest "greylist (blocked)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "13.67.224.13";

        for ( 1 .. 2 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_FORBIDDEN, "forbidden";
        }

        is \@logs,
          [
            { level => "warn", message => "Rate limiting 13.67.224.13 after 1/0 for 13.64.0.0/11" },
            { level => "warn", message => "Rate limiting 13.67.224.13 after 2/0 for 13.64.0.0/11" },

t/02-rate-codes.t  view on Meta::CPAN

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $ip = "66.249.66.1";

        subtest "robots.txt" => sub {
            {
                my $req = GET "/robots.txt", "X-Forwarded-For" => $ip;
                my $res = $cb->($req);
                is $res->code, HTTP_OK, "allowed";
            }
        };

        subtest "blocked" => sub {

            my $req = GET "/", "X-Forwarded-For" => $ip;
            my $res = $cb->($req);
            is $res->code, HTTP_FORBIDDEN, "forbidden";

            # Note that this is counting the /robots.txt request
            is \@logs, [ { level => "warn", message => "Rate limiting ${ip} after 2/0 for 66.249.64.0/19" }, ], "logs";

        };

        subtest "robots.txt" => sub {
            {
                my $req = GET "/robots.txt", "X-Forwarded-For" => $ip;
                my $res = $cb->($req);
                is $res->code, HTTP_OK, "allowed";
            }
        };

      };

};

done_testing;

t/03-override.t  view on Meta::CPAN

    # Capture log messages
    enable sub($app) {
        sub($env) {
            $env->{'psgix.logger'} = sub {
                push @logs, $_[0];
            };
            return $app->($env);
        };
    };

    # Trust the "X-Forwarded-For" header
    enable "ReverseProxy";

    enable "Greylist",
      default_rate => 5,
      cache_config => {
        init_file      => 1,
        unlink_on_exit => 1,
        expire_time    => 30,
        share_file     => $file,
      },

t/03-override.t  view on Meta::CPAN


subtest "rate limiting" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        for my $suff ( 1 .. 5 ) {
            my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.${suff}";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.10";
        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is $res->header('Retry-After'), 31, "Retry-After set from expire_time";

        is \@logs, [ { level => "warn", message => "Rate limiting 172.16.0.10 after 6/5 for 172.16.0.0/24" } ], "logs";

      };

};

subtest "greylist (higher limit)" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.128";

        for ( 1 .. 10 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs, [ { level => "warn", message => "Rate limiting 172.16.0.128 after 11/10 for 172.16.0.128/32" } ], "logs";

t/04-ip6.t  view on Meta::CPAN

    # Capture log messages
    enable sub($app) {
        sub($env) {
            $env->{'psgix.logger'} = sub {
                push @logs, $_[0];
            };
            return $app->($env);
        };
    };

    # Trust the "X-Forwarded-For" header
    enable "ReverseProxy";

    enable "Greylist",
      default_rate => 10,
      file         => $file,
      cache_config => { init_file => 1, unlink_on_exit => 1, expire_time => 30 },
      greylist     => \%greylist;

    sub($env) {
        my $res = Plack::Response->new( HTTP_OK, [ 'Content-Type' => 'text/plain' ], [ status_message(HTTP_OK) ] );

t/04-ip6.t  view on Meta::CPAN


subtest "rate limiting" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        for my $suff ( 1 .. 5 ) {
            my $req = HEAD "/", "X-Forwarded-For" => "2001:67c:1220::1";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $req = HEAD "/", "X-Forwarded-For" => "2001:67c:1220::1";
        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs, [ { level => "warn", message => "Rate limiting 2001:67c:1220::1 after 6/5 for 2001:67c:1220::/32" } ], "logs";

      };

};

subtest "rate limiting" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        for my $suff ( 1 .. 6 ) {
            my $req = HEAD "/", "X-Forwarded-For" => "2001:67c:1220:f565::1";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $req = HEAD "/", "X-Forwarded-For" => "2001:67c:1220:f565::1";
        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs,
          [ { level => "warn", message => "Rate limiting 2001:67c:1220:f565::1 after 7/6 for 2001:67c:1220:f565::/64" } ], "logs";

      };

};

subtest "default" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        my $req = HEAD "/", "X-Forwarded-For" => "2002:67c:1220:f565::1235";

        for ( 1 .. 10 ) {
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is \@logs, [ { level => "warn", message => "Rate limiting 2002:67c:1220:f565::1235 after 11/10 for default" } ], "logs";

t/05-callback.t  view on Meta::CPAN

    # Capture log messages
    enable sub($app) {
        sub($env) {
            $env->{'psgix.logger'} = sub {
                push @logs, $_[0];
            };
            return $app->($env);
        };
    };

    # Trust the "X-Forwarded-For" header
    enable "ReverseProxy";

    enable "Greylist",
      default_rate => 5,
      cache_config => {
        init_file      => 1,
        unlink_on_exit => 1,
        expire_time    => 30,
        share_file     => $file,
      },

t/05-callback.t  view on Meta::CPAN


subtest "rate limiting" => sub {

    @logs = ();

    test_psgi
      app    => $handler,
      client => sub($cb) {

        for my $suff ( 1 .. 5 ) {
            my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.${suff}";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok";
        }

        {
            my $req = HEAD "/?ok", "X-Forwarded-For" => "172.16.0.10";
            my $res = $cb->($req);
            is $res->code, HTTP_OK, "request ok (callback override)";
        }

        my $req = HEAD "/", "X-Forwarded-For" => "172.16.0.10";
        my $res = $cb->($req);
        is $res->code, HTTP_TOO_MANY_REQUESTS, "too many requests";

        is $res->header('Retry-After'), 31, "Retry-After set from expire_time";

        is \@logs, [], "nothing logged";

        is \@calls, [
            hash(
                sub {



( run in 2.220 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )