#! /usr/bin/perl
use Socket;
use Convert::Bencode;
use Data::Dumper;
use DBI;
use URI::Escape;

my $dbh = DBI->connect("dbi:Pg:dbname=ta;host=127.0.0.1", "ta", "ta")
	or die "db connect: " . DBI->errstr;

$| = 1;

$/ = "\r\n\r\n";
my $line = <STDIN>;

# connect to the tracker and tell just that
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto);
$sin = sockaddr_in(80, inet_aton("85.17.40.39"));
connect(SOCK, $sin);

my $hersockaddr    = getpeername(STDIN);
my ($port, $iaddr) = sockaddr_in($hersockaddr);
$iaddr = inet_ntoa($iaddr);

print STDERR "LINE: $line\n";

my $ih;
if ($line =~ /info_hash=(.*?)&/) {
	$ih = URI::Escape::uri_escape(URI::Escape::uri_unescape($1));
	if ($line =~ /port=(\d+)&/) {
		my $port = $1;

		# add to the list of seen TG peers
		if ($line =~ /event=stopped/) {
			$dbh->do('DELETE FROM ta WHERE host=? AND info_hash=?', undef,
				$iaddr, $ih);
		} else {
			$dbh->do('INSERT INTO ta (host, port, seen, info_hash) VALUES (?,?,CURRENT_TIMESTAMP,?)', undef,
				$iaddr, $port, $ih);
		}
	}
}

$line =~ s/\r\n\r\n//s;
$line .= "\r\nX-Forwarded-For: $iaddr\r\n\r\n";

send(SOCK, $line, 0);

# fetch the http header
$/ = "\r\n\r\n";
my $hdr = <SOCK>;

# fetch the body
$/ = undef;
my $body = <SOCK>;

my $bd = Convert::Bencode::bdecode($body);
if (exists($bd->{'peers'})) {
	my @allpeers = ();
	my @tgpeers = ();

	my $peers = $bd->{'peers'};

	for my $i (0..(length($peers) / 6 - 1)) {
		my $iaddr = inet_ntoa(substr($peers, ($i*6+1), 4));
		my $p1 = ord(substr($peers, ($i*6+5), 1));
		my $p2 = ord(substr($peers, ($i*6+6), 1));
		my $port = ($p1 << 8) | $p2;

		if ($iaddr =~ /^87\.76\./) {
			print STDERR "FOUND INTERNAL PEER: $iaddr\n";
			if (defined($ih)) {
				$dbh->do('INSERT INTO ta (host, port, seen, info_hash) VALUES (?,?,CURRENT_TIMESTAMP,?)', undef,
					$iaddr, $port, $ih);
			}
			push @tgpeers, [ $iaddr, $port ];
		}

		push @allpeers, [ $iaddr, $port ];
	}

	# check for other peers
	my $q = $dbh->prepare('SELECT DISTINCT ON (host) * FROM ta WHERE host<>? AND info_hash=? AND seen >= now() - INTERVAL \'1 hour 15 minutes\' ORDER BY host,seen desc');
	$q->execute($iaddr, $ih);

	while (my $ref = $q->fetchrow_hashref) {
		push @tgpeers, [ $ref->{'host'}, $ref->{'port'} ];
	}

	if (scalar @tgpeers > 0) {
		my $newpeers = "";
		for my $peer (@tgpeers) {
			$newpeers .= inet_aton($peer->[0]);
			$newpeers .= chr($peer->[1] >> 8);
			$newpeers .= chr($peer->[1] & 0xff);

			print STDERR "Adding peer $peer->[0]:$peer->[1]\n";
		}
		
		# fish in some other peers
		my $num = (scalar @tgpeers) * 2;
		my $i = 0;
		while ($num > 0 && $i < scalar @allpeers) {
			my $iaddr = $allpeers[$i]->[0];
			my $port = $allpeers[$i]->[1];
			++$i;
			next if ($iaddr =~ /^87\.76\./);
			--$num;
			
			$newpeers .= inet_aton($iaddr);
			$newpeers .= chr($port >> 8);
			$newpeers .= chr($port & 0xff);
		}

		$bd->{'peers'} = $newpeers;
		print STDERR "DELIVER PEERS " . scalar @tgpeers . "\n";
		$body = Convert::Bencode::bencode($bd);
	}
}

print $hdr . $body;

