package Apache::SpeedLimit;

use strict;
use Apache::Constants qw(:common);
use Apache::Log ();
use IPC::Shareable ();
use vars qw(%DB);

sub handler {
    my $r = shift;
    return DECLINED unless $r->is_main;  # don't handle sub-requests

    my $speed_limit = $r->dir_config('SpeedLimit') || 10; # Accesses per minute
    my $samples = $r->dir_config('SpeedSamples')   || 10; # Sampling threshold (hits)
    my $forgive = $r->dir_config('SpeedForgive')   || 20; # Forgive after this period (minutes)
     my $expire = $r->dir_config('SpeedExpire')   || 40; # Expire unused
                           # records from memory after this period (minutes)

    my $content_type = $r->lookup_uri($r->uri)->content_type;
    return OK if $content_type =~ m:^image/:i; # ignore images
    tie %DB, 'IPC::Shareable', 'SPLM', {create => 1, mode => 0644}
    unless defined %DB;
    
    my($ip, $agent) = ($r->connection->remote_ip, $r->header_in('User-Agent'));
    my $id = "$ip:$agent";
    my $now = time()/60; # minutes since the epoch
    
    # lock the shared memory while we work with it
    tied(%DB)->shlock;
    
    my($first, $last, $hits, $locked) = split ' ', $DB{$id};
    my $result = OK;
    my $l = $r->server->log;
  CASE:
    {
	unless ($first) { # we're seeing this client for the first time
	    $l->debug("First request from $ip.  Initializing speed counter.");
	    $first = $last = $now;
	    $hits = $locked = 0;
	    last CASE;
	}
	
	if ($now - $last > $forgive) { # beyond the grace period.  Treat like first
	    $l->debug("$ip beyond grace period.  Reinitializing speed counter.");
	    $last = $first = $now;
	    $hits = $locked = 0;
	    last CASE;
   	}
	
   	# update the values now
   	$last = $now; $hits++;
   	if ($hits < $samples) {
	    $l->debug("$ip not enough samples to calculate speed.");
	    last CASE;
   	}
	
   	if ($locked) { # already locked out, so forbid access
	    $l->debug("$ip locked");
	    $result = FORBIDDEN;
	    last CASE;
   	}
	
   	my $interval = $now - $first;
   	$l->debug("$ip speed = ", $hits/$interval);
   	if ($hits/$interval > $speed_limit) {
   	    $l->debug("$ip exceeded speed limit.  Blocking.");
   	    $locked = 1;
   	    $result = FORBIDDEN;
   	    last CASE;
   	}
    }
    
    $r->log_reason("Client exceeded speed limit.", $r->filename) 
	if $result == FORBIDDEN;
    $DB{$id} = join " ", $first, $now, $hits, $locked;

     foreach my $key (keys %DB) {
       my ($first, $last, $hits, $locked) = split(' ', $DB{$key});
       if ($now - $last > $expire) {
         delete $DB{$key};
       }
     }
     

    tied(%DB)->shunlock;
    
    return $result;
}

1;
__END__