=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/ServerTorrents.pl,v retrieving revision 1.19 retrieving revision 1.26 diff -u -r1.19 -r1.26 --- openbsd/OpenBSDTorrents/ServerTorrents.pl 2005/05/21 01:48:03 1.19 +++ openbsd/OpenBSDTorrents/ServerTorrents.pl 2008/12/29 22:02:14 1.26 @@ -1,11 +1,13 @@ #!/usr/bin/perl -T -#$Id: ServerTorrents.pl,v 1.19 2005/05/21 00:48:03 andrew Exp $ +#$RedRiver: ServerTorrents.pl,v 1.25 2008/09/23 16:35:45 andrew Exp $ use strict; use warnings; use diagnostics; use LWP::UserAgent; use Time::Local; +use File::Basename; +#use YAML; use lib 'lib'; use OpenBSDTorrents; @@ -13,8 +15,6 @@ %ENV = (); -#use YAML; - justme(); my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti'); @@ -32,18 +32,17 @@ s/^\s+//; s/\s+$//; next unless $_; - my ($name, $hash) = split /\t/; + my ($name, $hash, $disabled) = split /\t/; next if $name eq 'File'; - $name =~ s#^/torrents/##; - $server_torrents{$name} = $hash; + $name =~ s#.*/##; + $server_torrents{$name}{$hash} = $disabled; } } } else { die $response->status_line; } - my %files; opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; foreach (readdir DIR) { @@ -54,16 +53,21 @@ die "Invalid character in $_: $!"; } 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; eval { $t = BT::MetaInfo::Cached->new( $OBT->{DIR_TORRENT} . '/' . $_, { - cache_root => - $OBT->{DIR_HOME} . '/FileCache' + cache_root => '/tmp/OBTFileCache' + #$OBT->{DIR_HOME} . '/FileCache' } ); }; @@ -85,32 +89,36 @@ } closedir DIR; -#print Dump \%server_torrents, \%files; +#print Dump \%server_torrents; +#print Dump \%files; +#exit; -foreach my $name (keys %files) { +my %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 = 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}; - next if ( - exists $server_torrents{$torrent} && - $server_torrents{$torrent} eq $hash - ); - - Upload_Torrent($files{$name}{$epoch}); + unless (exists $server_torrents{$torrent}{$hash}) { + Upload_Torrent($files{$name}{$epoch}); + } } } -foreach my $file (keys %server_torrents) { - my ($name, $year, $mon, $mday, $hour, $min) = - $file =~ - /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; - unless (exists $files{$name}) { - Delete_Torrent($file); +foreach my $torrent (keys %server_torrents) { + foreach my $hash (keys %{ $server_torrents{$torrent} }) { + #printf "SERVER: [%s] [%s]\n", $hash, $torrent; + if ((! exists $torrents{$torrent}{$hash}) && + defined $server_torrents{$torrent}{$hash} && + $server_torrents{$torrent}{$hash} != 1 + ) { + Delete_Torrent($torrent, $hash); + } } } @@ -150,8 +158,11 @@ my $comment = $t->{comment}; $comment =~ s/\n.*$//s; - my ($filename) = $comment =~ /Files from (.+)/; + my $filename = + $comment =~ /($OBT->{BASENAME}.+)/ ? $1 + : $file; $filename =~ s#/# #g; + $filename =~ s/\.torrent\z//; $comment .= " [$size]"; $filename .= " [$time]"; @@ -178,6 +189,33 @@ sub Delete_Torrent { - my $file = shift; - print "Will delete $file soon enough\n"; + my $filename = shift; + my $hash = shift; + die "No hash passed!" unless $hash; + + print "Removing $filename [$hash]\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) { + my ($result) = $response->content =~ /class="error"\>([^<]+)\status_line . " removing $filename [$hash]\n"; + } }