=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/ServerTorrents.pl,v retrieving revision 1.14 retrieving revision 1.31 diff -u -r1.14 -r1.31 --- openbsd/OpenBSDTorrents/ServerTorrents.pl 2005/05/05 21:33:42 1.14 +++ openbsd/OpenBSDTorrents/ServerTorrents.pl 2012/09/01 17:36:37 1.31 @@ -1,169 +1,227 @@ #!/usr/bin/perl -T -#$Id: ServerTorrents.pl,v 1.14 2005/05/05 20:33:42 andrew Exp $ +#$RedRiver: ServerTorrents.pl,v 1.29 2010/03/08 20:19:37 andrew Exp $ use strict; use warnings; use diagnostics; use LWP::UserAgent; use Time::Local; +use File::Basename; +#use YAML; + use lib 'lib'; use OpenBSDTorrents; use BT::MetaInfo::Cached; %ENV = (); -#use YAML; - 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) = split /\t/; + my ( $name, $hash, $disabled ) = split /\t/; next if $name eq 'File'; - $name =~ s#^/torrents/##; - $server_torrents{$name} = $hash; + $name =~ s#.*/##; + $server_torrents{$hash} = { + name => $name, + disabled => $disabled, + }; } } -} else { +} +else { die $response->status_line; } +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 %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 ($name, $year, $mon, $mday, $hour, $min) = - /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; + if ($torrent =~ /^([^\/]+)$/) { + $torrent = $1; + } + else { + die "Invalid character in $torrent: $!"; + } - my $time = "$year.$mon.$mday $hour:$min"; + my $name = basename( $torrent, '.torrent' ); - $mon--; + if ( my ( $base, $year, $mon, $mday, $hour, $min ) + = $torrent =~ /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ ) + { + $name = $base; + } - my $epoch = timegm(0,$min,$hour,$mday,$mon,$year); + my $t; + eval { + $t = BT::MetaInfo::Cached->new( + $OBT->{DIR_TORRENT} . '/' . $torrent, + { cache_root => '/tmp/OBTFileCache' - $files{$name}{$epoch} = { - file => $_, - year => $year, - mon => $mon, - mday => $mday, - hour => $hour, - min => $min, - time => $time, - epoch => $epoch, - }; + #$OBT->{DIR_HOME} . '/FileCache' + } + ); + }; + if ($@) { + warn "Error reading torrent $torrent\n"; + next; + } + #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} ); + } + elsif ( $server_torrents{$hash}{disabled} ) { + Update_Torrent( $server_torrents{$hash}{name}, $hash ); + } } closedir DIR; -#print Dump \%server_torrents, \%files; +#print Dump \%server_torrents; +#exit; -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}; - unless (exists $server_torrents{$torrent} ) { - #my $time = - # $files{$name}{$epoch}{year} . '-' . - # $files{$name}{$epoch}{mon} . '-' . - # $files{$name}{$epoch}{mday} . ' ' . - # $files{$name}{$epoch}{hour} . ':' . - # $files{$name}{$epoch}{min} . ':00'; - - Upload_Torrent($torrent, $files{$name}{$epoch}{time}); - } - next; - } -} +foreach my $hash ( keys %server_torrents ) { -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); - } + #printf "SERVER: [%s] [%s]\n", $hash, $torrent; + if ( ( !exists $torrents{$hash} ) + && ( !$server_torrents{$hash}{disabled} ) ) + { + Update_Torrent( $server_torrents{$hash}{name}, $hash, 1 ); + } } -$ua->get($OBT->{URL_SANITY}); +$ua->get( $OBT->{URL_SANITY} ); -sub Upload_Torrent -{ - my $file = shift; - my $time = shift; +sub Upload_Torrent { + my $torrent = shift; + my $t = $torrent->{'details'}; - print "Uploading $file\n"; + my $file = $torrent->{'file'}; + #print "Uploading $file\n"; - my $t; - eval { $t = BT::MetaInfo::Cached->new("$OBT->{DIR_TORRENT}/$file"); }; - if ($@) { - warn "Error reading torrent $file\n"; - return undef; - } + 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; + ( $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 $comment = $t->{comment}; - $comment =~ s/\n.*$//s; - - my ($filename) = $comment =~ /Files from (.+)/; - $filename =~ s#/# #g; - - $comment .= " [$size]"; - $filename .= " [$time]"; + my $i = 0; + while ( $size > 1024 ) { + $size /= 1024; + $i++; + } + $size = sprintf( '%.2f', $size ); + $size .= $Sizes[$i] . 'B'; - 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 => $time, - info => $comment, - hash => '', - autoset => 'enabled', # -> checked="checked" - }, Content_Type => 'form-data'); + my $comment = $t->{comment}; + $comment =~ s/\n.*$//s; - if ($response->is_success) { - print STDERR "Uploaded $file\n"; - #print $response->content; - } else { - die $response->status_line; - } + my $filename + = $comment =~ /($OBT->{BASENAME}.+)/ + ? $1 + : $file; + $filename =~ s#/# #g; + $filename =~ s/\.torrent\z//; + + $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 $file = shift; - print "Will delete $file soon enough\n"; +sub Update_Torrent { + my $filename = shift; + my $hash = shift; + my $disable = shift || 0; + die "No hash passed!" unless $hash; + + #print "Removing $filename [$hash]\n"; + + my $response = $ua->post( + $OBT->{'URL_UPDATE'}, + { username => $OBT->{UPLOAD_USER}, + password => $OBT->{UPLOAD_PASS}, + hash => $hash, + disable => $disable, + }, + Content_Type => 'form-data' + ); + my $status = $disable ? 'Disabled' : 'Enabled'; + + if ( $response->is_success ) { + my ($result) = $response->content =~ /class="error"\>([^<]+)\status_line . " removing $filename [$hash]\n"; + } }