#! /usr/bin/perl -w
#!/usr/bin/perl -w
package Convert::Bencode;

=head1 NAME

Convert::Bencode - Functions for converting to/from bencoded strings

=head1 SYNOPSIS

  use Convert::Bencode qw(bencode bdecode);

  my $string = "d4:ainti12345e3:key5:value4:type4:teste";
  my $hashref = bdecode($string);

  foreach my $key (keys(%{$hashref})) {
      print "Key: $key, Value: ${$hashref}{$key}\n";
  }

  my $encoded_string = bencode($hashref);
  print $encoded_string."\n";

=head1 DESCRIPTION

This module provides two functions, C<bencode> and C<bdecode>, which
encode and decode bencoded strings respectivly.

=head2 Encoding

C<bencode()> expects to be passed a single value, which is either a scalar, 
a arrary ref, or a hash ref, and it returns a scalar containing the bencoded 
representation of the data structure it was passed. If the value passed was 
a scalar, it returns either a bencoded string, or a bencoded integer (floating 
points are not implemented, and would be returned as a string rather than a 
integer). If the value was a array ref, it returns a bencoded list, with all 
the values of that array also bencoded recursivly. If the value was a hash ref,
it returns a bencoded dictionary (which for all intents and purposes can be 
thought of as a synonym for hash) containing the recursivly bencoded key and 
value pairs of the hash.

=head2 Decoding

C<bdecode()> expects to be passed a single scalar containing the bencoded string
to be decoded. Its return value will be either a hash ref, a array ref, or a
scalar, depending on whether the outer most element of the bencoded string
was a dictionary, list, or a string/integer respectivly.

=head1 SEE ALSO

The description of bencode is part of the bittorrent protocol specification
which can be found at http://bitconjurer.org/BitTorrent/protocol.html

=head1 BUGS

None that I know of.

=head1 AUTHOR & COPYRIGHT

Created by R. Kyle Murphy <orclev@rejectedmaterial.com>, aka Orclev.

Copyright 2003 R. Kyle Murphy. All rights reserved. Convert::Bencode
is free software; you may redistribute it and/or modify it under the
same terms as Perl itself.

=cut

use strict;
use warnings;

BEGIN {
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS);

	$VERSION 	= 1.02;
	@ISA		= qw(Exporter);
	@EXPORT_OK	= qw(&bencode &bdecode);
	@EXPORT_FAIL	= qw(&_dechunk);
	%EXPORT_TAGS	= (all => [qw(&bencode &bdecode)]);
}
our @EXPORT_OK;

END { }

sub bencode {
	my $item = shift;
	my $line = '';
	if(ref($item) eq 'HASH') {
		$line = 'd';
		foreach my $key (sort(keys %{$item})) {
			$line .= bencode($key);
			$line .= bencode(${$item}{$key});
		}
		$line .= 'e';
		return $line;
	}
	if(ref($item) eq 'ARRAY') {
		$line = 'l';
		foreach my $l (@{$item}) {
			$line .= bencode($l);
		}
		$line .= 'e';
		return $line;
	}
	if($item =~ /^\d+$/) {
		$line = 'i';
		$line .= $item;
		$line .= 'e';
		return $line;
	}
	$line = length($item).":";
	$line .= $item;
	return $line;
}

sub bdecode {
	my $string = shift;
	my @chunks = split(//, $string);
	my $root = _dechunk(\@chunks);
	return $root;
}

sub _dechunk {
	my $chunks = shift;

	my $item = shift(@{$chunks});
	if($item eq 'd') {
		$item = shift(@{$chunks});
		my %hash;
		while($item ne 'e') {
			unshift(@{$chunks}, $item);
			my $key = _dechunk($chunks);
			$hash{$key} = _dechunk($chunks);
			$item = shift(@{$chunks});
		}
		return \%hash;
	}
	if($item eq 'l') {
		$item = shift(@{$chunks});
		my @list;
		while($item ne 'e') {
			unshift(@{$chunks}, $item);
			push(@list, _dechunk($chunks));
			$item = shift(@{$chunks});
		}
		return \@list;
	}
	if($item eq 'i') {
		my $num;
		$item = shift(@{$chunks});
		while($item ne 'e') {
			$num .= $item;
			$item = shift(@{$chunks});
		}
		return $num;
	}
	if($item =~ /\d/) {
		my $num;
		while($item =~ /\d/) {
			$num .= $item;
			$item = shift(@{$chunks});
		}
		my $line = '';
		for(1 .. $num) {
			$line .= shift(@{$chunks});
		}
		return $line;
	}
	return $chunks;
}

1;
#! /usr/bin/perl -w

use Getopt::Long;

use Digest::SHA1 qw(sha1 sha1_hex);
use Digest::MD5;
use POSIX qw(strftime);
use strict;

$::version = '0.2.0';
$| = 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 (torrenutils) $::version\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;
		open(FILE, '<', $torfile) || die "$torfile: cannot open - $!\n";
		binmode(FILE) || die "$torfile: cannot set binary mode - $!\n";
		read(FILE, $data, 11) == 11 || die "$torfile: cannot read - $!\n";
		die "$torfile: not a torrent file\n" if ($data ne 'd8:announce');
		my $size = (-s FILE) - 11;
		read(FILE, $data, $size, 11) == $size || die "$torfile: cannot read - $!\n";

		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 = ();
				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'} ];
				}
				checkpieces($info, $::digest, @files);
			} else {
				checkpieces($info, $::digest, [ $$info{'name'}, $$info{'length'} ]);
			}
		}
	};
	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 checkpieces {
	my ($info,$digest,@files) = @_;
	my $piecelen = $$info{'piece length'};
	my $pieces = $$info{'pieces'};
	my $missing = 0;

	my ($curfile,$curfilelen) = ();
	for (my $c = 0; $c < length($pieces)/20; $c++) {
		my $data = '';
		my $readbytes = 0;
		my @blockfiles = ();
		my @donefiles = ();
		my $pad = 0;

		$missing = 0 if !defined $curfile;
		while (length($data)+$pad < $piecelen) {
			if (!defined $curfile) {
				last if !@files;
				($curfile,$curfilelen) = @{shift @files};
				push @blockfiles, $curfile;
				if (!open(FILE, '<', $curfile)) {
					warn "$curfile: cannot open - $!\n";
					$missing = 1;
				}
				$digest->reset if defined $digest;
			}

			$readbytes = min($piecelen-length($data)-$pad, $curfilelen);
			$curfilelen -= $readbytes;
			if ($missing) {
				$pad += $readbytes;
			} else {
				my $readdata;
				read(FILE, $readdata, $readbytes);
				$data .= $readdata;
				$digest->add($readdata) if defined $digest;
			}
			if ($curfilelen <= 0) {
				my $sum = defined $digest ? $digest->hexdigest : undef;
				push @donefiles, [ $curfile, $sum ];
				undef $curfile;
				close(FILE);
			}
		}

		if ($missing) {
			foreach my $file (@blockfiles) {
				print quote($file)." INDETERMINABLE\n";
			}
		} else {
			my $sum1 = sha1($data);
			my $sum2 = substr($pieces, $c*20, 20);
			if ($sum1 eq $sum2) {
				foreach my $spec (@donefiles) {
					my ($file, $sum) = @{$spec};
					print quote($file)." OK\n" if $::cmd_check;
					print "$sum  $file\n" if defined $digest;
				}
			} else {
				print quote($_)." FAILED\n" foreach (@blockfiles);
			}
		}
	}

	close(FILE); # FILE might be closed already here
}

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