version 1.23, 2007/10/01 21:17:23 |
version 1.30, 2011/12/08 02:08:09 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl -T |
#$RedRiver: ServerTorrents.pl,v 1.22 2006/07/24 18:03:53 andrew Exp $ |
#$RedRiver: ServerTorrents.pl,v 1.29 2010/03/08 20:19:37 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 File::Basename; |
|
|
#use YAML; |
#use YAML; |
|
|
use lib 'lib'; |
use lib 'lib'; |
|
|
|
|
justme(); |
justme(); |
|
|
my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti'); |
my @Sizes = ( '', 'Ki', 'Mi', 'Gi', 'Ti' ); |
my $ua = LWP::UserAgent->new; |
my $ua = LWP::UserAgent->new; |
|
|
my $response = $ua->get($OBT->{URL_TORRENTS}); |
my $response = $ua->get( $OBT->{URL_TORRENTS} ); |
|
|
my %server_torrents; |
my %server_torrents; |
if ($response->is_success) { |
if ( $response->is_success ) { |
my $content = $response->content; # or whatever |
my $content = $response->content; # or whatever |
$content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!"; |
$content =~ s/^.*<!-- BEGIN LIST -->//s |
$content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!"; |
|| die "Beginning of list not found!"; |
unless ($content =~ /No data/) { |
$content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!"; |
foreach (split /\n/, $content) { |
unless ( $content =~ /No data/ ) { |
|
foreach ( split /\n/, $content ) { |
s/^\s+//; |
s/^\s+//; |
s/\s+$//; |
s/\s+$//; |
next unless $_; |
next unless $_; |
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{$hash} = { |
|
name => $name, |
|
disabled => $disabled, |
|
}; |
} |
} |
} |
} |
} else { |
} |
|
else { |
die $response->status_line; |
die $response->status_line; |
} |
} |
|
|
my %files; |
my %torrents; |
opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; |
opendir DIR, $OBT->{DIR_TORRENT} |
foreach (readdir DIR) { |
or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; |
chomp; |
foreach my $torrent ( readdir DIR ) { |
if (/^([^\/]+)$/) { |
chomp $torrent; |
$_ = $1; |
next unless $torrent =~ /\.torrent$/; |
} else { |
|
die "Invalid character in $_: $!"; |
|
} |
|
next unless /\.torrent$/; |
|
|
|
my $name = basename($_, '.torrent'); |
if ($torrent =~ /^([^\/]+)$/) { |
|
$torrent = $1; |
|
} |
|
else { |
|
die "Invalid character in $torrent: $!"; |
|
} |
|
|
if (my ($base, $year, $mon, $mday, $hour, $min) = |
my $name = basename( $torrent, '.torrent' ); |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) { |
|
$name = $base; |
|
} |
|
|
|
my $t; |
if ( my ( $base, $year, $mon, $mday, $hour, $min ) |
eval { |
= $torrent =~ /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ ) |
$t = BT::MetaInfo::Cached->new( |
{ |
$OBT->{DIR_TORRENT} . '/' . $_, |
$name = $base; |
{ |
} |
cache_root => '/tmp/OBTFileCache' |
|
#$OBT->{DIR_HOME} . '/FileCache' |
|
} |
|
); |
|
}; |
|
|
|
if ($@) { |
my $t; |
warn "Error reading torrent $_\n"; |
eval { |
next; |
$t = BT::MetaInfo::Cached->new( |
} |
$OBT->{DIR_TORRENT} . '/' . $torrent, |
|
{ cache_root => '/tmp/OBTFileCache' |
|
|
my $epoch = $t->creation_date; |
#$OBT->{DIR_HOME} . '/FileCache' |
|
} |
|
); |
|
}; |
|
if ($@) { |
|
warn "Error reading torrent $torrent\n"; |
|
next; |
|
} |
|
|
$files{$name}{$epoch} = { |
#my $epoch = $t->creation_date; |
file => $_, |
|
details => $t, |
|
name => $name, |
|
epoch => $epoch, |
|
}; |
|
|
|
|
my $hash = unpack( "H*", $t->info_hash ); |
|
$torrents{$hash} = { |
|
file => $torrent, |
|
details => $t, |
|
name => $name, |
|
#epoch => $epoch, |
|
}; |
|
|
|
if ( !exists $server_torrents{$hash} ) { |
|
Upload_Torrent( $torrents{$hash} ); |
|
} |
|
elsif ( $server_torrents{$hash}{disabled} ) { |
|
Update_Torrent( $server_torrents{$hash}{name}, $hash ); |
|
} |
} |
} |
closedir DIR; |
closedir DIR; |
|
|
#print Dump \%server_torrents; |
#print Dump \%server_torrents; |
#print Dump \%files; |
|
#exit; |
#exit; |
|
|
my %torrents; |
foreach my $hash ( keys %server_torrents ) { |
FILE: foreach my $name (keys %files) { |
|
#print "$name\n"; |
|
foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) { |
|
#print "\t$epoch\n"; |
|
my $torrent = $files{$name}{$epoch}{file}; |
|
|
|
my $hash = $files{$name}{$epoch}{'details'}->info_hash; |
#printf "SERVER: [%s] [%s]\n", $hash, $torrent; |
$hash = unpack("H*", $hash); |
if ( ( !exists $torrents{$hash} ) |
|
&& ( !$server_torrents{$hash}{disabled} ) ) |
|
{ |
|
Update_Torrent( $server_torrents{$hash}{name}, $hash, 1 ); |
|
} |
|
} |
|
|
$torrents{$torrent}{$hash} = $files{$name}{$epoch}; |
$ua->get( $OBT->{URL_SANITY} ); |
|
|
unless (exists $server_torrents{$torrent}{$hash}) { |
sub Upload_Torrent { |
Upload_Torrent($files{$name}{$epoch}); |
my $torrent = shift; |
} |
my $t = $torrent->{'details'}; |
} |
|
} |
|
|
|
foreach my $torrent (keys %server_torrents) { |
my $file = $torrent->{'file'}; |
foreach my $hash (keys %{ $server_torrents{$torrent} }) { |
#print "Uploading $file\n"; |
unless ( |
|
exists $torrents{$torrent}{$hash} || |
|
$server_torrents{$torrent}{$hash} == 1 |
|
) { |
|
Delete_Torrent($torrent, $hash); |
|
} |
|
} |
|
} |
|
|
|
$ua->get($OBT->{URL_SANITY}); |
my $size = $t->total_size; |
|
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) |
|
= gmtime( $t->creation_date ); |
|
$year += 1900; |
|
$mon++; |
|
my $time = sprintf "%04d.%02d.%02d %02d:%02d", |
|
$year, $mon, $mday, $hour, $min; |
|
|
sub Upload_Torrent |
( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) |
{ |
= localtime( $t->creation_date ); |
my $torrent = shift; |
$year += 1900; |
my $t = $torrent->{'details'}; |
$mon++; |
|
my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d", |
|
$year, $mon, $mday, $hour, $min; |
|
|
my $file = $torrent->{'file'}; |
my $i = 0; |
print "Uploading $file\n"; |
while ( $size > 1024 ) { |
|
$size /= 1024; |
|
$i++; |
|
} |
|
$size = sprintf( '%.2f', $size ); |
|
$size .= $Sizes[$i] . 'B'; |
|
|
my $size = $t->total_size; |
my $comment = $t->{comment}; |
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = |
$comment =~ s/\n.*$//s; |
gmtime($t->creation_date); |
|
$year += 1900; |
|
$mon++; |
|
my $time = sprintf "%04d.%02d.%02d %02d:%02d", |
|
$year, $mon, $mday, $hour, $min; |
|
|
|
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = |
my $filename |
localtime($t->creation_date); |
= $comment =~ /($OBT->{BASENAME}.+)/ |
$year += 1900; |
? $1 |
$mon++; |
: $file; |
my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d", |
$filename =~ s#/# #g; |
$year, $mon, $mday, $hour, $min; |
$filename =~ s/\.torrent\z//; |
|
|
my $i = 0; |
$comment .= " [$size]"; |
while ($size > 1024) { |
$filename .= " [$time]"; |
$size /= 1024; |
|
$i++; |
|
} |
|
$size = sprintf('%.2f', $size); |
|
$size .= $Sizes[$i] . 'B'; |
|
|
|
my $comment = $t->{comment}; |
|
$comment =~ s/\n.*$//s; |
|
|
|
my $filename = |
|
$comment =~ /Files from (.+)/ ? $1 |
|
: $file; |
|
$filename =~ s#/# #g; |
|
$filename =~ s/\.torrent\z//; |
|
|
|
$comment .= " [$size]"; |
|
$filename .= " [$time]"; |
|
|
|
my $response = $ua->post($OBT->{URL_UPLOAD}, { |
my $response = $ua->post( |
username => $OBT->{UPLOAD_USER}, |
$OBT->{URL_UPLOAD}, |
password => $OBT->{UPLOAD_PASS}, |
{ username => $OBT->{UPLOAD_USER}, |
torrent => [ $OBT->{DIR_TORRENT} . "/$file" ], |
password => $OBT->{UPLOAD_PASS}, |
url => "/torrents/$file", |
torrent => [ $OBT->{DIR_TORRENT} . "/$file" ], |
filename => $filename, |
url => "/torrents/$file", |
filedate => $sql_time, |
filename => $filename, |
info => $comment, |
filedate => $sql_time, |
hash => '', |
info => $comment, |
autoset => 'enabled', # -> checked="checked" |
hash => '', |
}, Content_Type => 'form-data'); |
autoset => 'enabled', # -> checked="checked" |
|
}, |
|
Content_Type => 'form-data' |
|
); |
|
|
if ($response->is_success) { |
if ( $response->is_success ) { |
print STDERR "Uploaded $file\n"; |
print STDERR "Uploaded $file\n"; |
#print $response->content; |
|
} else { |
#print $response->content; |
die $response->status_line; |
} |
} |
else { |
|
die $response->status_line; |
|
} |
} |
} |
|
|
sub Delete_Torrent |
sub Update_Torrent { |
{ |
my $filename = shift; |
my $filename = shift; |
my $hash = shift; |
my $hash = shift; |
my $disable = shift || 0; |
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( |
username => $OBT->{UPLOAD_USER}, |
$OBT->{'URL_UPDATE'}, |
password => $OBT->{UPLOAD_PASS}, |
{ username => $OBT->{UPLOAD_USER}, |
filename => $filename, |
password => $OBT->{UPLOAD_PASS}, |
hash => $hash, |
filename => $filename, |
}, Content_Type => 'form-data'); |
hash => $hash, |
|
disable => $disable, |
|
}, |
|
Content_Type => 'form-data' |
|
); |
|
my $status = $disable ? 'Disabled' : 'Enabled'; |
|
|
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 disabled set to ' . $disable ) { |
} else { |
print STDERR "$status $filename [$hash]\n"; |
print STDERR "An error occoured removing $filename\n"; |
} |
} |
elsif ($result) { |
} else { |
print STDERR "Error: $result (removing $filename [$hash])\n"; |
die $response->status_line; |
} |
} |
else { |
|
print STDERR |
|
"An unknown error occurred removing $filename [$hash]\n"; |
|
} |
|
} |
|
else { |
|
die $response->status_line . " removing $filename [$hash]\n"; |
|
} |
} |
} |