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>