#!perl

package Apache::ModBT::LeechNuker;

=pod

=head1 NAME

Apache::ModBT::LeechNuker - mod_perl handler to shun leeches on a mod_bt BitTorrent Tracker

=head1 SYNOPSIS

	PerlModule Apache::ModBT::LeechNuker

	<Location "/announce">
		<IfModule mod_perl.c>
			PerlFixupHandler	Apache::ModBT::LeechNuker
			PerlSetVar			MinLeechTime		3600
		</IfModule>
	</Location>

=head1 DESCRIPTION

  The Apache::ModBT::LeechNuker module is a basic example on how to manipulate the operations of
  a mod_bt BitTorrent tracker from mod_perl.
  
  When run on an "/announce" request, this module will look up the peer making the request in
  the tracker's database. If the peer has not uploaded anything, and has been connected to
  the tracker for a certain amount of time (the default is 3600 seconds or 1 hour), has been
  downloading, and there are other peers that need his or her help, the peer's "Shunned"
  flag is set in the database.
  
  A "Shunned" peer is never given any other peers when it makes /announce requests, and is
  never served to other peers, effectively blocking the peer from the network 

=cut

use strict;
use warnings;

use Apache2;
use Apache::Const qw(DECLINED);
use Apache::RequestRec;
use Apache::RequestIO;

use URI;
use Apache::ModBT;
use Net::BitTorrent::LibBTT;
use URI::Escape;

our $Shunned;

my(%flags)=(reverse(Net::BitTorrent::LibBTT::Peer::Flags()));

if(!$flags{Shunned})
{
 die "This tracker does not have a \"Shunned\" flag!";
}

$Shunned = $flags{Shunned};

our $shunstr =
 "Shunning peer \"%s\" from hash \"%s\" (No up, %u down, %u left, %u online, %u/%u downloaders)\n";

return 1;

sub handler
{
 my $r = shift;
 my $uri = URI->new();
 my $leechtime = $r->dir_config("MinLeechTime") || 3600;
 $uri->query($r->args);
 my(%args)=($uri->query_form());
 my $tracker = $r->server->ModBT_Tracker();
 
 if($args{"info_hash"} && $args{"peer_id"})
 {
  if(my $hash = $tracker->Infohash(uri_unescape($args{"info_hash"})))
  {
   if(my $peer = $hash->Peer(uri_unescape($args{"peer_id"})))
   {
    if
    (
     (!$peer->uploaded) && ($peer->downloaded) && ($peer->left) &&
     ($hash->seeds) && ($hash->peers > ($hash->seeds + 1)) &&
     ((time() - $peer->first_t) > $leechtime) &&
     (!($peer->flags & $Shunned))
    )
    {
     warn sprintf
     (
      $shunstr, uri_escape($peer->peerid), uri_escape($peer->infohash),
      $peer->downloaded, $peer->left, time() - $peer->first_t, $hash->peers, $hash->seeds
     );
     $peer->flags($peer->flags | $Shunned);
     $peer->save();
    }
   }
  }
 }
 
 return DECLINED;
}

