#! /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;


# TorrentSniff  http://www.highprogrammer.com/alan/perl/torrentsniff.html
# - 2003-05-29 - Changes by Alan De Smet (http://www.highprogrammer.com/alan/)
#      - Alan's changes are released under the "MIT License" as listed below:
#        (And frankly, they're pretty dumb changes, I mostly just slashed and
#        burned stuff I didn't need or couldn't implement from TorrentSpy.)
#
# - Based on vesion 0.1.0.3-BETA of TorrentSpy from http://torrentspy.sf.net/
#   Copyright 2003 "knowbuddy" who is at users.sourceforge.net
#   SourceForge indicates "MIT License"
#
#   The MIT License:
#
#	Permission is hereby granted, free of charge, to any person obtaining a
#	copy of this software and associated documentation files (the "Software"),
#	to deal in the Software without restriction, including without limitation
#	the rights to use, copy, modify, merge, publish, distribute, sublicense,
#	and/or sell copies of the Software, and to permit persons to whom the
#	Software is furnished to do so, subject to the following conditions:
#
#	The above copyright notice and this permission notice shall be included in
#	all copies or substantial portions of the Software.
#
#	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
#	IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
#	FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
#	AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
#	LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
#	FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
#	DEALINGS IN THE SOFTWARE.

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;
}
