=pod Track.pl - The barest minimum of a BitTorrent tracker. Required Non-Standard Modules ----------------------------- Bittorrent::Tracker Bittorrent::Bencode =cut use strict; use warnings; #use lib "../lib"; #use GetOpts::Long; use IO::Socket; use CGI; use Bittorrent::Tracker; my $tracker = new Bittorrent::Tracker; my $server = IO::Socket::INET->new(Listen => 10, LocalAddr => "localhost", LocalPort => 6969, Proto => 'tcp', Reuse => 1 ); while( my $client = $server->accept() ) { $client->autoflush(1); my @http_request; # get all data from the request while (my $line = <$client>) { last if $line =~ /^\015\012$/; # CRLF on a line by itself chomp $line; push @http_request, $line; } $http_request[0] =~ /\/(scrape|announce)\??(\S+)?\s/; # Request line my $page = $1; my $query = $2; # Tracker output line print STDOUT localtime()."|",$client->peerhost,"|",$page; print STDOUT "?",$query if $query; print STDOUT "\n"; my $cgi = CGI->new($query); if ($page eq "announce") { my $info_hash = $tracker->protocol->decode_hash($cgi->param('info_hash')); my %peer_data = ( peer_id => $tracker->protocol->decode_hash($cgi->param('peer_id')), ip => $cgi->param('ip') || $client->peerhost, port => $cgi->param('port'), event => $cgi->param('event'), downloaded => $cgi->param('downloaded'), uploaded => $cgi->param('uploaded'), left => $cgi->param('left'), ); # Print headers (if any) #** ADD SUPPORT FOR GZIP print $client $tracker->announce($info_hash, \%peer_data); } elsif ($page eq "scrape") { my @files = map { $tracker->protocol->decode_hash($_) } ($cgi->param('info_hash')); # print headers (if any) #** ADD SUPPORT FOR GZIP print $client $tracker->scrape(@files); } close $client; }