#! /usr/bin/perl -w
#
# BitTorrent file Virtual File System for Midnight Commander
#
# (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 Convert::Bencode qw(bdecode bencode);
use POSIX;
use Digest::SHA1 qw(sha1 sha1_hex);

die "Usage: $0 COMMAND [OPTION]...\n" if @ARGV < 2;
my $cmd = shift;
my $archive = shift;

if ($cmd eq 'list' || $cmd eq 'copyout') {
	die "missing argument\n" if $cmd eq 'copyout' && @ARGV < 2;
	my @filestat = stat($archive);
	die "$archive: cannot stat - $!\n" if !@filestat;
	my ($archivesize,$archivetime) = @filestat[7,9];
	$archivetime = POSIX::strftime('%m-%d-%Y %H:%M', localtime $archivetime);
	open(FILE, '<', $archive) || die "$archive: cannot open - $!\n";
	read(FILE, $data, $archivesize) || die "$archive: cannot read - $!\n";
	close(FILE);
	my $fields = bdecode($data);
	my $info = $$fields{info};

	my $filessize = 0;
	my $filescount = 0;
	if (exists $$info{files}) {
		foreach my $file (@{$$info{files}}) {
			printfile(join('/', 'CONTENTS', $$info{name}, @{$$file{path}}), $$file{'length'}, $archivetime) if $cmd eq 'list';
			$filessize += $$file{'length'};
			$filescount++;
		}
	} else {
		printfile('CONTENTS/'.$$info{name}, $$info{length}, $archivetime) if $cmd eq 'list';
		$filessize += $$info{length};
		$filescount++;
	}
	printfile('INFO', 0, $archivetime) if $cmd eq 'list';
	printfields('FIELDS', $fields, $archivetime) if $cmd eq 'list';

	if ($cmd eq 'copyout') {
		my $infile = shift;
		my $outfile = shift;
		if ($infile eq 'INFO') {
			open(FILE, '>', $outfile) || die "$outfile: cannot create - $!\n";
			print FILE 'Announce URL:  ', $$fields{announce}, "\n";
			print FILE 'Info Hash:     ', sha1_hex(bencode($$fields{info})), "\n";
			print FILE "\n";
			print FILE 'Total Size:    ', $filessize, "\n";
			print FILE 'File Count:    ', $filescount, "\n";
			print FILE "\n";
			print FILE 'Piece Length:  ', $$info{'piece length'}, "\n";
			print FILE 'Piece Count:   ', length($$info{'pieces'})/20, "\n";
			print FILE "\n";
			if (exists $$fields{'creation date'}) {
				print FILE "Creation Date: ", POSIX::strftime('%F %T', localtime $$fields{'creation date'}), "\n";
			}
			if (exists $$fields{'comment'}) {
				print FILE "Comment:\n", $$fields{'comment'}, "\n";
			}
			close(FILE);
		}
		elsif (substr($infile, 0, 7) eq 'FIELDS/') {
			my $field = $fields;
			my $path = substr($infile, 7);
			foreach my $name (split(/\//, $path)) {
				if (ref($field) eq 'HASH') {
					die "$archive: no such field `$path'\n" if !exists ${$field}{$name};
					$field = ${$field}{$name};
				}
				elsif (ref($field) eq 'ARRAY') {
					die "$archive: no such field `$path'\n" if $name !~ /^\d+$/ || $name >= @{$field};
					$field = ${$field}[$name];
				}
				else {
					die "$archive: no such field `$path'\n";
				}
			}
			die "$archive: no such end-field `$path'\n" if ref($field);
			open(FILE, '>', $outfile) || die "$outfile: cannot create - $!\n";
			print FILE $field;
			close(FILE);
		}
		else {
			die "$0: extracting not supported\n";
		}
	}
}
else {
	exit 1;
}

sub printfile {
	my ($name, $size, $time) = @_;
	printf "----------    1 user     group \%11s \%s \%s\n", $size, $time, $name;
}

sub printfields {
	my ($base,$field,$time) = @_;
	if (ref($field) eq 'HASH') {
		foreach my $key (keys %{$field}) {
			printfields($base.'/'.$key, ${$field}{$key}, $time);
		}
	}
	elsif (ref($field) eq 'ARRAY') {
		my $len = length scalar @{$field};
		for (my $c = 0; $c < @{$field}; $c++) {
			printfields(sprintf("\%s/\%0${len}d", $base, $c), ${$field}[$c], $time);
		}
	}
	else {
		printfile($base, length($field), $time);
	}
}
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];
}
