[bittorrent] getting seeders and peers from URL with perl

Dinesh Prasad dprasad830 at yahoo.com
Sun Aug 21 17:35:12 EDT 2005


The following script retrieves information such as
hash and
associated files just fine. however, it wont list
seed/peers and says:

Unable to retrieve tracker information about torrent:
Unable to
contact tracker
information server at http://205.177.3.2:6969/scrape:
The tracker
information se
rver is not available. This tracker may not support
providing
information. (404
Not Found).

On very rare occassions, it will show the seed/peer
info. However, I've only gotten that to work once.

http://freshmeat.net/projects/torrentsniff/

Note: Digest::SHA1 has been installed


torrentsniff.pl

#! /usr/bin/perl -w

# This is part of modern Perl distributions.
use FindBin;
use lib "$FindBin::Bin";

# These are part of modern Perl distributions.
use Getopt::Long;

# These modules aren't necessarily "standard" with
Perl. You might
need to
# install them seperately.
use Digest::SHA1 qw(sha1);
use LWP::UserAgent;

# This is part of TorrentSniff, and should have been
distributed with it.
use BitTorrent::BDecode;
use strict;

my $VERSION = '0.3';
my $PROGRAM_NAME = 'TorrentSniff';


main();

exit 0;

sub main {
# Autoflush stdout so messages to stderr will stick
with the associated
# stdout messages.
local $| = 1;

my $opt_report_file_info;
my $opt_report_tracker_info;
my $opt_help = 0;
GetOptions (
'f|file-info!' => \$opt_report_file_info,
't|tracker-info!' => \$opt_report_tracker_info,
'h|?|help' => \$opt_help,
) or usage_exit();

if($opt_help) {
usage_exit();
}

my($report_file_info, $report_tracker_info) = (1,1);
if($opt_report_file_info or $opt_report_tracker_info)
{
$report_file_info = $opt_report_file_info || 0;
$report_tracker_info = $opt_report_tracker_info || 0;
}

if($report_file_info == 0 and $report_tracker_info ==
0) {
print STDERR "No output requested.\n";
usage_exit();
}

if(not @ARGV) {
usage_exit();
}

foreach my $arg (@ARGV) {
if($arg =~ m|://|) {
process_url($arg, $report_file_info,
$report_tracker_info);
} else {
process_file($arg, $report_file_info,
$report_tracker_info);
}
print "\n";
}
}

sub process_url {
my($url, $report_file_info, $report_tracker_info) =
@_;
print "$url\n";
my $res = get_url($url);
if(not defined $res->is_success) {
print STDERR "Problem downloading $url:\n";
print STDERR $res->status_line."\n";
return;
}
output_torrent_data($res->content, $report_file_info,
$report_tracker_info);
}

sub process_file {
my($file, $report_file_info, $report_tracker_info) =
@_;
print "$file\n";
local *TOR;
if( not open(TOR, "<", $file) ) {
print STDERR "Unable to read $file because of $!\n";
return 0;
}
binmode(TOR);
my $body;
read(TOR, $body, (-s $file));
close(TOR);
output_torrent_data($body, $report_file_info,
$report_tracker_info);
}

sub output_torrent_data {
my($body, $report_file_info, $report_tracker_info) =
@_;
my $result = process_torrent_data($body);
if(not defined $result) {
print STDERR "Problem reading torrent file\n";
}


if($report_file_info) {
print " info hash: $result->{'hash'}\n";
print " announce url: $result->{'announce'}\n";
}

if($report_tracker_info) {
my($seeds, $leeches, $error_reason) =
retrive_hash_seed_leech($result);

if(defined $seeds and defined $leeches) {
print " full copies: $seeds seeds\n";
print " partial copies: $leeches leeches\n";
} else {
print STDERR "Unable to retrieve tracker information
about ".
"torrent: $error_reason\n";
}
}

if($report_file_info) {
printf " %15s %s\n", 'Bytes', 'File';
foreach my $file (@{$result->{'files'}}) {
my $size = $file->{'size'};
my $name = $file->{'name'};
printf " %15s %s\n", commify($size), $name;
}
if(@{$result->{'files'}} > 1) {
printf " %15s %s\n", commify($result->{'total_size'}),
'TOTAL';
}
}
}

{
my %tracker_status_cache;
sub retrieve_tracker_info {
my($announce_url) = @_;

if(exists $tracker_status_cache{$announce_url}) {
return ($tracker_status_cache{$announce_url}, undef);
}

my $scrape_url =
get_tracker_status_url($announce_url);
if(not defined $scrape_url) {
return (undef,
"Unable to determine URL to tracker information
(scrape) server.");
}

my $res = get_url($scrape_url);
if(not $res->is_success) {
my $error_reason = $res->status_line();
if($res->code() == 404) {
$error_reason = "The tracker information server is not
available. "
."This tracker may not support providing information.
"
."($error_reason)";
}
return (undef,
"Unable to contact tracker information server at
$scrape_url:"
." $error_reason.");
}

my $tracker_status =
get_tracker_status($res->content_ref);

if(not defined $tracker_status) {
return (undef,
"Error parsing results from tracker information
server.");
}

$tracker_status_cache{$announce_url} =
$tracker_status;

return($tracker_status, undef);
}
}

sub retrive_hash_seed_leech {
my($result) = @_;

my($tracker_status, $error_reason) =
retrieve_tracker_info($result->{'announce'});
if(not defined $tracker_status) {
return(undef, undef, $error_reason);
}
my $hash = $result->{'hash'};
my %status = %{$tracker_status};

if(not exists $status{$hash}) {
return (undef, undef,
"Tracker information server doesn't know about that
hash. ".
"The torrent may have been removed from the server."
);
}

my $seeds = $status{$hash}->{'complete'};
my $leeches = $status{$hash}->{'incomplete'};
return ($seeds, $leeches, undef);
}

sub process_torrent_data {
my($body) = @_;

my %result;

my $t = BitTorrent::BDecode::bdecode(\$body);

my $info = $t->{'info'};
my $s = substr($body, $t->{'_info_start'},
$t->{'_info_length'});
my $hash = bin2hex(sha1($s));
my $announce = $t->{'announce'};

$result{'hash'} = $hash;
$result{'announce'} = $announce;
$result{'files'} = [];
my $tsize = 0;
if(defined($info->{'files'})) {
foreach my $f (@{$info->{'files'}}) {
my %file_record = ( 'size' => $f->{'length'});

$tsize += $f->{'length'};
my $path = $f->{'path'};

if(ref($path) eq 'ARRAY') {
$file_record{'name'} = $info->{'name'}.'/'.$path->[0];
} else {
$file_record{'name'} = $info->{'name'}.'/'.$path;
}
push @{$result{'files'}}, \%file_record;

}
} else {
$tsize += $info->{'length'},

push @{$result{'files'}},
{
'size' => $info->{'length'},
'name' => $info->{'name'},
};

}
$result{'total_size'} = $tsize;

return \%result;
}

# Given a tracker announce URL, return the status
("scrape") URL
sub get_tracker_status_url {
my($url) = @_;
my($orig) = $url;
$url =~ s|/announce|/scrape|ig;
if($orig eq $url) {
return undef;
}
return $url;
}

# Retrieve complete (seed) and incomplete (leech)
counts for all
# torrents at a particular tracker.
sub get_tracker_status {
my($status_body) = @_;

my $s;
eval { $s =
BitTorrent::BDecode::bdecode($status_body); };
if($@) {
print STDERR "Invalid tracker response $@";
return undef;
}

if(not exists $s->{'files'}) {
print STDERR "Tracker returned odd results (no
files)\n";
return undef;
}

my %results;
foreach my $f (%{$s->{'files'}}) {
my $v = $s->{'files'}{$f};
my $fhash = bin2hex($f);
my $seeds = $v->{'complete'} || "0";
my $leeches = $v->{'incomplete'} || "0";
if(exists $results{$fhash}) {
print STDERR "Tracker has hash $fhash multiple
times\n";
}
$results{$fhash} = {'complete' => $seeds, 'incomplete'
=> $leeches};
}
return \%results;
}

# Add commas to number
sub commify {
local $_ = shift;
1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
return $_;
}

# Encode binary as hex characters
sub bin2hex {
my ($d) = @_;
$d =~ s/(.)/sprintf("%02x",ord($1))/egs;
$d = lc($d);
return $d;
}

BEGIN {
my $ua;
sub get_url {
if(not defined $ua) {
$ua = LWP::UserAgent->new(
'env_proxy' => 1,
'agent' => "$PROGRAM_NAME/$VERSION ",
'timeout' => 15,
);
}
return $ua->get($_[0]);
}
}

sub usage_exit {
print <<END;
$0 [options] [.torrent files ...]

Call with one or more .torrent files or URLs to
.torrent files.
Reports both information on the .torrent file and on
the tracker unless called with --tracker-info or
--file-info.

--tracker-info
--file-info
Options:
--help Print this documentation

--tracker-info
-t Return information on the torrent's tracker

--file-info
-f Return information on the torrent file itself

END
exit 1;
}







__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 
http://mail.yahoo.com 



More information about the BitTorrent mailing list