=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/CurrentTorrents.pl,v retrieving revision 1.23 retrieving revision 1.30 diff -u -r1.23 -r1.30 --- openbsd/OpenBSDTorrents/CurrentTorrents.pl 2007/10/01 21:17:23 1.23 +++ openbsd/OpenBSDTorrents/CurrentTorrents.pl 2010/02/25 18:03:01 1.30 @@ -1,5 +1,5 @@ #!/usr/bin/perl -T -#$RedRiver: CurrentTorrents.pl,v 1.22 2006/07/24 18:03:53 andrew Exp $ +#$RedRiver: CurrentTorrents.pl,v 1.29 2010/01/08 17:18:35 andrew Exp $ use strict; use warnings; use diagnostics; @@ -7,6 +7,10 @@ use Time::Local; use Fcntl ':flock'; use File::Basename; + +use Transmission::Client; +use Transmission::Utils; + #use YAML; use lib 'lib'; @@ -18,201 +22,268 @@ #justme(); my $Name_Filter = shift || ''; -if ($Name_Filter =~ /^(\w*)$/) { - $Name_Filter = $1; -} else { - die "Invalid filter: $Name_Filter"; +if ( $Name_Filter =~ /^(\w*)$/ ) { + $Name_Filter = $1; } +else { + die "Invalid filter: $Name_Filter"; +} my %Possible_Torrents; -Process_Dir($OBT->{DIR_FTP}); +Process_Dir( $OBT->{DIR_FTP} ); my %files; -my %keep; my @delete; -foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) { - opendir DIR, $DIR - or die "Couldn't opendir $DIR: $!"; - foreach (readdir DIR) { - next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/; +foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) { + opendir DIR, $DIR + or die "Couldn't opendir $DIR: $!"; + foreach ( readdir DIR ) { + next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/; - if (/^([^\/]+)$/) { - $_ = $1; - } else { - die "Invalid character in $_: $!"; - } - my $epoch = 0; - my $name = basename($_, '.torrent'); + if (/^([^\/]+)$/) { + $_ = $1; + } + else { + die "Invalid character in $_: $!"; + } + my $epoch = 0; + my $name = basename( $_, '.torrent' ); - if (my ($base, $year, $mon, $mday, $hour, $min) = - /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) { + if ( my ( $base, $year, $mon, $mday, $hour, $min ) + = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ ) + { - $mon--; - $epoch = timegm(0,$min,$hour,$mday,$mon,$year); - $name = $base; - } + $mon--; + $epoch = timegm( 0, $min, $hour, $mday, $mon, $year ); + $name = $base; + } - #print "Adding $_\n"; + #print "Adding $_\n"; - $files{$ext}{$name}{$epoch} = { - file => $_, - dir => $DIR, - path => "$DIR/$_", - ext => $ext, - #year => $year, - #mon => $mon, - #mday => $mday, - #hour => $hour, - #min => $min, - name => $name, - epoch => $epoch, - }; + $files{$ext}{$name}{$epoch} = { + file => $_, + dir => $DIR, + path => "$DIR/$_", + ext => $ext, - if ( - $name =~ m/\A $OBT->{BASENAME} /xms && - ! exists $Possible_Torrents{$name} - ) { - print "Would remove $_\n"; - push @delete, $files{$ext}{$name}{$epoch}; - } - } - closedir DIR; + #year => $year, + #mon => $mon, + #mday => $mday, + #hour => $hour, + #min => $min, + name => $name, + epoch => $epoch, + }; + + if ( $name =~ m/\A $OBT->{BASENAME} /xms + && !exists $Possible_Torrents{$name} ) + { + print "Would remove $_\n"; + push @delete, $files{$ext}{$name}{$epoch}; + } + } + closedir DIR; } -foreach my $name (keys %{ $files{torrent} }) { - next unless $name =~ /^$Name_Filter/; - #print "Checking $name\n"; +#print Dump \%files; - foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) { - #print "\t$epoch\n"; - my $torrent = $files{torrent}{$name}{$epoch}{path}; +my %keep; +my %seen; +foreach my $name ( sort keys %{ $files{torrent} } ) { + next unless $name =~ /^$Name_Filter/; - if ( - keys %{ $files{torrent}{$name} } == 1 && - $files{torrent}{$name}{$epoch}{dir} - eq $OBT->{DIR_TORRENT} - ) { - #print "Skipping torrent for $name there is only one.\n"; - next; - } + #next if $name =~ /_packages_/xms; + #print "Checking $name\n"; - my $t; - eval { - $t = BT::MetaInfo::Cached->new( - $torrent, - { - cache_root => '/tmp/OBTFileCache' - #$OBT->{DIR_HOME} . '/FileCache' - } - ); - }; + my $cn = $files{torrent}{$name}; - if ($@) { - warn "Error reading torrent $torrent\n"; - next; - } +EPOCH: foreach my $epoch ( sort { $a <=> $b } keys %{$cn} ) { + my $ct = $cn->{$epoch}; + my $cf = $ct->{path}; - $files{torrent}{$name}{$epoch}{comment} = $t->{comment}; - my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s; + #print "\t$epoch - $cf\n"; - unless (-d $OBT->{DIR_FTP} . "/$path") { - #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n"; - push @delete, $files{torrent}{$name}{$epoch}; - delete $files{torrent}{$name}{$epoch}; - next; - } + my $t; + eval { + $t + = BT::MetaInfo::Cached->new( $cf, + { cache_root => '/tmp/OBTFileCache' } ); + }; - my $hash = $t->info_hash; - $hash = unpack("H*", $hash); + if ($@) { + warn "Error reading torrent $cf\n"; + push @delete, $ct; + delete $cn->{$epoch}; + next EPOCH; + } - undef $t; + $ct->{comment} = $t->{comment}; + my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s; - $files{torrent}{$name}{$epoch}{info_hash} = $hash; + if ( !-e $OBT->{DIR_FTP} . "/$path" ) { + print + 'Deleting ', + $cn->{$epoch}{file}, ' the path (', $path, + ") doesn't exist.\n"; + push @delete, $ct; + delete $cn->{$epoch}; + next EPOCH; + } + my $hash = unpack( "H*", $t->info_hash ); + $ct->{info_hash} = $hash; - if (exists $keep{$name}) { - if (exists $keep{$name}{$hash}) { - push @delete, $keep{$name}{$hash}; - delete $files{torrent}{ - $keep{$name}{$hash}{name} - }{ - $keep{$name}{$hash}{epoch} - }; - $keep{$name}{$hash} = - $files{torrent}{$name}{$epoch}; - } else { - push @delete, $files{torrent}{$name}{$epoch}; - delete $files{torrent}{$name}{$epoch}; - } - } else { - $keep{$name}{$hash} = - $files{torrent}{$name}{$epoch}; + undef $t; - } - } + if ( $seen{$name} && $seen{$name} ne $hash ) { + print "Removing older [$name] [$hash]\n"; + if ( $keep{$hash}{path} ) { + print "\t", $keep{$hash}{path}, "\n"; + } + push @delete, $ct; + delete $cn->{$epoch}; + next EPOCH; + } + $seen{$name} = $hash; + + if ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) { + $keep{$hash} = $ct; + + #print "Keeping only instance of [$name] [$hash]\n\t", + # $ct->{path}, + # "\n"; + next EPOCH; + } + elsif ( $keep{$hash} ) { + if ( $keep{$hash}{epoch} == $epoch ) { + next EPOCH; + } + + print "Removing duplicate [$name] [$hash]\n\t", + $keep{$hash}{path}, "\n"; + push @delete, $keep{$hash}; + delete $files{torrent}{ $keep{$hash}{name} } + { $keep{$hash}{epoch} }; + + $keep{$hash} = $ct; + print "Keeping additional instance of [$name] [$hash]\n\t", + $ct->{path}, + "\n"; + } + else { + $keep{$hash} = $ct; + print "Keeping first instance of [$name] [$hash]\n\t", + $ct->{path}, + "\n"; + + } + } } #print Dump \%files, \%keep, \@delete; #exit; -foreach (@delete) { - print "Deleting '$_->{path}'\n"; - unlink $_->{path} or die "Couldn't unlink $_->{path}"; -} +my $client = Transmission::Client->new; +my %seeding; +foreach my $torrent ( @{ $client->torrents } ) { -foreach my $name (keys %{ $files{$OBT->{META_EXT} } }) { - foreach my $epoch (keys %{ $files{ $OBT->{META_EXT} }{$name} }) { - unless ( exists $files{torrent}{$name}{$epoch} ) { - my $path = $files{$OBT->{META_EXT}}{$name}{$epoch}{path}; - print "Unlinking '$path'\n"; - unlink $path or die "couldn't unlink '$path': $!"; - } - } + #my $status = Transmission::Utils::from_numeric_status($torrent->status); + my $hash = $torrent->hash_string; + if ( exists $keep{$hash} ) { + $seeding{$hash} = $torrent; + } + else { + print "No longer seeding [$hash]\n"; + $torrent->stop or warn $torrent->error_string; + $client->remove( $torrent->id ) or warn $client->error; + } } - #print Dump \%keep; -foreach my $name (keys %keep) { - foreach my $hash (keys %{ $keep{$name} }) { - my $file = $keep{$name}{$hash}{file}; - my $dir = $keep{$name}{$hash}{dir }; - if ($dir eq $OBT->{DIR_NEW_TORRENT}) { - print "Moving $file to current torrents\n"; - rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file) - or die "Couldn't rename '$file': $!"; +foreach my $hash ( keys %keep ) { + my $file = $keep{$hash}{file} || q{}; + my $dir = $keep{$hash}{dir} || q{}; + if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) { + print "Moving $file to current torrents\n"; + rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file ) + or die "Couldn't rename '$file': $!"; - my $name = $keep{$name}{$hash}{name}; - my $epoch = $keep{$name}{$hash}{epoch}; + my $name = $keep{$hash}{name}; + my $epoch = $keep{$hash}{epoch}; + $dir = $OBT->{DIR_TORRENT}; - if (exists $files{txt}{$name}{$epoch}) { - my $m_file = $files{txt}{$name}{$epoch}{file}; - my $m_dir = $files{txt}{$name}{$epoch}{dir }; - rename( - "$m_dir/$m_file", - $OBT->{DIR_TORRENT} . "/" . $m_file - ) or die "Couldn't rename '$m_file': $!"; - } - } - } + if ( exists $files{txt}{$name}{$epoch} ) { + my $m_file = $files{txt}{$name}{$epoch}{file}; + my $m_dir = $files{txt}{$name}{$epoch}{dir}; + rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file ) + or die "Couldn't rename '$m_file': $!"; + } + } + + if ( !$seeding{$hash} ) { + print "Starting seed of [$file] [$hash]\n"; + if (!$client->add( + filename => "$dir/$file", + download_dir => $OBT->{DIR_FTP}, + ) + ) + { + + #warn $client->error, ": $dir/$file\n"; + print "Removing invalid torrent\n\t", $keep{$hash}{path}, "\n"; + push @delete, $keep{$hash}; + delete $files{torrent}{ $keep{$hash}{name} } + { $keep{$hash}{epoch} }; + } + } } -sub Process_Dir -{ - my $basedir = shift; +foreach (@delete) { + if ( $_->{path} ) { + print "Deleting '$_->{path}'\n"; + unlink $_->{path} or die "Couldn't unlink $_->{path}"; + } + else { + use Data::Dumper; + print Dumper $_; + } +} - my ($dirs, $files) = Get_Files_and_Dirs($basedir); - if (@$files) { - my $dir = $basedir; - $dir =~ s/^$OBT->{DIR_FTP}\///; - my $torrent = Name_Torrent($dir); - $torrent =~ s/-.*$//; - $Possible_Torrents{$torrent} = 1; +foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) { + foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) { + unless ( exists $files{torrent}{$name}{$epoch} ) { + my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path}; + print "Unlinking '$path'\n"; + unlink $path or die "couldn't unlink '$path': $!"; } + } +} - foreach my $subdir (@$dirs) { - next if $subdir eq '.'; - next if $subdir eq '..'; - Process_Dir("$basedir/$subdir") +$client->start; + +sub Process_Dir { + my $basedir = shift; + + my ( $dirs, $files ) = Get_Files_and_Dirs($basedir); + if (@$files) { + my $dir = $basedir; + $dir =~ s/^$OBT->{DIR_FTP}\///; + my $torrent = Name_Torrent($dir); + $torrent =~ s/-.*$//; + $Possible_Torrents{$torrent} = 1; + foreach my $file (@$files) { + if ( $file =~ /$INSTALL_ISO_REGEX/ ) { + $torrent = Name_Torrent("$dir/$file"); + $torrent =~ s/-.*$//; + $Possible_Torrents{$torrent} = 1; + } } + } + + foreach my $subdir (@$dirs) { + next if $subdir eq '.'; + next if $subdir eq '..'; + Process_Dir("$basedir/$subdir"); + } }