18-97-9-172.crawl.commoncrawl.org | ToothyWiki | BitTorrent | RecentChanges | Login
This quick and nasty hack will examine all the torrents available on a tracker and check it can actually talk to the seeds/peers. You can use it from, say, a machine outside your firewall to make sure your seeds are actually visible through NAT and the like and to help narrow down problems a little.
It works with the toothycat.net AMV tracker at the time of writing; MoonShadow hasn't tested it with anything else. As written, it'll hammer the tracker pretty hard, so please only use on your own trackers.
#! perl -w
use strict;
my $myPeerID = '01234567890123456789'; # todo: generate this pseudorandomly
# ----------------------------------------------------
my $usage = <<'END'
Usage:
perl btconntest.pl 'tracker url'
END
;
use IO::Socket;
use URI::Escape;
use LWP::UserAgent;
my $tracker = '';
my $UA = LWP::UserAgent->new();
sub GET
{
my ($x) = @_;
my @getargs = $x;
my $response = $UA->get(@getargs);
if ($response->is_success)
{
return $response->content;
}
print $response->status_line;
return '';
}
sub bdecode
{
my ($x) = @_;
if( $x =~ /^d/s )
{
$x = substr($x, 1);
my %result;
while( length($x) && !($x =~ /^e/s) )
{
my $key;
my $elt;
($key, $x) = bdecode( $x );
($elt, $x) = bdecode( $x );
$result{$$key} = $elt;
}
return( \%result, substr($x, 1) );
}
elsif( $x =~ /^i([0-9-]+)e/s )
{
return (\substr($x, 1, length($1)), substr($x, length($1)+2));
}
elsif( $x =~ /^l/s )
{
$x = substr($x, 1);
my @result;
while( length($x) && !($x =~ /^e/s) )
{
my $elt;
($elt, $x) = bdecode( $x );
push @result, $elt;
}
return( \@result, substr($x, 1) );
}
elsif( $x =~ /^([0-9]+):/s )
{
$x = substr($x, length($1) + 1);
return (\substr($x, 0, $1), substr($x, $1));
}
die("Invalid bdecode prefix: '$x'\n");
}
sub Bin
{
my ($info_hash) = @_;
return pack('H*', $info_hash);
}
sub Handshake
{
my($peer, $port, $info_hash, $peer_ID) = @_;
my $sock = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $peer,
PeerPort => $port
) or return 0;
print $sock chr(19) . 'BitTorrent protocol' . (chr(0) x 8) . $info_hash . $myPeerID;
my $x = '';
my $len = '';
my $ok = read($sock, $len, 1);
$ok and $ok = read($sock, $x, unpack('c', $len));
if( $ok and ( $x ne 'BitTorrent protocol' ) )
{
print " - using unknown protocol: $x";
}
$ok and $ok = read($sock, $x, 8); # reserved bytes
$ok and $ok = read($sock, $x, 20); # info hash
if( $ok and ( $info_hash ne $x ) )
{
print " - info_hash " . unpack('H*', $x) . " doesn't match tracker";
}
$ok and $ok = read($sock, $x, 20); # peer ID
if( $ok and ( $peer_ID ne $x ) )
{
print " - peer ID " . unpack('H*', $x) . " doesn't match tracker";
}
$sock->shutdown(2);
return $ok;
}
sub Scrape
{
my ($scrape, $left) = bdecode( GET($tracker.'scrape') );
if($scrape->{files})
{
foreach my $file( keys %{$scrape->{files}} )
{
print unpack('H*' , $file) . "\n";
TryPeers( $file );
}
}
}
sub TryPeers
{
my($hash) = @_;
my $rq = 'announce?';
$rq .= 'info_hash=' . uri_escape($hash) . '&';
$rq .= 'peer_id=' . $myPeerID . '&';
$rq .= 'port=6881&uploaded=0&downloaded=0&left=999999&numwant=30';
my $result = GET($tracker.$rq.'&event=started');
my $left = GET($tracker.$rq.'&event=stopped');
( $result, $left ) = bdecode( $result );
if( defined( $result->{peers} ) )
{
foreach my $peer( @{$result->{peers}} )
{
print 'Peer: ';
print ${$peer->{'peer id'}};
print ' ';
print ${$peer->{'ip'}};
print ':';
print ${$peer->{'port'}};
if( Handshake( ${$peer->{'ip'}}, ${$peer->{'port'}}, $hash, ${$peer->{'peer id'}} ) )
{
print " - OK\n";
}
else
{
print " - N/A\n";
}
print "\n";
}
}
else
{
print "Tracker didn't send any peers.\n";
}
print "\n";
}
if( $#ARGV != 0 )
{
die ($usage);
}
$tracker = $ARGV[0];
if( !($tracker =~ /^http:\/\//i) )
{
$tracker = 'http://' . $tracker;
}
if( !($tracker =~/\/$/) )
{
$tracker = $tracker . '/';
}
Scrape();