#!/usr/bin/perl -w


=head1 NAME

DropClients - Drop agents that make bad requests to our site.

=cut

=head1 ABOUT

  This module will ban clients that make bogus requests to our
 server.

  We only care about one kind of bogus request - and that
 is requests that contain the "#" or fragment character.  This shouldn't
 be sent to our server, instead it should be processed client side.

=cut

=head1 INFORMATION

  This module was written for a simple article on mod_perl available
 here:

    http://debian-administration.org/tag/mod_perl

=cut

=head1 AUTHOR

 Steve
 --
 http://www.steve.org.uk/

=cut

=head1 LICENSE

Copyright (c) 2009 by Steve Kemp.  All rights reserved.

This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut


use strict;
use warnings;


#
#  Modules we use.
#
use APR::Table;
use Apache2::Connection;
use Apache2::Const;
use Apache2::Log;



#
#  Our package.
#
package DropClients;
our $VERSION = '0.01';




=begin doc

  Called when a request comes in.

=end doc

=cut

sub handler
{

    #
    #  We only care about the initial request.
    #
    my $r = shift;
    return Apache2::Const::DECLINED unless $r->is_initial_req;


    #
    #  Create an identifier for the remote client,
    # which is based upon their IP, and their user-agent
    #
    my $ip     = $r->connection->remote_ip();
    my $agent  = $r->headers_in->{ 'User-Agent' } || "unknown-agent";
    my $client = $ip . $agent;


    #
    #  Sanitize the client a little
    #
    $client =~ s/[^a-zA-Z0-9_-]//g;


    #
    #  If the request contains the hash then mark the client as bad
    #
    my $uri = $r->unparsed_uri();

    if ( $uri =~ /#/ )
    {

        #
        #  Prevent the client from making further connections
        #
        blockRemote($client);


        #
        #  Deny
        #
        $r->log_reason("Blocking IP:$ip [$agent] for request: $uri");
        return Apache2::Const::FORBIDDEN;
    }

    #
    # Is the visitor currently blocked?
    #
    if ( isBlocked($client) )
    {
        $r->log_reason("Blocked IP:$ip [$agent] for request: $uri");
        return Apache2::Const::FORBIDDEN;
    }

    #
    #  OK access allowed
    #
    return Apache2::Const::DECLINED;

}



=begin doc

  Test if the given client is blocked.

=end doc

=cut

sub isBlocked
{
    my ($remote) = (@_);

    return ( -e "/tmp/blah/$remote" );
}



=begin doc

  Block the given client.

=end doc

=cut

sub blockRemote
{
    my ($remote) = (@_);

    #
    #  Make sure we have the block directory
    #
    if ( !-d "/tmp/blah" )
    {
        system("mkdir -p /tmp/blah");
    }

    #
    #  Record the block
    #
    system( "touch", "/tmp/blah/$remote" );

}

#
#  The end of the module
#
1;