<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">=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-&gt;new(Listen	=&gt; 10,
			   	   LocalAddr	=&gt; "localhost",
				   LocalPort	=&gt; 6969,
				   Proto	=&gt; 'tcp',
				   Reuse	=&gt; 1
				   );



while( my $client = $server-&gt;accept() )
{
    $client-&gt;autoflush(1);
    
    
    my @http_request;
    # get all data from the request
    while (my $line = &lt;$client&gt;)
    {
	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-&gt;peerhost,"|",$page;
    print STDOUT "?",$query if $query;
    print STDOUT "\n";
    
    my $cgi = CGI-&gt;new($query);
    
    if ($page eq "announce")
    {
	my $info_hash = $tracker-&gt;protocol-&gt;decode_hash($cgi-&gt;param('info_hash'));
	
	my %peer_data = (
		peer_id	     =&gt; $tracker-&gt;protocol-&gt;decode_hash($cgi-&gt;param('peer_id')),
		ip	     =&gt; $cgi-&gt;param('ip') || $client-&gt;peerhost,
		port	     =&gt; $cgi-&gt;param('port'),
		event	     =&gt; $cgi-&gt;param('event'),
		downloaded   =&gt; $cgi-&gt;param('downloaded'),
		uploaded     =&gt; $cgi-&gt;param('uploaded'),
		left	     =&gt; $cgi-&gt;param('left'),
		);
	
	# Print headers (if any)
	#** ADD SUPPORT FOR GZIP
	
	print $client $tracker-&gt;announce($info_hash, \%peer_data);
	
    }
    
    elsif ($page eq "scrape")
    {
	my @files = 
		map { $tracker-&gt;protocol-&gt;decode_hash($_) } ($cgi-&gt;param('info_hash'));
		
	# print headers (if any)
	#** ADD SUPPORT FOR GZIP
	
	
	print $client $tracker-&gt;scrape(@files);
	
    }
    
    
    close $client;
}</pre></body></html>