git.sesse.net Git - torrentaccelerator/blob - test.pl

   1 #! /usr/bin/perl
   2 use Socket;
   3 use Convert::Bencode;
   4 use Data::Dumper;
   5 use DBI;
   6 use URI::Escape;
   7
   8 my $dbh = DBI->connect("dbi:Pg:dbname=ta;host=127.0.0.1", "ta", "ta")
   9         or die "db connect: " . DBI->errstr;
  10
  11 $| = 1;
  12
  13 $/ = "\r\n\r\n";
  14 my $line = <STDIN>;
  15
  16 # connect to the tracker and tell just that
  17 $proto = getprotobyname('tcp');
  18 socket(SOCK, PF_INET, SOCK_STREAM, $proto);
  19 $sin = sockaddr_in(80, inet_aton("85.17.40.39"));
  20 connect(SOCK, $sin);
  21
  22 my $hersockaddr    = getpeername(STDIN);
  23 my ($port, $iaddr) = sockaddr_in($hersockaddr);
  24 $iaddr = inet_ntoa($iaddr);
  25
  26 print STDERR "LINE: $line\n";
  27
  28 my $ih;
  29 if ($line =~ /info_hash=(.*?)&/) {
  30         $ih = URI::Escape::uri_escape(URI::Escape::uri_unescape($1));
  31         if ($line =~ /port=(\d+)&/) {
  32                 my $port = $1;
  33
  34                 # add to the list of seen TG peers
  35                 if ($line =~ /event=stopped/) {
  36                         $dbh->do('DELETE FROM ta WHERE host=? AND info_hash=?', undef,
  37                                 $iaddr, $ih);
  38                 } else {
  39                         $dbh->do('INSERT INTO ta (host, port, seen, info_hash) VALUES (?,?,CURRENT_TIMESTAMP,?)', undef,
  40                                 $iaddr, $port, $ih);
  41                 }
  42         }
  43 }
  44
  45 $line =~ s/\r\n\r\n//s;
  46 $line .= "\r\nX-Forwarded-For: $iaddr\r\n\r\n";
  47
  48 send(SOCK, $line, 0);
  49
  50 # fetch the http header
  51 $/ = "\r\n\r\n";
  52 my $hdr = <SOCK>;
  53
  54 # fetch the body
  55 $/ = undef;
  56 my $body = <SOCK>;
  57
  58 my $bd = Convert::Bencode::bdecode($body);
  59 if (exists($bd->{'peers'})) {
  60         my @allpeers = ();
  61         my @tgpeers = ();
  62
  63         my $peers = $bd->{'peers'};
  64
  65         for my $i (0..(length($peers) / 6 - 1)) {
  66                 my $iaddr = inet_ntoa(substr($peers, ($i*6+1), 4));
  67                 my $p1 = ord(substr($peers, ($i*6+5), 1));
  68                 my $p2 = ord(substr($peers, ($i*6+6), 1));
  69                 my $port = ($p1 << 8) | $p2;
  70
  71                 if ($iaddr =~ /^87\.76\./) {
  72                         print STDERR "FOUND INTERNAL PEER: $iaddr\n";
  73                         if (defined($ih)) {
  74                                 $dbh->do('INSERT INTO ta (host, port, seen, info_hash) VALUES (?,?,CURRENT_TIMESTAMP,?)', undef,
  75                                         $iaddr, $port, $ih);
  76                         }
  77                         push @tgpeers, [ $iaddr, $port ];
  78                 }
  79
  80                 push @allpeers, [ $iaddr, $port ];
  81         }
  82
  83         # check for other peers
  84         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');
  85         $q->execute($iaddr, $ih);
  86
  87         while (my $ref = $q->fetchrow_hashref) {
  88                 push @tgpeers, [ $ref->{'host'}, $ref->{'port'} ];
  89         }
  90
  91         if (scalar @tgpeers > 0) {
  92                 my $newpeers = "";
  93                 for my $peer (@tgpeers) {
  94                         $newpeers .= inet_aton($peer->[0]);
  95                         $newpeers .= chr($peer->[1] >> 8);
  96                         $newpeers .= chr($peer->[1] & 0xff);
  97
  98                         print STDERR "Adding peer $peer->[0]:$peer->[1]\n";
  99                 }
 100
 101                 # fish in some other peers
 102                 my $num = (scalar @tgpeers) * 2;
 103                 my $i = 0;
 104                 while ($num > 0 && $i < scalar @allpeers) {
 105                         my $iaddr = $allpeers[$i]->[0];
 106                         my $port = $allpeers[$i]->[1];
 107                         ++$i;
 108                         next if ($iaddr =~ /^87\.76\./);
 109                         --$num;
 110
 111                         $newpeers .= inet_aton($iaddr);
 112                         $newpeers .= chr($port >> 8);
 113                         $newpeers .= chr($port & 0xff);
 114                 }
 115
 116                 $bd->{'peers'} = $newpeers;
 117                 print STDERR "DELIVER PEERS " . scalar @tgpeers . "\n";
 118                 $body = Convert::Bencode::bencode($bd);
 119         }
 120 }
 121
 122 print $hdr . $body;
 123