#!/usr/pkg/bin/perl -w
#
# A tool for receiving information from BitTorrent .torrent files
#
# (C) 2003  Oskar Liljeblad <oskar@osk.mine.nu>.
#
# This software is copyrighted work licensed under the terms of the
# GNU General Public License. Please consult the file `COPYING' for
# details.
#

use Getopt::Long;
#use Convert::Bencode qw(bencode bdecode);
use Digest::SHA1 qw(sha1 sha1_hex);
use Digest::MD5;
use POSIX qw(strftime);
#use strict;

$| = 1;
$::digest = undef;
$::opt_verbose = 0;
$::opt_path_separator = '/';
$::opt_pathstrip = 0;
@::cmd_fields = ();
Getopt::Long::config('bundling');
Getopt::Long::GetOptions(
	'i|info-hash'    => \$::cmd_info_hash,
	'f|field=s'      => \@::cmd_fields,
	'a|all-fields'   => \$::cmd_all_fields,
	'l|list'         => \$::cmd_list_files,
	'c|check'        => \$::cmd_check,
	'g|generate=s'   => \$::cmd_generate,
	'v|verbose+'     => \$::opt_verbose,
	'p|strip=i'      => \$::opt_pathstrip,
	'help'           => \$::cmd_help,
	'version'        => \$::cmd_version,
) or exit 1;

if ($::cmd_help) {
	print "Usage: $0 [OPTION]... FILE...\n";
	print "\n";
	print "  -i, --info-hash      display the info MD5 hash of the torrent\n";
	print "  -f, --field=NAME     display a specific field in the torrent\n";
	print "  -a, --all-fields     display all fields in the torrent\n";
	print "  -l, --list           list files in torrent\n";
	print "  -c, --check          check local files against checksums in torrent\n";
	print "  -g, --generate=TYPE  generate checksums for local files\n";
	print "  -v, --verbose        explain what is being done\n";
	print "  -p, --strip=NUM      strip NUM leading path components (list/compare)\n";
	print "      --help           display this help and exit\n";
	print "      --version        output version information and exit\n";
	print "\n";
	print "The --generate option requires a parameter specifying type of checksums\n";
	print "to generate - either \`MD5' or \`SHA1'. The generate command implies\n";
	print "--check since checksums cannot be generated without the local files.\n";
	print "\n";
	print "Report bugs to <oskar\@osk.mine.nu>.\n";
	exit;
}
if ($::cmd_version) {
	print "torrenttool (torrentutils) 0.3.0\n";
	print "Written by Oskar Liljeblad.\n";
	print "\n";
	print "Copyright (C) 2003 Oskar Liljeblad.\n";
	print "This is free software; see the source for copying conditions.  There is NO\n";
	print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
	exit;
}

if (defined $::cmd_generate) {
	$::digest = new Digest::MD5  if uc $::cmd_generate eq 'MD5';
	$::digest = new Digest::SHA1 if uc $::cmd_generate eq 'SHA1';
	die "$0: invalid algorithm `".quote($::cmd_generate)."' for `--generate'\n" if (!defined $::digest);
}
if (!$::cmd_info_hash && !@::cmd_fields
    && !$::cmd_all_fields && !$::cmd_list_files
		&& !$::cmd_check && !$::cmd_generate) {
	die "$0: nothing to do\n";
}
die "$0: missing torrent file argument\n" if (!@ARGV);

foreach my $torfile (@ARGV) {
	eval {
		my $data;
		my $count;
		open(FILE, '<', $torfile) || die "$torfile: cannot open - $!\n";
		binmode(FILE) || die "$torfile: cannot set binary mode - $!\n";
		$count = read(FILE, $data, 11);
		die "$torfile: cannot read - $!\n" if (!defined $count);
		die "$torfile: premature end of file\n" if ($count != 11);
		die "$torfile: not a torrent file\n" if ($data ne 'd8:announce');
		my $size = (-s FILE) - 11;
		$count = read(FILE, $data, $size, 11);
		die "$torfile: cannot read - $!\n" if (!defined $count);
		die "$torfile: premature end of file\n" if ($count != $size);

		my $fields = bdecode($data);
		my $info = $$fields{info};

		if ($::cmd_info_hash) {
			my $infohash = sha1_hex(bencode($$fields{info}));
			print "$infohash\n";
		}
		if ($::cmd_list_files) {
			if (exists $$info{files}) {
				foreach my $file (@{$$info{files}}) {
					my @path = ($$info{'name'}, @{$$file{'path'}});
					splice @path, 0, min($::opt_pathstrip, scalar(@path)-1);
					printfile(join($::opt_path_separator, @path), $$file{length});
				}
			} else {
				printfile($$info{name}, $$info{length});
			}
		}
		if ($::cmd_all_fields) {
			@::cmd_fields = sort keys %$fields;
		}
		foreach my $name (@::cmd_fields) {
			my $value = lookupfield($fields, $name);
			if (!defined $value) {
				warn "$torfile: $name: no such field\n";
				next;
			}
			dumpfield($name, $value, $name, 0);
		}
		if ($::cmd_check || $::cmd_generate) {
			if (exists $$info{files}) {
				my @files = ();
				my $totalsize = 0;
				foreach my $file (@{$$info{files}}) {
					my @path = ($$info{'name'}, @{$$file{'path'}});
					splice @path, 0, min($::opt_pathstrip, scalar(@path)-1);
					push @files, [ join($::opt_path_separator, @path), $$file{'length'}, $totalsize ];
					$totalsize += $$file{'length'};
				}
				checkpieces($info, $::digest, $totalsize, @files) || exit 1;
			} else {
				checkpieces($info, $::digest, $$info{'length'}, [ $$info{'name'}, $$info{'length'}, 0 ]) || exit 1;
			}
		}
	};
	warn "$@" if ($@);
	close(FILE); # might be closed already, but we don't care
}

sub quote {
	my ($str) = @_;
	my %esc = (
		"\b" => 'b', "\f" => 'f', "\n" => 'n', "\r" => 'r', "\t" => 't',
	  "\013" => 'v', '\\' => '\\', "'" => "'", '"' => '"',
	);
	$str =~ s/([^[:print:]])/'\\'.($esc{$1} ? $esc{$1} : sprintf('%03o', ord($1)))/eg;
	return $str;
}

sub min {
	my $min = shift;
	foreach my $value (@_) {
		$min = $value if ($value < $min);
	}
	return $min;
}

sub max {
	my $max = shift;
	foreach my $value (@_) {
		$max = $value if ($value > $max);
	}
	return $max;
}

sub checkpieces {
	my ($info,$digest,$totalsize,@files) = @_;
	my $genpiecelen = $$info{'piece length'};		# length of each piece except last
	my $pieces = $$info{'pieces'};							# checksums for pieces
	my ($f0, $f1) = (0, 0); 										# first and last file in a piece
	my $maxnamelen = max(map { length quote(${$_}[0]) } @files); # for output purposes

	$digest->reset if defined $digest;

	for (my $c = 0; $c < length($pieces)/20; $c++) {
		my $piecepos = $c * $genpiecelen;												# start of piece relative to all torrent data
		my $pieceend = min($piecepos+$genpiecelen, $totalsize); # end of piece relative to all torrent data

		for ($f0 = $f1; ${$files[$f0]}[1] + ${$files[$f0]}[2] < $piecepos; $f0++) {}
		for ($f1 = $f0; ${$files[$f1]}[1] + ${$files[$f1]}[2] < $pieceend; $f1++) {}
		my @piecefiles = @files[$f0..$f1];

		my $data = '';
		my $datalen = 0;
		foreach my $file (@piecefiles) {
			my ($name,$size,$start,$state,$fh,$goodpieces,$checksum) = @{$file};
			my $readlen = min($pieceend, $start+$size)-($piecepos+$datalen);

			if (@{$file} <= 3) {										# open file if not open already
				if (!-f $name) {
					$state = 'MISSING';
				}	elsif (!open($fh, '<', $name)) {
					warn "$name: cannot open - $!\n";
					$state = "ERROR - $!";
				}
				$goodpieces = 0;
				$checksum = undef;
			}

			if (defined $fh) {
				my $newdata = '';
				my $read = read($fh, $newdata, $readlen);
				if (!defined $read) {
					warn "$name: cannot read - $!\n";
					$state = "ERROR - $!";
					close($fh);
					$fh = undef;
				}	elsif ($read != $readlen) {
					if (!defined $state) {
						$state = ($read == 0 ? 'TOO SHORT' : 'INDETERMINABLE');
					}
					close($fh);
					$fh = undef;
				}	elsif (defined $digest) {
					$digest->add($newdata);
					if ($start+$size <= $pieceend) {
						$checksum = $digest->hexdigest;
						$digest->reset;
					}
				}
				$data .= $newdata;
			}
			elsif (!defined $state) {
				$state = 'INDETERMINABLE';
			}

			@{$file} = ($name,$size,$start,$state,$fh,$goodpieces,$checksum);
			$datalen += $readlen;
		}

		if (length($data) == $datalen) {
			my $goodpiece = (sha1($data) eq substr($pieces, $c*20, 20));
			foreach my $file (@piecefiles) {
				my ($name,$size,$start,$state,$fh,$goodpieces,$checksum) = @{$file};
				#print "file=$name piece=$c piecefiles=",scalar @piecefiles," goodpiece=$goodpiece state: ", (defined $state ? $state : 'UNSET');
				if (!defined $state) {
					if (!$goodpiece) {
						$state = (@piecefiles > 1 ? 'INDETERMINABLE' : 'FAILED');
					} elsif ($start+$size <= $pieceend) {
						$state = (eof $fh ? 'OK' : 'TOO LONG');
					}
				}
				elsif ($state eq 'INDETERMINABLE' && !$goodpiece && @piecefiles == 1) {
					# If the state was set to INDETERMINABLE before, we can now
					# prove it is FAILED because an isolated piece (a piece that
					# belongs to a single file only) was FAILED.
					$state = 'FAILED';
				}
				#print " => ", (defined $state ? $state : 'UNSET'), "\n";
				$goodpieces += $goodpiece;
				@{$file} = ($name,$size,$start,$state,$fh,$goodpieces,$checksum);
			}
		}
		else {
			foreach my $file (@piecefiles) {
				my ($name,$size,$start,$state,$fh,$goodpieces,$checksum) = @{$file};
				$state = 'INDETERMINABLE' if (!defined $state);
				@{$file} = ($name,$size,$start,$state,$fh,$goodpieces,$checksum);
			}
		}

		foreach my $file (@piecefiles) {
			my ($name,$size,$start,$state,$fh,$goodpieces,$checksum) = @{$file};
			if ($start+$size <= $pieceend) {
				my $piececount = int(($start%$genpiecelen + $size + $genpiecelen-1)/$genpiecelen);
				if ($::cmd_check) {
					if ($::opt_verbose <= 0) {
						printf "\%${maxnamelen}s \%s\n", quote($name), $state if $state ne 'OK';
					} elsif ($::opt_verbose == 1) {
						printf "\%${maxnamelen}s \%s\n", quote($name), $state;
					} elsif ($::opt_verbose >= 2) {
						printf "\%${maxnamelen}s \%s (%d%% correct, %d/%d pieces)\n", quote($name),
							$state, ($goodpieces/$piececount)*100, $goodpieces, $piececount;
					}
				}
				print $checksum, '  ', quote($name), "\n" if (defined $digest && $state eq 'OK');
				close($fh) if defined $fh;
			}
		}
	}

	my $badfiles = grep { ${$_}[3] ne 'OK' } @files;
	if ($::opt_verbose == 1) {
		printf '%s: %d of %d file(s) failed check%s', $0, $badfiles, scalar @files, "\n";
	}
	return $badfiles == 0;
}

sub printfile {
	my ($name,$size) = @_;
	if ($::opt_verbose >= 1) {
		printf "\%10d \%s\n", $size, $name;
	} else {
		print $name, "\n";
	}
}

sub formatfield {
	my ($key, $value) = @_;
	if ($key eq 'info/pieces' && $::opt_verbose < 1) {
		return '.. ('.length($value).' bytes)';
	} elsif ($key eq 'creation date' && $value =~ /^-?\d+$/) {
		return POSIX::strftime('%F %T', localtime $value)." ($value)";
	} elsif ($value =~ /^-?\d+$/) {
		return $value;	
	}
	return '"'.quote($value).'"';
}

sub dumpfield {
	my ($name, $value, $fullname, $ident) = @_;
	if (ref $value eq 'HASH') {
		print '  'x$ident, quote($name)." (dict)\n";
		foreach my $key (keys %$value) {
			dumpfield($key, $$value{$key}, $fullname.'/'.$key, $ident+1);
		}
	} elsif (ref $value eq 'ARRAY') {
		print '  'x$ident, quote($name)." (list)\n";
		for (my $c = 0; $c < @$value; $c++) {
			dumpfield($c+1, $$value[$c], $fullname.'/'.($c+1), $ident+1);
		}
	} else {
		print '  'x$ident, quote($name), ' = ', formatfield($fullname, $value), "\n";
	}
}

sub lookupfield {
	my ($fields, $field) = @_;
	return $fields if (!defined $field);
	my ($head,$rest) = ($field =~ /^((?:[^\\\/]|\\\/|\\\\)*)(?:\/(.*))?$/);
	$head =~ s/\\([\\\/])/$1/g;
	if (ref $fields eq 'HASH') {
		return lookupfield($$fields{$head}, $rest) if (exists $$fields{$head});
	} elsif (ref $fields eq 'ARRAY') {
		return lookupfield($$fields[$head-1], $rest) if ($head =~ /^[1-9]\d*$/ && $head <= @$fields);
	}
	return undef;
}
sub bencode {
	my ($item) = @_;
	return 'd'.join('', map { bencode($_).bencode(${$item}{$_}) } sort keys %{$item}).'e'
		if (ref $item eq 'HASH');
	return 'l'.join('', map { bencode($_) } @{$item}).'e' if (ref $item eq 'ARRAY');
	return 'i'.$item.'e' if ($item =~ /^(0|-?[1-9][0-9]*)$/);
	return length($item).':'.$item;
}

sub bdecode {
	my ($data) = @_;
	my @queue = ([]);
	for (my $c = 0; $c < length $data; $c++) {
		my $ch = substr($data, $c, 1);
		my ($value, $e);

		if ($ch eq 'e') {
			if (ref $queue[0] eq 'HASH') {
				die "value for key missing\n" if defined ${$queue[0]}{'KEY'};
				%{$queue[0]} = %{${$queue[0]}{'HASH'}};
			}
			shift @queue;
			next;
		} elsif ($ch eq 'i') {
			for ($e = $c+1; substr($data, $e, 1) ne 'e'; $e++) {}
			$value = substr($data, $c+1, $e-$c-1);
			$c = $e;
		} elsif ($ch ge '0' && $ch le '9') {
			for ($e = $c+1; substr($data, $e, 1) ne ':'; $e++) {}
			my $len = int(substr($data, $c, $e-$c));
			$value = substr($data, $e+1, $len);
			$c = $e + $len;
		} elsif ($ch eq 'l') {
			$value = [];
		} elsif ($ch eq 'd') {
			$value = { 'HASH'=>{}, 'KEY'=>undef };
		}

		if (ref $queue[0] eq 'ARRAY') {
			push @{$queue[0]}, $value;
		} else {
			my $key = ${$queue[0]}{'KEY'};
			if (defined $key) {
				${${$queue[0]}{'HASH'}}{$key} = $value;
				${$queue[0]}{'KEY'} = undef;
			} else {
				die "bad key type\n" if $ch lt '0' || $ch gt '9';
				${$queue[0]}{'KEY'} = $value;
			}
		}

		unshift @queue, $value if $ch eq 'l' || $ch eq 'd';
	}
	return ${$queue[0]}[0];
}
