=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/ServerTorrents.pl,v retrieving revision 1.22 retrieving revision 1.27 diff -u -r1.22 -r1.27 --- openbsd/OpenBSDTorrents/ServerTorrents.pl 2006/07/24 19:03:53 1.22 +++ openbsd/OpenBSDTorrents/ServerTorrents.pl 2008/12/29 22:04:00 1.27 @@ -1,11 +1,13 @@ #!/usr/bin/perl -T -#$RedRiver: ServerTorrents.pl,v 1.21 2006/05/15 18:47:04 andrew Exp $ +#$RedRiver: ServerTorrents.pl,v 1.26 2008/12/29 22:02:14 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'); @@ -35,7 +35,7 @@ my ($name, $hash, $disabled) = split /\t/; next if $name eq 'File'; - $name =~ s#^/torrents/##; + $name =~ s#.*/##; $server_torrents{$name}{$hash} = $disabled; } } @@ -43,7 +43,6 @@ die $response->status_line; } - my %files; opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; foreach (readdir DIR) { @@ -54,9 +53,14 @@ 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( @@ -85,8 +89,8 @@ } closedir DIR; -#use Data::Dumper; -#print Dumper \%server_torrents;#, \%files; +#print Dump \%server_torrents; +#print Dump \%files; #exit; my %torrents; @@ -95,10 +99,9 @@ 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}; unless (exists $server_torrents{$torrent}{$hash}) { @@ -109,9 +112,12 @@ foreach my $torrent (keys %server_torrents) { foreach my $hash (keys %{ $server_torrents{$torrent} }) { - unless ( - exists $torrents{$torrent}{$hash} || - $server_torrents{$torrent}{$hash} == 1 + #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); } @@ -154,8 +160,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]"; @@ -186,7 +195,7 @@ my $hash = shift; die "No hash passed!" unless $hash; - print "Disabling $filename\n"; + print "Removing $filename [$hash]\n"; my $response = $ua->post($OBT->{'URL_DELETE'}, { username => $OBT->{UPLOAD_USER}, @@ -196,13 +205,19 @@ }, 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"; + my ($result) = $response->content =~ /class="error"\>([^<]+)\status_line; + elsif ($result) { + 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"; } }