version 1.6, 2005/03/29 00:28:50 |
version 1.22, 2006/07/24 19:03:53 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl -T |
#$Id$ |
#$RedRiver: ServerTorrents.pl,v 1.21 2006/05/15 18:47:04 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use diagnostics; |
use diagnostics; |
|
|
use BT::MetaInfo; |
|
use LWP::UserAgent; |
use LWP::UserAgent; |
use Time::Local; |
use Time::Local; |
|
|
use lib 'lib'; |
use lib 'lib'; |
use OpenBSDTorrents; |
use OpenBSDTorrents; |
|
use BT::MetaInfo::Cached; |
|
|
%ENV = (); |
%ENV = (); |
|
|
|
|
|
|
justme(); |
justme(); |
|
|
my $url_torrents = 'http://openbsd.somedomain.net/dumptorrents.php'; |
|
my $url_upload = 'http://openbsd.somedomain.net/newtorrents.php'; |
|
my $url_delete = 'http://openbsd.somedomain.net/deltorrents.php'; |
|
my $url_sanity = 'http://openbsd.somedomain.net/sanity.php'; |
|
|
|
my $user = 'torrentup'; |
|
my $pass = 'ssapword'; |
|
|
|
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($url_torrents); |
my $response = $ua->get($OBT->{URL_TORRENTS}); |
|
|
my %server_torrents; |
my %server_torrents; |
if ($response->is_success) { |
if ($response->is_success) { |
|
|
s/^\s+//; |
s/^\s+//; |
s/\s+$//; |
s/\s+$//; |
next unless $_; |
next unless $_; |
my ($name, $hash) = split /\t/; |
my ($name, $hash, $disabled) = split /\t/; |
next if $name eq 'File'; |
next if $name eq 'File'; |
|
|
$name =~ s#^/torrents/##; |
$name =~ s#^/torrents/##; |
$server_torrents{$name} = $hash; |
$server_torrents{$name}{$hash} = $disabled; |
} |
} |
} |
} |
} else { |
} else { |
|
|
|
|
|
|
my %files; |
my %files; |
opendir DIR, $TorrentDir or die "Couldn't opendir $TorrentDir: $!"; |
opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; |
foreach (readdir DIR) { |
foreach (readdir DIR) { |
|
chomp; |
if (/^([^\/]+)$/) { |
if (/^([^\/]+)$/) { |
$_ = $1; |
$_ = $1; |
} else { |
} else { |
die "Invalid character in $_: $!"; |
die "Invalid character in $_: $!"; |
} |
} |
next unless /\.torrent$/; |
next unless /\.torrent$/; |
chomp; |
|
my ($name, $year, $mon, $mday, $hour, $min) = |
my ($name, $year, $mon, $mday, $hour, $min) = |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; |
|
|
my $epoch = timegm(0,$min,$hour,$mday,$mon,$year); |
my $t; |
|
eval { |
|
$t = BT::MetaInfo::Cached->new( |
|
$OBT->{DIR_TORRENT} . '/' . $_, |
|
{ |
|
cache_root => '/tmp/OBTFileCache' |
|
#$OBT->{DIR_HOME} . '/FileCache' |
|
} |
|
); |
|
}; |
|
|
|
if ($@) { |
|
warn "Error reading torrent $_\n"; |
|
next; |
|
} |
|
|
|
my $epoch = $t->creation_date; |
|
|
$files{$name}{$epoch} = { |
$files{$name}{$epoch} = { |
file => $_, |
file => $_, |
year => $year, |
details => $t, |
mon => $mon, |
name => $name, |
mday => $mday, |
|
hour => $hour, |
|
min => $min, |
|
epoch => $epoch, |
epoch => $epoch, |
}; |
}; |
|
|
} |
} |
closedir DIR; |
closedir DIR; |
|
|
#print Dump \%server_torrents, \%files; |
#use Data::Dumper; |
|
#print Dumper \%server_torrents;#, \%files; |
|
#exit; |
|
|
foreach my $name (keys %files) { |
my %torrents; |
|
FILE: foreach my $name (keys %files) { |
#print "$name\n"; |
#print "$name\n"; |
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}; |
unless (exists $server_torrents{$torrent} ) { |
|
my $time = |
my $hash = $files{$name}{$epoch}{'details'}->info_hash; |
$files{$name}{$epoch}{year} . '-' . |
$hash = unpack("H*", $hash); |
$files{$name}{$epoch}{mon} . '-' . |
|
$files{$name}{$epoch}{mday} . ' ' . |
$torrents{$torrent}{$hash} = $files{$name}{$epoch}; |
$files{$name}{$epoch}{hour} . ':' . |
|
$files{$name}{$epoch}{min} . ':00'; |
unless (exists $server_torrents{$torrent}{$hash}) { |
|
Upload_Torrent($files{$name}{$epoch}); |
Upload_Torrent($torrent, $time); |
|
} |
} |
next; |
|
} |
} |
} |
} |
|
|
foreach my $file (keys %server_torrents) { |
foreach my $torrent (keys %server_torrents) { |
my ($name, $year, $mon, $mday, $hour, $min) = |
foreach my $hash (keys %{ $server_torrents{$torrent} }) { |
$file =~ |
unless ( |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; |
exists $torrents{$torrent}{$hash} || |
unless (exists $files{$name}) { |
$server_torrents{$torrent}{$hash} == 1 |
Delete_Torrent($file); |
) { |
|
Delete_Torrent($torrent, $hash); |
|
} |
} |
} |
} |
} |
|
|
$ua->get($url_sanity); |
$ua->get($OBT->{URL_SANITY}); |
|
|
sub Upload_Torrent |
sub Upload_Torrent |
{ |
{ |
my $file = shift; |
my $torrent = shift; |
my $time = shift; |
my $t = $torrent->{'details'}; |
|
|
|
my $file = $torrent->{'file'}; |
print "Uploading $file\n"; |
print "Uploading $file\n"; |
|
|
my $t; |
|
eval { $t = BT::MetaInfo->new("$TorrentDir/$file"); }; |
|
if ($@) { |
|
warn "Error reading torrent $file\n"; |
|
return undef; |
|
} |
|
|
|
my $size = $t->total_size; |
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; |
|
|
my $i; |
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = |
|
localtime($t->creation_date); |
|
$year += 1900; |
|
$mon++; |
|
my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d", |
|
$year, $mon, $mday, $hour, $min; |
|
|
|
my $i = 0; |
while ($size > 1024) { |
while ($size > 1024) { |
$size /= 1024; |
$size /= 1024; |
$i++; |
$i++; |
|
|
$comment .= " [$size]"; |
$comment .= " [$size]"; |
$filename .= " [$time]"; |
$filename .= " [$time]"; |
|
|
my $response = $ua->post($url_upload, { |
my $response = $ua->post($OBT->{URL_UPLOAD}, { |
username => $user, |
username => $OBT->{UPLOAD_USER}, |
password => $pass, |
password => $OBT->{UPLOAD_PASS}, |
torrent => [ "$TorrentDir/$file" ], |
torrent => [ $OBT->{DIR_TORRENT} . "/$file" ], |
url => "/torrents/$file", |
url => "/torrents/$file", |
filename => $filename, |
filename => $filename, |
filedate => $time, |
filedate => $sql_time, |
info => $comment, |
info => $comment, |
hash => '', |
hash => '', |
autoset => 'enabled', # -> checked="checked" |
autoset => 'enabled', # -> checked="checked" |
|
|
|
|
sub Delete_Torrent |
sub Delete_Torrent |
{ |
{ |
my $file = shift; |
my $filename = shift; |
print "Will delete $file soon enough\n"; |
my $hash = shift; |
|
die "No hash passed!" unless $hash; |
|
|
|
print "Disabling $filename\n"; |
|
|
|
my $response = $ua->post($OBT->{'URL_DELETE'}, { |
|
username => $OBT->{UPLOAD_USER}, |
|
password => $OBT->{UPLOAD_PASS}, |
|
filename => $filename, |
|
hash => $hash, |
|
}, Content_Type => 'form-data'); |
|
|
|
if ($response->is_success) { |
|
#print $response->content; |
|
if ($response->content =~ /Torrent was removed successfully/) { |
|
print STDERR "Disabled $filename\n"; |
|
} else { |
|
print STDERR "An error occoured removing $filename\n"; |
|
} |
|
} else { |
|
die $response->status_line; |
|
} |
} |
} |