Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.30
1.1 andrew 1: #!/usr/bin/perl -T
1.30 ! andrew 2: #$RedRiver: ServerTorrents.pl,v 1.29 2010/03/08 20:19:37 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.30 ! andrew 102: elsif ( $server_torrents{$hash}{disabled} ) {
! 103: Update_Torrent( $server_torrents{$hash}{name}, $hash );
! 104: }
1.1 andrew 105: }
106: closedir DIR;
107:
1.23 andrew 108: #print Dump \%server_torrents;
1.20 andrew 109: #exit;
1.1 andrew 110:
1.28 andrew 111: foreach my $hash ( keys %server_torrents ) {
112:
113: #printf "SERVER: [%s] [%s]\n", $hash, $torrent;
114: if ( ( !exists $torrents{$hash} )
115: && ( !$server_torrents{$hash}{disabled} ) )
116: {
1.30 ! andrew 117: Update_Torrent( $server_torrents{$hash}{name}, $hash, 1 );
1.28 andrew 118: }
1.1 andrew 119: }
120:
1.28 andrew 121: $ua->get( $OBT->{URL_SANITY} );
122:
123: sub Upload_Torrent {
124: my $torrent = shift;
125: my $t = $torrent->{'details'};
126:
127: my $file = $torrent->{'file'};
1.29 andrew 128: #print "Uploading $file\n";
1.28 andrew 129:
130: my $size = $t->total_size;
131: my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday )
132: = gmtime( $t->creation_date );
133: $year += 1900;
134: $mon++;
135: my $time = sprintf "%04d.%02d.%02d %02d:%02d",
136: $year, $mon, $mday, $hour, $min;
137:
138: ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday )
139: = localtime( $t->creation_date );
140: $year += 1900;
141: $mon++;
142: my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
143: $year, $mon, $mday, $hour, $min;
144:
145: my $i = 0;
146: while ( $size > 1024 ) {
147: $size /= 1024;
148: $i++;
149: }
150: $size = sprintf( '%.2f', $size );
151: $size .= $Sizes[$i] . 'B';
152:
153: my $comment = $t->{comment};
154: $comment =~ s/\n.*$//s;
155:
156: my $filename
157: = $comment =~ /($OBT->{BASENAME}.+)/
158: ? $1
159: : $file;
160: $filename =~ s#/# #g;
161: $filename =~ s/\.torrent\z//;
162:
163: $comment .= " [$size]";
164: $filename .= " [$time]";
165:
166: my $response = $ua->post(
167: $OBT->{URL_UPLOAD},
168: { username => $OBT->{UPLOAD_USER},
169: password => $OBT->{UPLOAD_PASS},
170: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
171: url => "/torrents/$file",
172: filename => $filename,
173: filedate => $sql_time,
174: info => $comment,
175: hash => '',
176: autoset => 'enabled', # -> checked="checked"
177: },
178: Content_Type => 'form-data'
179: );
180:
181: if ( $response->is_success ) {
182: print STDERR "Uploaded $file\n";
183:
184: #print $response->content;
185: }
186: else {
187: die $response->status_line;
188: }
1.1 andrew 189: }
190:
1.30 ! andrew 191: sub Update_Torrent {
1.28 andrew 192: my $filename = shift;
193: my $hash = shift;
1.30 ! andrew 194: my $disable = shift || 0;
1.28 andrew 195: die "No hash passed!" unless $hash;
196:
1.29 andrew 197: #print "Removing $filename [$hash]\n";
1.28 andrew 198:
199: my $response = $ua->post(
1.30 ! andrew 200: $OBT->{'URL_UPDATE'},
1.28 andrew 201: { username => $OBT->{UPLOAD_USER},
202: password => $OBT->{UPLOAD_PASS},
203: filename => $filename,
204: hash => $hash,
1.30 ! andrew 205: disable => $disable,
1.28 andrew 206: },
207: Content_Type => 'form-data'
208: );
1.30 ! andrew 209: my $status = $disable ? 'Disabled' : 'Enabled';
1.1 andrew 210:
1.28 andrew 211: if ( $response->is_success ) {
212: my ($result) = $response->content =~ /class="error"\>([^<]+)\</;
1.1 andrew 213:
1.30 ! andrew 214: if ( $result eq 'Torrent disabled set to ' . $disable ) {
! 215: print STDERR "$status $filename [$hash]\n";
1.28 andrew 216: }
217: elsif ($result) {
218: print STDERR "Error: $result (removing $filename [$hash])\n";
219: }
220: else {
221: print STDERR
222: "An unknown error occurred removing $filename [$hash]\n";
223: }
224: }
225: else {
226: die $response->status_line . " removing $filename [$hash]\n";
227: }
1.1 andrew 228: }
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