=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/ServerTorrents.pl,v retrieving revision 1.27 retrieving revision 1.28 diff -u -r1.27 -r1.28 --- openbsd/OpenBSDTorrents/ServerTorrents.pl 2008/12/29 22:04:00 1.27 +++ openbsd/OpenBSDTorrents/ServerTorrents.pl 2010/01/07 18:50:02 1.28 @@ -1,5 +1,5 @@ #!/usr/bin/perl -T -#$RedRiver: ServerTorrents.pl,v 1.26 2008/12/29 22:02:14 andrew Exp $ +#$RedRiver: ServerTorrents.pl,v 1.27 2008/12/29 22:04:00 andrew Exp $ use strict; use warnings; use diagnostics; @@ -7,6 +7,7 @@ use LWP::UserAgent; use Time::Local; use File::Basename; + #use YAML; use lib 'lib'; @@ -17,207 +18,205 @@ justme(); -my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti'); +my @Sizes = ( '', 'Ki', 'Mi', 'Gi', 'Ti' ); my $ua = LWP::UserAgent->new; -my $response = $ua->get($OBT->{URL_TORRENTS}); +my $response = $ua->get( $OBT->{URL_TORRENTS} ); my %server_torrents; -if ($response->is_success) { - my $content = $response->content; # or whatever - $content =~ s/^.*//s || die "Beginning of list not found!"; - $content =~ s/.*$//s || die "End of list not found!"; - unless ($content =~ /No data/) { - foreach (split /\n/, $content) { +if ( $response->is_success ) { + my $content = $response->content; # or whatever + $content =~ s/^.*//s + || die "Beginning of list not found!"; + $content =~ s/.*$//s || die "End of list not found!"; + unless ( $content =~ /No data/ ) { + foreach ( split /\n/, $content ) { s/^\s+//; s/\s+$//; next unless $_; - my ($name, $hash, $disabled) = split /\t/; + my ( $name, $hash, $disabled ) = split /\t/; next if $name eq 'File'; $name =~ s#.*/##; - $server_torrents{$name}{$hash} = $disabled; + $server_torrents{$hash} = { + name => $name, + disabled => $disabled, + }; } } -} else { +} +else { die $response->status_line; } -my %files; -opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; -foreach (readdir DIR) { - chomp; - if (/^([^\/]+)$/) { - $_ = $1; - } else { - die "Invalid character in $_: $!"; - } - next unless /\.torrent$/; +my %torrents; +opendir DIR, $OBT->{DIR_TORRENT} + or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; +foreach my $torrent ( readdir DIR ) { + chomp $torrent; + next unless $torrent =~ /\.torrent$/; - my $name = basename($_, '.torrent'); + if ($torrent =~ /^([^\/]+)$/) { + $torrent = $1; + } + else { + die "Invalid character in $torrent: $!"; + } - if (my ($base, $year, $mon, $mday, $hour, $min) = - /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) { - $name = $base; - } + my $name = basename( $torrent, '.torrent' ); - my $t; - eval { - $t = BT::MetaInfo::Cached->new( - $OBT->{DIR_TORRENT} . '/' . $_, - { - cache_root => '/tmp/OBTFileCache' - #$OBT->{DIR_HOME} . '/FileCache' - } - ); - }; + if ( my ( $base, $year, $mon, $mday, $hour, $min ) + = $torrent =~ /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ ) + { + $name = $base; + } - if ($@) { - warn "Error reading torrent $_\n"; - next; - } + my $t; + eval { + $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} = { - file => $_, - details => $t, - name => $name, - epoch => $epoch, - }; + #my $epoch = $t->creation_date; + 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} ); + } } closedir DIR; #print Dump \%server_torrents; -#print Dump \%files; #exit; -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; +foreach my $hash ( keys %server_torrents ) { - $torrents{$torrent}{$hash} = $files{$name}{$epoch}; - - unless (exists $server_torrents{$torrent}{$hash}) { - Upload_Torrent($files{$name}{$epoch}); - } - } + #printf "SERVER: [%s] [%s]\n", $hash, $torrent; + if ( ( !exists $torrents{$hash} ) + && ( !$server_torrents{$hash}{disabled} ) ) + { + Delete_Torrent( $server_torrents{$hash}{name}, $hash ); + } } -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); - } - } -} +$ua->get( $OBT->{URL_SANITY} ); -$ua->get($OBT->{URL_SANITY}); +sub Upload_Torrent { + my $torrent = shift; + my $t = $torrent->{'details'}; -sub Upload_Torrent -{ - my $torrent = shift; - my $t = $torrent->{'details'}; + my $file = $torrent->{'file'}; + print "Uploading $file\n"; - my $file = $torrent->{'file'}; - print "Uploading $file\n"; + 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 $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; + ( $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; - ($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 ) { + $size /= 1024; + $i++; + } + $size = sprintf( '%.2f', $size ); + $size .= $Sizes[$i] . 'B'; - my $i = 0; - while ($size > 1024) { - $size /= 1024; - $i++; - } - $size = sprintf('%.2f', $size); - $size .= $Sizes[$i] . 'B'; - - my $comment = $t->{comment}; - $comment =~ s/\n.*$//s; - - my $filename = - $comment =~ /($OBT->{BASENAME}.+)/ ? $1 - : $file; - $filename =~ s#/# #g; - $filename =~ s/\.torrent\z//; - - $comment .= " [$size]"; - $filename .= " [$time]"; + my $comment = $t->{comment}; + $comment =~ s/\n.*$//s; - my $response = $ua->post($OBT->{URL_UPLOAD}, { - username => $OBT->{UPLOAD_USER}, - password => $OBT->{UPLOAD_PASS}, - torrent => [ $OBT->{DIR_TORRENT} . "/$file" ], - url => "/torrents/$file", - filename => $filename, - filedate => $sql_time, - info => $comment, - hash => '', - autoset => 'enabled', # -> checked="checked" - }, Content_Type => 'form-data'); + my $filename + = $comment =~ /($OBT->{BASENAME}.+)/ + ? $1 + : $file; + $filename =~ s#/# #g; + $filename =~ s/\.torrent\z//; - if ($response->is_success) { - print STDERR "Uploaded $file\n"; - #print $response->content; - } else { - die $response->status_line; - } + $comment .= " [$size]"; + $filename .= " [$time]"; + + my $response = $ua->post( + $OBT->{URL_UPLOAD}, + { username => $OBT->{UPLOAD_USER}, + password => $OBT->{UPLOAD_PASS}, + torrent => [ $OBT->{DIR_TORRENT} . "/$file" ], + url => "/torrents/$file", + filename => $filename, + filedate => $sql_time, + info => $comment, + hash => '', + autoset => 'enabled', # -> checked="checked" + }, + Content_Type => 'form-data' + ); + + if ( $response->is_success ) { + print STDERR "Uploaded $file\n"; + + #print $response->content; + } + else { + die $response->status_line; + } } -sub Delete_Torrent -{ - my $filename = shift; - my $hash = shift; - die "No hash passed!" unless $hash; +sub Delete_Torrent { + my $filename = shift; + my $hash = shift; + die "No hash passed!" unless $hash; - print "Removing $filename [$hash]\n"; + 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'); + 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"\>([^<]+)\is_success ) { + my ($result) = $response->content =~ /class="error"\>([^<]+)\status_line . " removing $filename [$hash]\n"; - } + if ( $result eq 'Torrent was removed successfully.' ) { + print STDERR "Removed $filename [$hash]\n"; + } + 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"; + } }