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