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