Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.7
1.1 andrew 1: #!/usr/bin/perl -T
1.7 ! andrew 2: #$Id: ServerTorrents.pl,v 1.6 2005/03/29 00:28:50 andrew Exp andrew $
1.1 andrew 3: use strict;
4: use warnings;
5: use diagnostics;
6:
7: use BT::MetaInfo;
8: use LWP::UserAgent;
9: use Time::Local;
10:
11: use lib 'lib';
12: use OpenBSDTorrents;
13:
14: %ENV = ();
15:
1.5 andrew 16: #use YAML;
1.3 andrew 17:
1.5 andrew 18: justme();
1.1 andrew 19:
20: my $url_torrents = 'http://openbsd.somedomain.net/dumptorrents.php';
21: my $url_upload = 'http://openbsd.somedomain.net/newtorrents.php';
22: my $url_delete = 'http://openbsd.somedomain.net/deltorrents.php';
1.4 andrew 23: my $url_sanity = 'http://openbsd.somedomain.net/sanity.php';
1.1 andrew 24:
25: my $user = 'torrentup';
26: my $pass = 'ssapword';
27:
1.3 andrew 28: my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti');
1.1 andrew 29: my $ua = LWP::UserAgent->new;
30:
31: my $response = $ua->get($url_torrents);
32:
33: my %server_torrents;
34: if ($response->is_success) {
35: my $content = $response->content; # or whatever
36: $content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!";
37: $content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!";
38: unless ($content =~ /No data/) {
39: foreach (split /\n/, $content) {
40: s/^\s+//;
41: s/\s+$//;
42: next unless $_;
43: my ($name, $hash) = split /\t/;
44: next if $name eq 'File';
45:
46: $name =~ s#^/torrents/##;
47: $server_torrents{$name} = $hash;
48: }
49: }
50: } else {
51: die $response->status_line;
52: }
53:
54:
55: my %files;
56: opendir DIR, $TorrentDir or die "Couldn't opendir $TorrentDir: $!";
57: foreach (readdir DIR) {
58: if (/^([^\/]+)$/) {
59: $_ = $1;
60: } else {
61: die "Invalid character in $_: $!";
62: }
63: next unless /\.torrent$/;
64: chomp;
65: my ($name, $year, $mon, $mday, $hour, $min) =
66: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
1.7 ! andrew 67:
! 68: $mon--;
1.1 andrew 69:
70: my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
71:
72: $files{$name}{$epoch} = {
73: file => $_,
74: year => $year,
75: mon => $mon,
76: mday => $mday,
77: hour => $hour,
78: min => $min,
79: epoch => $epoch,
80: };
81:
82: }
83: closedir DIR;
84:
85: #print Dump \%server_torrents, \%files;
86:
87: foreach my $name (keys %files) {
88: #print "$name\n";
89: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
90: #print "\t$epoch\n";
91: my $torrent = $files{$name}{$epoch}{file};
92: unless (exists $server_torrents{$torrent} ) {
93: my $time =
94: $files{$name}{$epoch}{year} . '-' .
95: $files{$name}{$epoch}{mon} . '-' .
96: $files{$name}{$epoch}{mday} . ' ' .
97: $files{$name}{$epoch}{hour} . ':' .
98: $files{$name}{$epoch}{min} . ':00';
99:
100: Upload_Torrent($torrent, $time);
101: }
102: next;
103: }
104: }
105:
106: foreach my $file (keys %server_torrents) {
1.2 andrew 107: my ($name, $year, $mon, $mday, $hour, $min) =
108: $file =~
109: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
110: unless (exists $files{$name}) {
1.1 andrew 111: Delete_Torrent($file);
112: }
113: }
114:
1.4 andrew 115: $ua->get($url_sanity);
1.1 andrew 116:
117: sub Upload_Torrent
118: {
119: my $file = shift;
120: my $time = shift;
121:
122: print "Uploading $file\n";
123:
124: my $t;
125: eval { $t = BT::MetaInfo->new("$TorrentDir/$file"); };
126: if ($@) {
127: warn "Error reading torrent $file\n";
128: return undef;
129: }
130:
1.3 andrew 131: my $size = $t->total_size;
132:
133: my $i;
134: while ($size > 1024) {
135: $size /= 1024;
136: $i++;
137: }
138: $size = sprintf('%.2f', $size);
139: $size .= $Sizes[$i] . 'B';
140:
1.1 andrew 141: my $comment = $t->{comment};
142: $comment =~ s/\n.*$//s;
1.3 andrew 143:
144: my ($filename) = $comment =~ /Files from (.+)/;
1.1 andrew 145: $filename =~ s#/# #g;
146:
1.3 andrew 147: $comment .= " [$size]";
148: $filename .= " [$time]";
1.1 andrew 149:
150: my $response = $ua->post($url_upload, {
151: username => $user,
152: password => $pass,
153: torrent => [ "$TorrentDir/$file" ],
154: url => "/torrents/$file",
155: filename => $filename,
156: filedate => $time,
157: info => $comment,
158: hash => '',
159: autoset => 'enabled', # -> checked="checked"
160: }, Content_Type => 'form-data');
161:
162: if ($response->is_success) {
1.6 andrew 163: print STDERR "Uploaded $file\n";
1.1 andrew 164: #print $response->content;
165: } else {
166: die $response->status_line;
167: }
168: }
169:
170: sub Delete_Torrent
171: {
172: my $file = shift;
173: print "Will delete $file soon enough\n";
174: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>