1#!/usr/local/bin/perl -w 2 3# This is part of modern Perl distributions. 4use FindBin; 5use lib "$FindBin::Bin"; 6 7# These are part of modern Perl distributions. 8use Getopt::Long; 9 10# These modules aren't necessarily "standard" with Perl. You might need to 11# install them seperately. 12use Digest::SHA1 qw(sha1); 13use LWP::UserAgent; 14 15# This is part of TorrentSniff, and should have been distributed with it. 16use BitTorrent::BDecode; 17 18 19# TorrentSniff http://www.highprogrammer.com/alan/perl/torrentsniff.html 20# - 2003-05-29 - Changes by Alan De Smet (http://www.highprogrammer.com/alan/) 21# - Alan's changes are released under the "MIT License" as listed below: 22# (And frankly, they're pretty dumb changes, I mostly just slashed and 23# burned stuff I didn't need or couldn't implement from TorrentSpy.) 24# 25# - Based on vesion 0.1.0.3-BETA of TorrentSpy from http://torrentspy.sf.net/ 26# Copyright 2003 "knowbuddy" who is at users.sourceforge.net 27# SourceForge indicates "MIT License" 28# 29# The MIT License: 30# 31# Permission is hereby granted, free of charge, to any person obtaining a 32# copy of this software and associated documentation files (the "Software"), 33# to deal in the Software without restriction, including without limitation 34# the rights to use, copy, modify, merge, publish, distribute, sublicense, 35# and/or sell copies of the Software, and to permit persons to whom the 36# Software is furnished to do so, subject to the following conditions: 37# 38# The above copyright notice and this permission notice shall be included in 39# all copies or substantial portions of the Software. 40# 41# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 42# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 43# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 44# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 45# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 46# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 47# DEALINGS IN THE SOFTWARE. 48 49use strict; 50 51my $VERSION = '0.3'; 52my $PROGRAM_NAME = 'TorrentSniff'; 53 54 55main(); 56 57exit 0; 58 59sub main { 60 # Autoflush stdout so messages to stderr will stick with the associated 61 # stdout messages. 62 local $| = 1; 63 64 my $opt_report_file_info; 65 my $opt_report_tracker_info; 66 my $opt_help = 0; 67 GetOptions ( 68 'f|file-info!' => \$opt_report_file_info, 69 't|tracker-info!' => \$opt_report_tracker_info, 70 'h|?|help' => \$opt_help, 71 ) or usage_exit(); 72 73 if($opt_help) { 74 usage_exit(); 75 } 76 77 my($report_file_info, $report_tracker_info) = (1,1); 78 if($opt_report_file_info or $opt_report_tracker_info) { 79 $report_file_info = $opt_report_file_info || 0; 80 $report_tracker_info = $opt_report_tracker_info || 0; 81 } 82 83 if($report_file_info == 0 and $report_tracker_info == 0) { 84 print STDERR "No output requested.\n"; 85 usage_exit(); 86 } 87 88 if(not @ARGV) { 89 usage_exit(); 90 } 91 92 foreach my $arg (@ARGV) { 93 if($arg =~ m|://|) { 94 process_url($arg, $report_file_info, $report_tracker_info); 95 } else { 96 process_file($arg, $report_file_info, $report_tracker_info); 97 } 98 print "\n"; 99 } 100} 101 102sub process_url { 103 my($url, $report_file_info, $report_tracker_info) = @_; 104 print "$url\n"; 105 my $res = get_url($url); 106 if(not defined $res->is_success) { 107 print STDERR "Problem downloading $url:\n"; 108 print STDERR $res->status_line."\n"; 109 return; 110 } 111 output_torrent_data($res->content, $report_file_info, $report_tracker_info); 112} 113 114sub process_file { 115 my($file, $report_file_info, $report_tracker_info) = @_; 116 print "$file\n"; 117 local *TOR; 118 if( not open(TOR, "< $file") ) { 119 print STDERR "Unable to read $file because of $!\n"; 120 return 0; 121 } 122 binmode(TOR); 123 my $body; 124 read(TOR, $body, (-s $file)); 125 close(TOR); 126 output_torrent_data($body, $report_file_info, $report_tracker_info); 127} 128 129sub output_torrent_data { 130 my($body, $report_file_info, $report_tracker_info) = @_; 131 my $result = process_torrent_data($body); 132 if(not defined $result) { 133 print STDERR "Problem reading torrent file\n"; 134 } 135 136 137 if($report_file_info) { 138 print " info hash: $result->{'hash'}\n"; 139 print " announce url: $result->{'announce'}\n"; 140 } 141 142 if($report_tracker_info) { 143 my($seeds, $leeches, $error_reason) = retrive_hash_seed_leech($result); 144 145 if(defined $seeds and defined $leeches) { 146 print " full copies: $seeds seeds\n"; 147 print " partial copies: $leeches leeches\n"; 148 } else { 149 print STDERR "Unable to retrieve tracker information about ". 150 "torrent: $error_reason\n"; 151 } 152 } 153 154 if($report_file_info) { 155 printf " %15s %s\n", 'Bytes', 'File'; 156 foreach my $file (@{$result->{'files'}}) { 157 my $size = $file->{'size'}; 158 my $name = $file->{'name'}; 159 printf " %15s %s\n", commify($size), $name; 160 } 161 if(@{$result->{'files'}} > 1) { 162 printf " %15s %s\n", commify($result->{'total_size'}), 'TOTAL'; 163 } 164 } 165} 166 167{ 168my %tracker_status_cache; 169sub retrieve_tracker_info { 170 my($announce_url) = @_; 171 172 if(exists $tracker_status_cache{$announce_url}) { 173 return ($tracker_status_cache{$announce_url}, undef); 174 } 175 176 my $scrape_url = get_tracker_status_url($announce_url); 177 if(not defined $scrape_url) { 178 return (undef, 179 "Unable to determine URL to tracker information (scrape) server."); 180 } 181 182 my $res = get_url($scrape_url); 183 if(not $res->is_success) { 184 my $error_reason = $res->status_line(); 185 if($res->code() == 404) { 186 $error_reason = "The tracker information server is not available. " 187 ."This tracker may not support providing information. " 188 ."($error_reason)"; 189 } 190 return (undef, 191 "Unable to contact tracker information server at $scrape_url:" 192 ." $error_reason."); 193 } 194 195 my $tracker_status = get_tracker_status($res->content_ref); 196 197 if(not defined $tracker_status) { 198 return (undef, 199 "Error parsing results from tracker information server."); 200 } 201 202 $tracker_status_cache{$announce_url} = $tracker_status; 203 204 return($tracker_status, undef); 205} 206} 207 208sub retrive_hash_seed_leech { 209 my($result) = @_; 210 211 my($tracker_status, $error_reason) = 212 retrieve_tracker_info($result->{'announce'}); 213 if(not defined $tracker_status) { 214 return(undef, undef, $error_reason); 215 } 216 my $hash = $result->{'hash'}; 217 my %status = %{$tracker_status}; 218 219 if(not exists $status{$hash}) { 220 return (undef, undef, 221 "Tracker information server doesn't know about that hash. ". 222 "The torrent may have been removed from the server." 223 ); 224 } 225 226 my $seeds = $status{$hash}->{'complete'}; 227 my $leeches = $status{$hash}->{'incomplete'}; 228 return ($seeds, $leeches, undef); 229} 230 231sub process_torrent_data { 232 my($body) = @_; 233 234 my %result; 235 236 my $t = BitTorrent::BDecode::bdecode(\$body); 237 238 my $info = $t->{'info'}; 239 my $s = substr($body, $t->{'_info_start'}, $t->{'_info_length'}); 240 my $hash = bin2hex(sha1($s)); 241 my $announce = $t->{'announce'}; 242 243 $result{'hash'} = $hash; 244 $result{'announce'} = $announce; 245 $result{'files'} = []; 246 my $tsize = 0; 247 if(defined($info->{'files'})) { 248 foreach my $f (@{$info->{'files'}}) { 249 my %file_record = ( 'size' => $f->{'length'}); 250 251 $tsize += $f->{'length'}; 252 my $path = $f->{'path'}; 253 254 if(ref($path) eq 'ARRAY') { 255 $file_record{'name'} = $info->{'name'}.'/'.$path->[0]; 256 } else { 257 $file_record{'name'} = $info->{'name'}.'/'.$path; 258 } 259 push @{$result{'files'}}, \%file_record; 260 261 } 262 } else { 263 $tsize += $info->{'length'}, 264 265 push @{$result{'files'}}, 266 { 267 'size' => $info->{'length'}, 268 'name' => $info->{'name'}, 269 }; 270 271 } 272 $result{'total_size'} = $tsize; 273 274 return \%result; 275} 276 277# Given a tracker announce URL, return the status ("scrape") URL 278sub get_tracker_status_url { 279 my($url) = @_; 280 my($orig) = $url; 281 $url =~ s|/announce|/scrape|ig; 282 if($orig eq $url) { 283 return undef; 284 } 285 return $url; 286} 287 288# Retrieve complete (seed) and incomplete (leech) counts for all 289# torrents at a particular tracker. 290sub get_tracker_status { 291 my($status_body) = @_; 292 293 my $s; 294 eval { $s = BitTorrent::BDecode::bdecode($status_body); }; 295 if($@) { 296 print STDERR "Invalid tracker response $@"; 297 return undef; 298 } 299 300 if(not exists $s->{'files'}) { 301 print STDERR "Tracker returned odd results (no files)\n"; 302 return undef; 303 } 304 305 my %results; 306 foreach my $f (%{$s->{'files'}}) { 307 my $v = $s->{'files'}{$f}; 308 my $fhash = bin2hex($f); 309 my $seeds = $v->{'complete'} || "0"; 310 my $leeches = $v->{'incomplete'} || "0"; 311 if(exists $results{$fhash}) { 312 print STDERR "Tracker has hash $fhash multiple times\n"; 313 } 314 $results{$fhash} = {'complete' => $seeds, 'incomplete' => $leeches}; 315 } 316 return \%results; 317} 318 319# Add commas to number 320sub commify { 321 local $_ = shift; 322 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; 323 return $_; 324} 325 326# Encode binary as hex characters 327sub bin2hex { 328 my ($d) = @_; 329 $d =~ s/(.)/sprintf("%02x",ord($1))/egs; 330 $d = lc($d); 331 return $d; 332} 333 334BEGIN { 335my $ua; 336sub get_url { 337 if(not defined $ua) { 338 $ua = LWP::UserAgent->new( 339 'env_proxy' => 1, 340 'agent' => "$PROGRAM_NAME/$VERSION ", 341 'timeout' => 15, 342 ); 343 } 344 return $ua->get($_[0]); 345} 346} 347 348sub usage_exit { 349 print <<END; 350$0 [options] [.torrent files ...] 351 352Call with one or more .torrent files or URLs to .torrent files. 353Reports both information on the .torrent file and on 354the tracker unless called with --tracker-info or --file-info. 355 356 --tracker-info 357 --file-info 358 Options: 359 --help Print this documentation 360 361 --tracker-info 362 -t Return information on the torrent's tracker 363 364 --file-info 365 -f Return information on the torrent file itself 366 367END 368 exit 1; 369} 370