#!/usr/bin/perl -w # tristan+perl@ethereal.net 16apr2005, 11jul2006 # display & unlink completed torrents # with many thanks to Doug Bagley (most code lifted from bttools) # TODO: -v to show overall rate since creation of torrent file use strict; use Getopt::Std; use vars qw($opt_u); getopts('u'); sub bdecode { my ($dataref) = @_; unless (ref($dataref) eq 'SCALAR') { die 'Function bdecode takes a scalar ref!'; } my $p = 0; return benc_parse_hash($dataref,\$p); } sub benc_parse_hash { my ($data, $p) = @_; my $c = substr($$data,$$p,1); my $r = undef; if ($c eq 'd') { %{$r} = (); ++$$p; while ($$p < length($$data) && substr($$data, $$p, 1) ne 'e') { my $k = benc_parse_string($data, $p); my $start = $$p; $r->{'_' . $k . '_start'} = $$p if $k eq 'info'; my $v = benc_parse_hash($data, $p); $r->{'_' . $k . '_length'} = ($$p - $start) if $k eq 'info'; $r->{$k} = $v; } ++$$p; } elsif ($c eq 'l') { @{$r} = \(); ++$$p; while (substr($$data, $$p, 1) ne 'e') { push @{$r}, benc_parse_hash($data, $p); } ++$$p; } elsif ($c eq 'i') { $r = 0; my $c; ++$$p; while (($c = substr($$data,$$p,1)) ne 'e') { $r *= 10; $r += int($c); ++$$p; } # while ++$$p; } elsif ($c =~ /\d/) { $r = benc_parse_string($data, $p); } else { die "Unknown token '$c' at $p!"; } $r; } sub benc_parse_string { my ($data, $p) = @_; my $l = 0; my $c = undef; my $s; while (($c = substr($$data,$$p,1)) ne ':') { $l *= 10; $l += int($c); ++$$p; } ++$$p; $s = substr($$data,$$p,$l); $$p += $l; $s; } sub check_complete { my($self, $dir, $verbose) = @_; $dir ||= '.'; my $plen = $self->piece_length; my $pi = 0; my $pa = $self->pieces_array; my $name = $self->name; my %stats = (); my @files = (); my $total_size = $self->total_size; my $file_info = $self->file_info; @files = keys %$file_info; print STDERR "[verifying " if $verbose; my $total_read = 0; my $buf = ''; my $off = 0; my $len = $plen; my $last_dots = 0; my($file); my @status = (); my $ok = 1; @files = sort @files; while (1) { my $nrd; $file = shift @files; last if (!defined $file); my $path = "$dir/$file"; $path =~ s!//+!/!g; local *FH; unless (open(FH, "<$path")) { print STDERR qq{\nError opening "$path" for input ($!)} if $verbose; next; } while ($nrd = sysread(FH, $buf, $len, $off)) { $total_read += $nrd; my $dots = int(50 * ($total_read / $total_size)); if ($dots > $last_dots) { for ($last_dots .. ($dots - 1)) { print STDERR (0 == ($_ % 5)) ? ($_/5) : '.' if $verbose; } $last_dots = $dots; } $off += $nrd; if ($off == $plen) { # we have read a complete piece, so check it unless ($status[$pi] = (Digest::SHA1::sha1($buf) eq $pa->[$pi])) { $ok = 0; } $pi++; # setup for next piece $len = $plen; $off = 0; $buf = ''; } else { # was partial read, so we'll continue on next iteration $len -= $nrd; } } print STDERR qq{read error on "$file" ($!)} if (!defined $nrd); if ($buf) { $status[$pi] = (Digest::SHA1::sha1($buf) eq $pa->[$pi]); } close(FH); unless (@files) { my $complete = ($ok and ($total_read == $total_size)) ? 'ALL OK' : 'INCOMPLETE!'; print STDERR " EOF" if ($last_dots < 50 and $verbose); print STDERR "] $complete\n" if $verbose; my $f_beg = 0; my @files = keys %$file_info; while (my $file = shift @files) { my $f_end = $f_beg + $file_info->{$file}; my $pi = int($f_beg / $plen); my $p_beg = $pi * $plen; my $p_end = $p_beg + $plen; print STDERR "$file:\n" if ($verbose > 1); while ($p_beg < $f_end) { if ($status[$pi]) { my $ok_bytes = $plen; $ok_bytes -= $f_beg - $p_beg if ($p_beg < $f_beg); $ok_bytes -= $p_end - $f_end if ($p_end > $f_end); $stats{$file} += $ok_bytes; printf(STDERR " %4d: OK\n", $pi) if ($verbose > 1); } else { printf(STDERR " %4d: BAD\n", $pi) if ($verbose > 1); } $p_beg += $plen; $p_end += $plen; $pi++; } $f_beg = $f_end; } return \%stats; } } print STDERR "]\n" if $verbose; return undef; } for my $file (@ARGV) { print "$file: "; local *TOR; if (!open(TOR, $file)) { print "doesn't exist!\n"; next; } binmode(TOR); my $body; read(TOR, $body, (-s $file)); close(TOR); my $t = bdecode(\$body); my $info = $t->{'info'}; my @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 @files, \%file_record; } } else { $tsize += $info->{'length'}, push @files, { 'size' => $info->{'length'}, 'name' => $info->{'name'}, }; } my $fileordir = $file; $fileordir =~ s/\.torrent$//; my $complete; if ($#files == 0) { # single file in torrent if (-f $fileordir) { # downloaded as basename of torrent $complete = (-s $fileordir) / $tsize; } else { # downloaded into dir named after basename of torrent my $fn = $fileordir . '/' . $files[0]{'name'}; $complete = (-s $fn) / $tsize; } } else { # multiple files in torrent my $dlsize; foreach my $f (@files) { # btlaunchmany* in "--saveas_style 4" (default) mode appears to # strip leading directory name; why? need to look into this more. my $fn = $f->{'name'}; $fn =~ s/^[^\/]*\//$fileordir\//; $dlsize += -s $fn; } $complete = $dlsize / $tsize; } printf "%.1f%% complete", $complete * 100; if ($complete == 1 && $opt_u) { unlink $file; print " -- unlinked"; } print "\n"; }