Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.24
1.1 andrew 1: #!/usr/bin/perl -T
1.24 ! andrew 2: #$RedRiver: ServerTorrents.pl,v 1.23 2007/10/01 20:17:23 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:
38: $name =~ s#^/torrents/##;
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.19 andrew 102:
103: my $hash = $files{$name}{$epoch}{'details'}->info_hash;
104: $hash = unpack("H*", $hash);
105:
1.20 andrew 106: $torrents{$torrent}{$hash} = $files{$name}{$epoch};
1.19 andrew 107:
1.20 andrew 108: unless (exists $server_torrents{$torrent}{$hash}) {
109: Upload_Torrent($files{$name}{$epoch});
110: }
1.1 andrew 111: }
112: }
113:
1.20 andrew 114: foreach my $torrent (keys %server_torrents) {
115: foreach my $hash (keys %{ $server_torrents{$torrent} }) {
116: unless (
117: exists $torrents{$torrent}{$hash} ||
118: $server_torrents{$torrent}{$hash} == 1
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:
196: print "Disabling $filename\n";
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) {
206: #print $response->content;
207: if ($response->content =~ /Torrent was removed successfully/) {
208: print STDERR "Disabled $filename\n";
209: } else {
210: print STDERR "An error occoured removing $filename\n";
211: }
212: } else {
213: die $response->status_line;
214: }
1.1 andrew 215: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ServerTorrents.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / openbsd / OpenBSDTorrents