Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.27
1.1 andrew 1: #!/usr/bin/perl -T
1.27 ! andrew 2: #$RedRiver: ServerTorrents.pl,v 1.26 2008/12/29 22:02:14 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}) &&
1.27 ! andrew 117: (
! 118: (! defined $server_torrents{$torrent}{$hash}) ||
1.25 andrew 119: $server_torrents{$torrent}{$hash} != 1
1.27 ! andrew 120: )
1.20 andrew 121: ) {
122: Delete_Torrent($torrent, $hash);
123: }
1.1 andrew 124: }
125: }
126:
1.10 andrew 127: $ua->get($OBT->{URL_SANITY});
1.1 andrew 128:
129: sub Upload_Torrent
130: {
1.17 andrew 131: my $torrent = shift;
132: my $t = $torrent->{'details'};
1.1 andrew 133:
1.17 andrew 134: my $file = $torrent->{'file'};
1.1 andrew 135: print "Uploading $file\n";
136:
1.3 andrew 137: my $size = $t->total_size;
1.17 andrew 138: my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
139: gmtime($t->creation_date);
140: $year += 1900;
141: $mon++;
142: my $time = sprintf "%04d.%02d.%02d %02d:%02d",
143: $year, $mon, $mday, $hour, $min;
1.3 andrew 144:
1.19 andrew 145: ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
146: localtime($t->creation_date);
147: $year += 1900;
148: $mon++;
149: my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
150: $year, $mon, $mday, $hour, $min;
151:
1.13 andrew 152: my $i = 0;
1.3 andrew 153: while ($size > 1024) {
154: $size /= 1024;
155: $i++;
156: }
157: $size = sprintf('%.2f', $size);
158: $size .= $Sizes[$i] . 'B';
159:
1.1 andrew 160: my $comment = $t->{comment};
161: $comment =~ s/\n.*$//s;
1.3 andrew 162:
1.23 andrew 163: my $filename =
1.24 andrew 164: $comment =~ /($OBT->{BASENAME}.+)/ ? $1
1.23 andrew 165: : $file;
1.1 andrew 166: $filename =~ s#/# #g;
1.23 andrew 167: $filename =~ s/\.torrent\z//;
1.1 andrew 168:
1.3 andrew 169: $comment .= " [$size]";
170: $filename .= " [$time]";
1.1 andrew 171:
1.10 andrew 172: my $response = $ua->post($OBT->{URL_UPLOAD}, {
173: username => $OBT->{UPLOAD_USER},
174: password => $OBT->{UPLOAD_PASS},
175: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
1.1 andrew 176: url => "/torrents/$file",
177: filename => $filename,
1.19 andrew 178: filedate => $sql_time,
1.1 andrew 179: info => $comment,
180: hash => '',
181: autoset => 'enabled', # -> checked="checked"
182: }, Content_Type => 'form-data');
183:
184: if ($response->is_success) {
1.6 andrew 185: print STDERR "Uploaded $file\n";
1.1 andrew 186: #print $response->content;
187: } else {
188: die $response->status_line;
189: }
190: }
191:
192: sub Delete_Torrent
193: {
1.20 andrew 194: my $filename = shift;
195: my $hash = shift;
196: die "No hash passed!" unless $hash;
197:
1.25 andrew 198: print "Removing $filename [$hash]\n";
1.20 andrew 199:
200: my $response = $ua->post($OBT->{'URL_DELETE'}, {
201: username => $OBT->{UPLOAD_USER},
202: password => $OBT->{UPLOAD_PASS},
203: filename => $filename,
204: hash => $hash,
205: }, Content_Type => 'form-data');
206:
207: if ($response->is_success) {
1.25 andrew 208: my ($result) = $response->content =~ /class="error"\>([^<]+)\</;
209:
210: if ($result eq 'Torrent was removed successfully.') {
211: print STDERR "Removed $filename [$hash]\n";
212: }
213: elsif ($result) {
214: print STDERR "Error: $result (removing $filename [$hash])\n";
215: }
216: else {
217: print STDERR "An unknown error occurred removing $filename [$hash]\n";
1.20 andrew 218: }
1.25 andrew 219: }
220: else {
221: die $response->status_line . " removing $filename [$hash]\n";
1.20 andrew 222: }
1.1 andrew 223: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>