From 2221eea0951681b413a674d01317fa079200b5d4 Mon Sep 17 00:00:00 2001
From: "Steinar H. Gunderson" <sgunderson@bigfoot.com>
Date: Tue, 22 Jan 2013 17:18:14 +0100
Subject: [PATCH] Initial checkin for move to Git (no prior version history
 available).

---
 test.pl | 123 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 123 insertions(+)
 create mode 100755 test.pl

diff --git a/test.pl b/test.pl
new file mode 100755
index 0000000..7699333
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,123 @@
+#! /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;
+
-- 
2.39.2