| version 1.21, 2006/05/15 19:47:04 |
version 1.26, 2008/12/29 22:02:14 |
|
|
| #!/usr/bin/perl -T |
#!/usr/bin/perl -T |
| #$RedRiver: ServerTorrents.pl,v 1.20 2005/06/03 01:32:40 andrew Exp $ |
#$RedRiver: ServerTorrents.pl,v 1.25 2008/09/23 16:35:45 andrew Exp $ |
| use strict; |
use strict; |
| use warnings; |
use warnings; |
| use diagnostics; |
use diagnostics; |
| |
|
| use LWP::UserAgent; |
use LWP::UserAgent; |
| use Time::Local; |
use Time::Local; |
| |
use File::Basename; |
| |
#use YAML; |
| |
|
| use lib 'lib'; |
use lib 'lib'; |
| use OpenBSDTorrents; |
use OpenBSDTorrents; |
|
|
| |
|
| %ENV = (); |
%ENV = (); |
| |
|
| #use YAML; |
|
| |
|
| justme(); |
justme(); |
| |
|
| my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti'); |
my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti'); |
|
|
| my ($name, $hash, $disabled) = split /\t/; |
my ($name, $hash, $disabled) = split /\t/; |
| next if $name eq 'File'; |
next if $name eq 'File'; |
| |
|
| $name =~ s#^/torrents/##; |
$name =~ s#.*/##; |
| $server_torrents{$name}{$hash} = $disabled; |
$server_torrents{$name}{$hash} = $disabled; |
| } |
} |
| } |
} |
|
|
| die $response->status_line; |
die $response->status_line; |
| } |
} |
| |
|
| |
|
| my %files; |
my %files; |
| opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; |
opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; |
| foreach (readdir DIR) { |
foreach (readdir DIR) { |
|
|
| die "Invalid character in $_: $!"; |
die "Invalid character in $_: $!"; |
| } |
} |
| next unless /\.torrent$/; |
next unless /\.torrent$/; |
| my ($name, $year, $mon, $mday, $hour, $min) = |
|
| /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; |
|
| |
|
| |
my $name = basename($_, '.torrent'); |
| |
|
| |
if (my ($base, $year, $mon, $mday, $hour, $min) = |
| |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) { |
| |
$name = $base; |
| |
} |
| |
|
| my $t; |
my $t; |
| eval { |
eval { |
| $t = BT::MetaInfo::Cached->new( |
$t = BT::MetaInfo::Cached->new( |
| $OBT->{DIR_TORRENT} . '/' . $_, |
$OBT->{DIR_TORRENT} . '/' . $_, |
| { |
{ |
| cache_root => |
cache_root => '/tmp/OBTFileCache' |
| $OBT->{DIR_HOME} . '/FileCache' |
#$OBT->{DIR_HOME} . '/FileCache' |
| } |
} |
| ); |
); |
| }; |
}; |
|
|
| } |
} |
| closedir DIR; |
closedir DIR; |
| |
|
| #use Data::Dumper; |
#print Dump \%server_torrents; |
| #print Dumper \%server_torrents;#, \%files; |
#print Dump \%files; |
| #exit; |
#exit; |
| |
|
| my %torrents; |
my %torrents; |
|
|
| foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) { |
foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) { |
| #print "\t$epoch\n"; |
#print "\t$epoch\n"; |
| my $torrent = $files{$name}{$epoch}{file}; |
my $torrent = $files{$name}{$epoch}{file}; |
| |
my $hash = unpack("H*", $files{$name}{$epoch}{'details'}->info_hash ); |
| |
#printf "LOCAL: [%s] [%s]\n", $hash, $torrent; |
| |
|
| my $hash = $files{$name}{$epoch}{'details'}->info_hash; |
|
| $hash = unpack("H*", $hash); |
|
| |
|
| $torrents{$torrent}{$hash} = $files{$name}{$epoch}; |
$torrents{$torrent}{$hash} = $files{$name}{$epoch}; |
| |
|
| unless (exists $server_torrents{$torrent}{$hash}) { |
unless (exists $server_torrents{$torrent}{$hash}) { |
|
|
| |
|
| foreach my $torrent (keys %server_torrents) { |
foreach my $torrent (keys %server_torrents) { |
| foreach my $hash (keys %{ $server_torrents{$torrent} }) { |
foreach my $hash (keys %{ $server_torrents{$torrent} }) { |
| unless ( |
#printf "SERVER: [%s] [%s]\n", $hash, $torrent; |
| exists $torrents{$torrent}{$hash} || |
if ((! exists $torrents{$torrent}{$hash}) && |
| $server_torrents{$torrent}{$hash} == 1 |
defined $server_torrents{$torrent}{$hash} && |
| |
$server_torrents{$torrent}{$hash} != 1 |
| ) { |
) { |
| Delete_Torrent($torrent, $hash); |
Delete_Torrent($torrent, $hash); |
| } |
} |
|
|
| my $comment = $t->{comment}; |
my $comment = $t->{comment}; |
| $comment =~ s/\n.*$//s; |
$comment =~ s/\n.*$//s; |
| |
|
| my ($filename) = $comment =~ /Files from (.+)/; |
my $filename = |
| |
$comment =~ /($OBT->{BASENAME}.+)/ ? $1 |
| |
: $file; |
| $filename =~ s#/# #g; |
$filename =~ s#/# #g; |
| |
$filename =~ s/\.torrent\z//; |
| |
|
| $comment .= " [$size]"; |
$comment .= " [$size]"; |
| $filename .= " [$time]"; |
$filename .= " [$time]"; |
|
|
| my $hash = shift; |
my $hash = shift; |
| die "No hash passed!" unless $hash; |
die "No hash passed!" unless $hash; |
| |
|
| print "Disabling $filename\n"; |
print "Removing $filename [$hash]\n"; |
| |
|
| my $response = $ua->post($OBT->{'URL_DELETE'}, { |
my $response = $ua->post($OBT->{'URL_DELETE'}, { |
| username => $OBT->{UPLOAD_USER}, |
username => $OBT->{UPLOAD_USER}, |
|
|
| }, Content_Type => 'form-data'); |
}, Content_Type => 'form-data'); |
| |
|
| if ($response->is_success) { |
if ($response->is_success) { |
| #print $response->content; |
my ($result) = $response->content =~ /class="error"\>([^<]+)\</; |
| if ($response->content =~ /Torrent was removed successfully/) { |
|
| print STDERR "Disabled $filename\n"; |
if ($result eq 'Torrent was removed successfully.') { |
| } else { |
print STDERR "Removed $filename [$hash]\n"; |
| print STDERR "An error occoured removing $filename\n"; |
|
| } |
} |
| } else { |
elsif ($result) { |
| die $response->status_line; |
print STDERR "Error: $result (removing $filename [$hash])\n"; |
| |
} |
| |
else { |
| |
print STDERR "An unknown error occurred removing $filename [$hash]\n"; |
| |
} |
| |
} |
| |
else { |
| |
die $response->status_line . " removing $filename [$hash]\n"; |
| } |
} |
| } |
} |