Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.29
1.1 andrew 1: #!/usr/bin/perl -T
1.29 ! andrew 2: #$RedRiver: ServerTorrents.pl,v 1.28 2010/01/07 18:50:02 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;
1.28 andrew 10:
1.23 andrew 11: #use YAML;
1.1 andrew 12:
13: use lib 'lib';
14: use OpenBSDTorrents;
1.14 andrew 15: use BT::MetaInfo::Cached;
1.1 andrew 16:
17: %ENV = ();
18:
1.5 andrew 19: justme();
1.1 andrew 20:
1.28 andrew 21: my @Sizes = ( '', 'Ki', 'Mi', 'Gi', 'Ti' );
1.1 andrew 22: my $ua = LWP::UserAgent->new;
23:
1.28 andrew 24: my $response = $ua->get( $OBT->{URL_TORRENTS} );
1.1 andrew 25:
26: my %server_torrents;
1.28 andrew 27: if ( $response->is_success ) {
28: my $content = $response->content; # or whatever
29: $content =~ s/^.*<!-- BEGIN LIST -->//s
30: || die "Beginning of list not found!";
31: $content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!";
32: unless ( $content =~ /No data/ ) {
33: foreach ( split /\n/, $content ) {
1.1 andrew 34: s/^\s+//;
35: s/\s+$//;
36: next unless $_;
1.28 andrew 37: my ( $name, $hash, $disabled ) = split /\t/;
1.1 andrew 38: next if $name eq 'File';
39:
1.25 andrew 40: $name =~ s#.*/##;
1.28 andrew 41: $server_torrents{$hash} = {
42: name => $name,
43: disabled => $disabled,
44: };
1.1 andrew 45: }
46: }
1.28 andrew 47: }
48: else {
1.1 andrew 49: die $response->status_line;
50: }
51:
1.28 andrew 52: my %torrents;
53: opendir DIR, $OBT->{DIR_TORRENT}
54: or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
55: foreach my $torrent ( readdir DIR ) {
56: chomp $torrent;
57: next unless $torrent =~ /\.torrent$/;
58:
59: if ($torrent =~ /^([^\/]+)$/) {
60: $torrent = $1;
61: }
62: else {
63: die "Invalid character in $torrent: $!";
64: }
65:
66: my $name = basename( $torrent, '.torrent' );
67:
68: if ( my ( $base, $year, $mon, $mday, $hour, $min )
69: = $torrent =~ /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
70: {
71: $name = $base;
72: }
73:
74: my $t;
75: eval {
76: $t = BT::MetaInfo::Cached->new(
77: $OBT->{DIR_TORRENT} . '/' . $torrent,
78: { cache_root => '/tmp/OBTFileCache'
79:
80: #$OBT->{DIR_HOME} . '/FileCache'
81: }
82: );
83: };
84: if ($@) {
85: warn "Error reading torrent $torrent\n";
86: next;
87: }
88:
89: #my $epoch = $t->creation_date;
1.1 andrew 90:
1.28 andrew 91: my $hash = unpack( "H*", $t->info_hash );
92: $torrents{$hash} = {
93: file => $torrent,
94: details => $t,
95: name => $name,
96: #epoch => $epoch,
97: };
98:
99: if ( !exists $server_torrents{$hash} ) {
100: Upload_Torrent( $torrents{$hash} );
101: }
1.1 andrew 102: }
103: closedir DIR;
104:
1.23 andrew 105: #print Dump \%server_torrents;
1.20 andrew 106: #exit;
1.1 andrew 107:
1.28 andrew 108: foreach my $hash ( keys %server_torrents ) {
109:
110: #printf "SERVER: [%s] [%s]\n", $hash, $torrent;
111: if ( ( !exists $torrents{$hash} )
112: && ( !$server_torrents{$hash}{disabled} ) )
113: {
114: Delete_Torrent( $server_torrents{$hash}{name}, $hash );
115: }
1.1 andrew 116: }
117:
1.28 andrew 118: $ua->get( $OBT->{URL_SANITY} );
119:
120: sub Upload_Torrent {
121: my $torrent = shift;
122: my $t = $torrent->{'details'};
123:
124: my $file = $torrent->{'file'};
1.29 ! andrew 125: #print "Uploading $file\n";
1.28 andrew 126:
127: my $size = $t->total_size;
128: my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday )
129: = gmtime( $t->creation_date );
130: $year += 1900;
131: $mon++;
132: my $time = sprintf "%04d.%02d.%02d %02d:%02d",
133: $year, $mon, $mday, $hour, $min;
134:
135: ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday )
136: = localtime( $t->creation_date );
137: $year += 1900;
138: $mon++;
139: my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
140: $year, $mon, $mday, $hour, $min;
141:
142: my $i = 0;
143: while ( $size > 1024 ) {
144: $size /= 1024;
145: $i++;
146: }
147: $size = sprintf( '%.2f', $size );
148: $size .= $Sizes[$i] . 'B';
149:
150: my $comment = $t->{comment};
151: $comment =~ s/\n.*$//s;
152:
153: my $filename
154: = $comment =~ /($OBT->{BASENAME}.+)/
155: ? $1
156: : $file;
157: $filename =~ s#/# #g;
158: $filename =~ s/\.torrent\z//;
159:
160: $comment .= " [$size]";
161: $filename .= " [$time]";
162:
163: my $response = $ua->post(
164: $OBT->{URL_UPLOAD},
165: { username => $OBT->{UPLOAD_USER},
166: password => $OBT->{UPLOAD_PASS},
167: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
168: url => "/torrents/$file",
169: filename => $filename,
170: filedate => $sql_time,
171: info => $comment,
172: hash => '',
173: autoset => 'enabled', # -> checked="checked"
174: },
175: Content_Type => 'form-data'
176: );
177:
178: if ( $response->is_success ) {
179: print STDERR "Uploaded $file\n";
180:
181: #print $response->content;
182: }
183: else {
184: die $response->status_line;
185: }
1.1 andrew 186: }
187:
1.28 andrew 188: sub Delete_Torrent {
189: my $filename = shift;
190: my $hash = shift;
191: die "No hash passed!" unless $hash;
192:
1.29 ! andrew 193: #print "Removing $filename [$hash]\n";
1.28 andrew 194:
195: my $response = $ua->post(
196: $OBT->{'URL_DELETE'},
197: { username => $OBT->{UPLOAD_USER},
198: password => $OBT->{UPLOAD_PASS},
199: filename => $filename,
200: hash => $hash,
201: },
202: Content_Type => 'form-data'
203: );
1.1 andrew 204:
1.28 andrew 205: if ( $response->is_success ) {
206: my ($result) = $response->content =~ /class="error"\>([^<]+)\</;
1.1 andrew 207:
1.28 andrew 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
216: "An unknown error occurred removing $filename [$hash]\n";
217: }
218: }
219: else {
220: die $response->status_line . " removing $filename [$hash]\n";
221: }
1.1 andrew 222: }
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