[BACK]Return to ServerTorrents.pl CVS log [TXT][DIR] Up to [local] / openbsd / OpenBSDTorrents

Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.25

1.1       andrew      1: #!/usr/bin/perl -T
1.25    ! andrew      2: #$RedRiver: ServerTorrents.pl,v 1.24 2007/11/02 02:36:01 andrew Exp $
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
                      7: use LWP::UserAgent;
                      8: use Time::Local;
1.23      andrew      9: use File::Basename;
                     10: #use YAML;
1.1       andrew     11:
                     12: use lib 'lib';
                     13: use OpenBSDTorrents;
1.14      andrew     14: use BT::MetaInfo::Cached;
1.1       andrew     15:
                     16: %ENV = ();
                     17:
1.5       andrew     18: justme();
1.1       andrew     19:
1.3       andrew     20: my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti');
1.1       andrew     21: my $ua = LWP::UserAgent->new;
                     22:
1.10      andrew     23: my $response = $ua->get($OBT->{URL_TORRENTS});
1.1       andrew     24:
                     25: my %server_torrents;
                     26: if ($response->is_success) {
                     27:     my $content = $response->content;  # or whatever
                     28:     $content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!";
                     29:     $content =~ s/<!-- END LIST -->.*$//s   || die "End of list not found!";
                     30:     unless ($content =~ /No data/) {
                     31:         foreach (split /\n/, $content) {
                     32:             s/^\s+//;
                     33:             s/\s+$//;
                     34:             next unless $_;
1.20      andrew     35:             my ($name, $hash, $disabled) = split /\t/;
1.1       andrew     36:             next if $name eq 'File';
                     37:
1.25    ! andrew     38:             $name =~ s#.*/##;
1.20      andrew     39:             $server_torrents{$name}{$hash} = $disabled;
1.1       andrew     40:         }
                     41:     }
                     42: } else {
                     43:     die $response->status_line;
                     44: }
                     45:
                     46: my %files;
1.10      andrew     47: opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
1.1       andrew     48: foreach (readdir DIR) {
1.8       andrew     49:        chomp;
1.1       andrew     50:        if (/^([^\/]+)$/) {
                     51:                $_ = $1;
                     52:        } else {
                     53:                die "Invalid character in $_: $!";
                     54:        }
                     55:        next unless /\.torrent$/;
1.23      andrew     56:
                     57:        my $name = basename($_, '.torrent');
                     58:
                     59:        if (my ($base, $year, $mon, $mday, $hour, $min) =
                     60:           /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) {
                     61:                $name = $base;
                     62:        }
1.7       andrew     63:
1.17      andrew     64:        my $t;
                     65:         eval {
                     66:                $t = BT::MetaInfo::Cached->new(
1.19      andrew     67:                        $OBT->{DIR_TORRENT} . '/' . $_,
1.17      andrew     68:                        {
1.22      andrew     69:                                cache_root => '/tmp/OBTFileCache'
                     70:                                #$OBT->{DIR_HOME} . '/FileCache'
1.17      andrew     71:                        }
                     72:                );
                     73:        };
1.9       andrew     74:
1.17      andrew     75:        if ($@) {
                     76:                warn "Error reading torrent $_\n";
1.19      andrew     77:                next;
1.17      andrew     78:        }
1.1       andrew     79:
1.17      andrew     80:        my $epoch = $t->creation_date;
1.1       andrew     81:
                     82:        $files{$name}{$epoch} = {
                     83:                file      => $_,
1.17      andrew     84:                details   => $t,
                     85:                name      => $name,
1.1       andrew     86:                epoch     => $epoch,
                     87:        };
                     88:
                     89: }
                     90: closedir DIR;
                     91:
1.23      andrew     92: #print Dump \%server_torrents;
                     93: #print Dump \%files;
1.20      andrew     94: #exit;
1.1       andrew     95:
1.20      andrew     96: my %torrents;
                     97: FILE: foreach my $name (keys %files) {
1.1       andrew     98:        #print "$name\n";
                     99:        foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
                    100:                #print "\t$epoch\n";
                    101:                my $torrent = $files{$name}{$epoch}{file};
1.25    ! andrew    102:                my $hash = unpack("H*", $files{$name}{$epoch}{'details'}->info_hash );
        !           103:                #printf "LOCAL:  [%s] [%s]\n", $hash, $torrent;
1.19      andrew    104:
1.20      andrew    105:                $torrents{$torrent}{$hash} = $files{$name}{$epoch};
1.19      andrew    106:
1.20      andrew    107:                unless (exists $server_torrents{$torrent}{$hash}) {
                    108:                        Upload_Torrent($files{$name}{$epoch});
                    109:                }
1.1       andrew    110:        }
                    111: }
                    112:
1.20      andrew    113: foreach my $torrent (keys %server_torrents) {
                    114:        foreach my $hash (keys %{ $server_torrents{$torrent} }) {
1.25    ! andrew    115:                #printf "SERVER: [%s] [%s]\n", $hash, $torrent;
        !           116:                if ((! exists $torrents{$torrent}{$hash}) &&
        !           117:                     $server_torrents{$torrent}{$hash} != 1
1.20      andrew    118:                ) {
                    119:                        Delete_Torrent($torrent, $hash);
                    120:                }
1.1       andrew    121:        }
                    122: }
                    123:
1.10      andrew    124: $ua->get($OBT->{URL_SANITY});
1.1       andrew    125:
                    126: sub Upload_Torrent
                    127: {
1.17      andrew    128:        my $torrent = shift;
                    129:        my $t = $torrent->{'details'};
1.1       andrew    130:
1.17      andrew    131:        my $file = $torrent->{'file'};
1.1       andrew    132:        print "Uploading $file\n";
                    133:
1.3       andrew    134:        my $size = $t->total_size;
1.17      andrew    135:        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
                    136:                gmtime($t->creation_date);
                    137:        $year += 1900;
                    138:        $mon++;
                    139:        my $time = sprintf "%04d.%02d.%02d %02d:%02d",
                    140:                $year, $mon, $mday,  $hour, $min;
1.3       andrew    141:
1.19      andrew    142:        ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
                    143:                localtime($t->creation_date);
                    144:        $year += 1900;
                    145:        $mon++;
                    146:        my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
                    147:                $year, $mon, $mday,  $hour, $min;
                    148:
1.13      andrew    149:        my $i = 0;
1.3       andrew    150:        while ($size > 1024) {
                    151:                $size /= 1024;
                    152:                $i++;
                    153:        }
                    154:        $size = sprintf('%.2f', $size);
                    155:        $size .= $Sizes[$i] . 'B';
                    156:
1.1       andrew    157:        my $comment = $t->{comment};
                    158:        $comment =~ s/\n.*$//s;
1.3       andrew    159:
1.23      andrew    160:        my $filename =
1.24      andrew    161:                 $comment =~ /($OBT->{BASENAME}.+)/ ? $1
1.23      andrew    162:                :                                $file;
1.1       andrew    163:        $filename =~ s#/# #g;
1.23      andrew    164:        $filename =~ s/\.torrent\z//;
1.1       andrew    165:
1.3       andrew    166:        $comment  .= " [$size]";
                    167:        $filename .= " [$time]";
1.1       andrew    168:
1.10      andrew    169:        my $response = $ua->post($OBT->{URL_UPLOAD}, {
                    170:                username => $OBT->{UPLOAD_USER},
                    171:                password => $OBT->{UPLOAD_PASS},
                    172:                torrent  => [ $OBT->{DIR_TORRENT} . "/$file" ],
1.1       andrew    173:                url      => "/torrents/$file",
                    174:                filename => $filename,
1.19      andrew    175:                filedate => $sql_time,
1.1       andrew    176:                info     => $comment,
                    177:                hash     => '',
                    178:                autoset  => 'enabled', # -> checked="checked"
                    179:        }, Content_Type => 'form-data');
                    180:
                    181:        if ($response->is_success) {
1.6       andrew    182:                print STDERR "Uploaded  $file\n";
1.1       andrew    183:                #print $response->content;
                    184:        } else {
                    185:                die $response->status_line;
                    186:        }
                    187: }
                    188:
                    189: sub Delete_Torrent
                    190: {
1.20      andrew    191:        my $filename = shift;
                    192:        my $hash = shift;
                    193:        die "No hash passed!" unless $hash;
                    194:
1.25    ! andrew    195:        print "Removing $filename [$hash]\n";
1.20      andrew    196:
                    197:        my $response = $ua->post($OBT->{'URL_DELETE'}, {
                    198:                username => $OBT->{UPLOAD_USER},
                    199:                password => $OBT->{UPLOAD_PASS},
                    200:                filename => $filename,
                    201:                hash     => $hash,
                    202:        }, Content_Type => 'form-data');
                    203:
                    204:        if ($response->is_success) {
1.25    ! andrew    205:                my ($result) = $response->content =~ /class="error"\>([^<]+)\</;
        !           206:
        !           207:                if ($result eq 'Torrent was removed successfully.') {
        !           208:                        print STDERR "Removed $filename [$hash]\n";
        !           209:                }
        !           210:                elsif ($result) {
        !           211:                        print STDERR "Error: $result (removing $filename [$hash])\n";
        !           212:                }
        !           213:                else {
        !           214:                        print STDERR "An unknown error occurred removing $filename [$hash]\n";
1.20      andrew    215:                }
1.25    ! andrew    216:        }
        !           217:        else {
        !           218:                die $response->status_line . " removing $filename [$hash]\n";
1.20      andrew    219:        }
1.1       andrew    220: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>