Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

First version

  • Loading branch information...
commit b097f70c5694049ef0cd6feeb580717715438d83 0 parents
@pawal authored
Showing with 272 additions and 0 deletions.
  1. +5 −0 README
  2. +179 −0 collect.pl
  3. +22 −0 list.pl
  4. +66 −0 list.txt
5 README
@@ -0,0 +1,5 @@
+This is a hack to track the IP addresses of popular bittorrent trackers.
+
+If you don't know how to use it, don't.
+
+For more information, contact Patrik Wallström <pawal@blipp.com>.
179 collect.pl
@@ -0,0 +1,179 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use URI;
+use Net::DNS;
+use List::Compare;
+use JSON -support_by_pp;
+use Fcntl qw(:flock);
+use Data::Dumper;
+
+# options
+my $file = 'data.json';
+my $oldfile = $file.'.old';
+my $trackerlist = 'list.txt';
+my $resolver = '127.0.0.1';
+my $DEBUG = 0;
+
+sub getHosts {
+ my $file = shift;
+ open TRACKERS, $file or die "Cannot read trackers list from file $file";
+ my @trackers = <TRACKERS>;
+ close TRACKERS;
+
+ my @hosts;
+ foreach (@trackers) {
+ s/^udp(.*)/http$1/; # udp is not a recognized url
+ my $url = URI->new($_);
+ my $domain = $url->host;
+ push @hosts, $domain;
+ }
+ # return a unique array
+ my %unique;
+ for (@hosts) { $unique{$_}++; }
+ @hosts = sort keys %unique;
+ return \@hosts;
+}
+
+sub collectDNS {
+ my $hosts = shift;
+
+ my $res = Net::DNS::Resolver->new;
+ $res->nameservers($resolver);
+ $res->recurse(1);
+
+ my $answer;
+ my $result;
+
+ # resolve names
+ foreach my $name (@$hosts) {
+ # initialize arrays for completeness in later comparisons
+ $result->{$name}->{'A'} = [];
+ $result->{$name}->{'AAAA'} = [];
+
+ # query for A record
+ $answer = $res->send($name,'A');
+ if (defined $answer) {
+ foreach my $data ($answer->answer)
+ {
+ if ($data->type eq 'A') {
+ print "$name: ".$data->address." (".$data->ttl.")\n" if $DEBUG;
+ push @{$result->{$name}->{'A'}}, $data->address;
+ }
+ }
+ }
+
+ # query for AAAA record
+ $answer = $res->send($name,'AAAA');
+ if (defined $answer) {
+ foreach my $data ($answer->answer)
+ {
+ if ($data->type eq 'AAAA') {
+ print "$name: ".$data->address." (".$data->ttl.")\n" if $DEBUG;
+ push @{$result->{$name}->{'AAAA'}}, $data->address;
+ }
+ }
+ }
+ }
+ return $result;
+}
+
+# compare the A and AAAA records for a host and return diff
+sub compareHost {
+ my $old = shift;
+ my $new = shift;
+
+ my @removed;
+ my @added;
+ # A
+ {
+ my $lc = List::Compare->new($old->{'A'},$new->{'A'});
+ push @removed, $lc->get_unique;
+ push @added, $lc->get_complement;
+ }
+
+ # AAAA
+ {
+ my $lc = List::Compare->new($old->{'AAAA'},$new->{'AAAA'});
+ push @removed, $lc->get_unique;
+ push @added, $lc->get_complement;
+ }
+ return \@removed, \@added;
+}
+
+# compare the whole set differences for the array of hosts
+sub findDifferences {
+ my $old = shift;
+ my $new = shift;
+ my @diff;
+ foreach my $name ( keys %{$new} ) {
+ # old name might not exist
+ if (not defined $old->{$name}) {
+
+ $old->{$name}->{'A'} = [];
+ $old->{$name}->{'AAAA'} = [];
+ }
+ my ($removed, $added) = compareHost($old->{$name}, $new->{$name});
+ # TODO: before adding, maybe do a reverse lookup on the IP?
+ map { push @diff, "- $name $_" } @$removed;
+ map { push @diff, "+ $name $_" } @$added;
+ }
+ my $result;
+ map { $result .= "$_\n" } @diff;
+ return $result;
+}
+
+sub getOldFile {
+ my $file = shift;
+ my $oldresult = {};
+ if (not open OLDFILE, $file) {
+ warn "Cannot read old file: $file";
+ } else {
+ my @olddata = <OLDFILE>;
+ my $olddata = join '', @olddata;
+ $oldresult = from_json($olddata);
+ }
+ close OLDFILE;
+ return $oldresult;
+}
+
+sub sendReport {
+ my $diff = shift;
+
+ my $subject = 'Tracker report';
+ my $to = 'pawal@iis.se';
+ my $from = 'pawal@snake.blipp.com';
+
+ open(MAIL, "|/usr/sbin/sendmail -t") or die "Cannot send e-mail!";
+ print MAIL "To: $to\n";
+ print MAIL "From: $from\n";
+ print MAIL "Subject: $subject\n\n";
+ print MAIL $diff;
+ close(MAIL);
+}
+
+sub main {
+# this should only run one process at a time
+ unless (flock(DATA, LOCK_EX|LOCK_NB)) {
+ print "$0 is already running. Exiting.\n";
+ exit(1);
+ }
+ my $oldresult = getOldFile($file);
+ my $hosts = getHosts($trackerlist);
+ my $result = collectDNS($hosts);
+ rename $file, $oldfile;
+ open(OUT, '>', $file) or die $!;
+ print OUT to_json($result, { utf8 => 1 });
+ close(OUT);
+ my $diff = findDifferences($oldresult,$result);
+ if (defined $diff and length($diff) > 0) {
+ sendReport($diff);
+ }
+}
+
+main();
+
+__DATA__
+Data used for locking.
22 list.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use JSON -support_by_pp;
+
+my $file = shift or die "no file argument";
+my $trackers = {};
+
+if (not open OLDFILE, $file) {
+ warn "Cannot read data file: $file";
+} else {
+ my @data = <OLDFILE>;
+ my $data = join '', @data;
+ $trackers = from_json($data);
+}
+
+foreach my $name (keys %{$trackers}) {
+ map { print "$name: $_\n" } @{$trackers->{$name}->{'A'}};
+ map { print "$name: $_\n" } @{$trackers->{$name}->{'AAAA'}};
+}
66 list.txt
@@ -0,0 +1,66 @@
+udp://denis.stalker.h3q.com:6969/announce
+udp://denis.stalker.h3q.com:6969/announce
+http://denis.stalker.h3q.com:6969/announce
+udp://tracker.publicbt.com:80/announce
+http://tracker.publicbt.com/announce
+udp://tracker.openbittorrent.com:80/announce
+http://tracker.openbittorrent.com/announce
+udp://tracker.1337x.org:80/announce
+udp://tracker.1337x.org:80/announce
+udp://tracker.publicbt.com:80/announce
+udp://tracker.openbittorrent.com:80
+udp://fr33domtracker.h33t.com:3310/announce
+udp://tracker.istole.it:80/announce
+http://exodus.desync.com:6969/announce
+udp://fr33dom.h33t.com:3310/announce
+http://fr33dom.h33t.com:3310/announce
+http://erdgeist.org/arts/software/opentracker/announce
+http://ipv6.tracker.harry.lu/announce
+http://bt.e-burg.org:2710/announce
+http://tracker.torrentbay.to:6969/announce
+http://tracker.1337x.org/announce
+http://cpleft.com:2710/announce
+http://tracker.bittorrent.am/announce
+http://sline.net:2710/announce
+http://retracker.nn.ertelecom.ru/announce
+http://cpleft.com:2710/announce
+http://tracker.cpleft.com:2710/announce
+http://exodus.desync.com/announce
+http://tracker.novalayer.org:6969/announce
+http://retracker.hq.ertelecom.ru/announce
+http://retracker.perm.ertelecom.ru/announce
+http://i.bandito.org/announce
+http://tracker.tfile.me/announce
+http://siambit.com/announce.php
+http://announce.torrentsmd.com:6969/announce
+http://coppersurfer.tk:6969/announce
+http://tracker.coppersurfer.tk:6969/announce
+http://tracker.anime-miako.to:6969/announce
+http://p2p.lineage2.com.cn:6969/announce
+http://tracker.hdcmct.com:2710/announce
+http://php.hdcmct.com:2710/announce
+http://bigfangroup.org/announce.php
+http://thebox.bz:2710/announce
+http://tracker.thebox.bz:8080/announce
+http://www.total-share.org/announce.php
+http://retracker.hotplug.ru:2710/announce
+http://announce.partis.si/announce
+http://tracker.torrentbox.com:2710/announce
+http://jpopsuki.eu:7531/announce
+http://masters-tb.com/announce.php
+http://www.music-vid.com/announce.php
+http://deviloid.net:6969/announce
+http://announce.xxx-tracker.com:2710/announce
+http://tracker.gaytorrent.ru/announce.php
+http://papaja.v2v.cc:6970/announce
+http://bttrack.9you.com/announce
+http://tracker.torrentleech.org:2710/announce
+http://grabthe.info/announce.php
+http://tracker.zokio.net:8080/announce
+http://torrent.jiwang.cc/announce.php
+http://www.elitezones.ro/announce.php
+http://elitezones.ro/announce.php
+http://www.unlimitz.com/announce.php
+http://baconbits.org:34000/announce
+http://rds-zone.ro/announce.php
+http://craiovatracker.com/announce.php
Please sign in to comment.
Something went wrong with that request. Please try again.