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