Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.22
1.1 andrew 1: #!/usr/bin/perl -T
1.22 ! andrew 2: #$RedRiver: ServerTorrents.pl,v 1.21 2006/05/15 18:47:04 andrew Exp $
1.1 andrew 3: use strict;
4: use warnings;
5: use diagnostics;
6:
7: use LWP::UserAgent;
8: use Time::Local;
9:
10: use lib 'lib';
11: use OpenBSDTorrents;
1.14 andrew 12: use BT::MetaInfo::Cached;
1.1 andrew 13:
14: %ENV = ();
15:
1.5 andrew 16: #use YAML;
1.3 andrew 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:
47: my %files;
1.10 andrew 48: opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
1.1 andrew 49: foreach (readdir DIR) {
1.8 andrew 50: chomp;
1.1 andrew 51: if (/^([^\/]+)$/) {
52: $_ = $1;
53: } else {
54: die "Invalid character in $_: $!";
55: }
56: next unless /\.torrent$/;
57: my ($name, $year, $mon, $mday, $hour, $min) =
58: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
1.7 andrew 59:
1.17 andrew 60: my $t;
61: eval {
62: $t = BT::MetaInfo::Cached->new(
1.19 andrew 63: $OBT->{DIR_TORRENT} . '/' . $_,
1.17 andrew 64: {
1.22 ! andrew 65: cache_root => '/tmp/OBTFileCache'
! 66: #$OBT->{DIR_HOME} . '/FileCache'
1.17 andrew 67: }
68: );
69: };
1.9 andrew 70:
1.17 andrew 71: if ($@) {
72: warn "Error reading torrent $_\n";
1.19 andrew 73: next;
1.17 andrew 74: }
1.1 andrew 75:
1.17 andrew 76: my $epoch = $t->creation_date;
1.1 andrew 77:
78: $files{$name}{$epoch} = {
79: file => $_,
1.17 andrew 80: details => $t,
81: name => $name,
1.1 andrew 82: epoch => $epoch,
83: };
84:
85: }
86: closedir DIR;
87:
1.20 andrew 88: #use Data::Dumper;
89: #print Dumper \%server_torrents;#, \%files;
90: #exit;
1.1 andrew 91:
1.20 andrew 92: my %torrents;
93: FILE: foreach my $name (keys %files) {
1.1 andrew 94: #print "$name\n";
95: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
96: #print "\t$epoch\n";
97: my $torrent = $files{$name}{$epoch}{file};
1.19 andrew 98:
99: my $hash = $files{$name}{$epoch}{'details'}->info_hash;
100: $hash = unpack("H*", $hash);
101:
1.20 andrew 102: $torrents{$torrent}{$hash} = $files{$name}{$epoch};
1.19 andrew 103:
1.20 andrew 104: unless (exists $server_torrents{$torrent}{$hash}) {
105: Upload_Torrent($files{$name}{$epoch});
106: }
1.1 andrew 107: }
108: }
109:
1.20 andrew 110: foreach my $torrent (keys %server_torrents) {
111: foreach my $hash (keys %{ $server_torrents{$torrent} }) {
112: unless (
113: exists $torrents{$torrent}{$hash} ||
114: $server_torrents{$torrent}{$hash} == 1
115: ) {
116: Delete_Torrent($torrent, $hash);
117: }
1.1 andrew 118: }
119: }
120:
1.10 andrew 121: $ua->get($OBT->{URL_SANITY});
1.1 andrew 122:
123: sub Upload_Torrent
124: {
1.17 andrew 125: my $torrent = shift;
126: my $t = $torrent->{'details'};
1.1 andrew 127:
1.17 andrew 128: my $file = $torrent->{'file'};
1.1 andrew 129: print "Uploading $file\n";
130:
1.3 andrew 131: my $size = $t->total_size;
1.17 andrew 132: my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
133: gmtime($t->creation_date);
134: $year += 1900;
135: $mon++;
136: my $time = sprintf "%04d.%02d.%02d %02d:%02d",
137: $year, $mon, $mday, $hour, $min;
1.3 andrew 138:
1.19 andrew 139: ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
140: localtime($t->creation_date);
141: $year += 1900;
142: $mon++;
143: my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
144: $year, $mon, $mday, $hour, $min;
145:
1.13 andrew 146: my $i = 0;
1.3 andrew 147: while ($size > 1024) {
148: $size /= 1024;
149: $i++;
150: }
151: $size = sprintf('%.2f', $size);
152: $size .= $Sizes[$i] . 'B';
153:
1.1 andrew 154: my $comment = $t->{comment};
155: $comment =~ s/\n.*$//s;
1.3 andrew 156:
157: my ($filename) = $comment =~ /Files from (.+)/;
1.1 andrew 158: $filename =~ s#/# #g;
159:
1.3 andrew 160: $comment .= " [$size]";
161: $filename .= " [$time]";
1.1 andrew 162:
1.10 andrew 163: my $response = $ua->post($OBT->{URL_UPLOAD}, {
164: username => $OBT->{UPLOAD_USER},
165: password => $OBT->{UPLOAD_PASS},
166: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
1.1 andrew 167: url => "/torrents/$file",
168: filename => $filename,
1.19 andrew 169: filedate => $sql_time,
1.1 andrew 170: info => $comment,
171: hash => '',
172: autoset => 'enabled', # -> checked="checked"
173: }, Content_Type => 'form-data');
174:
175: if ($response->is_success) {
1.6 andrew 176: print STDERR "Uploaded $file\n";
1.1 andrew 177: #print $response->content;
178: } else {
179: die $response->status_line;
180: }
181: }
182:
183: sub Delete_Torrent
184: {
1.20 andrew 185: my $filename = shift;
186: my $hash = shift;
187: die "No hash passed!" unless $hash;
188:
189: print "Disabling $filename\n";
190:
191: my $response = $ua->post($OBT->{'URL_DELETE'}, {
192: username => $OBT->{UPLOAD_USER},
193: password => $OBT->{UPLOAD_PASS},
194: filename => $filename,
195: hash => $hash,
196: }, Content_Type => 'form-data');
197:
198: if ($response->is_success) {
199: #print $response->content;
200: if ($response->content =~ /Torrent was removed successfully/) {
201: print STDERR "Disabled $filename\n";
202: } else {
203: print STDERR "An error occoured removing $filename\n";
204: }
205: } else {
206: die $response->status_line;
207: }
1.1 andrew 208: }
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