#!/usr/bin/perl

use strict;
use warnings;
use vars qw(@ARGV %SIG);
use Apache2; # to get path for APR
use HTTP::Daemon;
use Net::BitTorrent::LibBT::Tracker;
use Socket qw(inet_aton);

our $tracker;
our $daemon;

sub do_shutdown
{
 $daemon->close;
 $daemon = $tracker = 0;
 print "[Daemon Shutting Down]\n";
 exit(0);
}

$SIG{HUP} = $SIG{INT} = \&do_shutdown;

if((@ARGV != 2 && @ARGV != 3) || (@ARGV == 3 && $ARGV[2] ne "-master"))
{
 die "Usage: bttrack.pl homedir port [-master]";
}

my $master = $ARGV[2] ? 1 : 0;

if($daemon = HTTP::Daemon->new(LocalPort => $ARGV[1]))
{
 if($tracker = Net::BitTorrent::LibBT::Tracker::Tracker->new($ARGV[0], $master))
 {
  print "[Daemon Ready on port $ARGV[1]]\n";
  $tracker->c->detail_url("/details");
  $tracker->c->stylesheet("");
  while(my $c = $daemon->accept)
  {
   my($rv, $content_length, $content);
   if(my $r = $c->get_request(1))
   {
    my $ct = "";
    if($r->url->path eq "/")
    {
     # Root HTML info page
     my $args = $r->url->query;
     if($args)
     {
      $args.="&html=1";
     }
     else
     {
      $args = "html=1";
     }
     ($rv, $content_length, $content) = $tracker->cxn_scrape($args, unpack('L', $c->peeraddr), $c->peerport);
     $ct = "text/html";
    }
    elsif($r->url->path eq "/announce")
    {
    	# Announce URL
     ($rv, $content_length, $content) = $tracker->cxn_announce($r->url->query, $r->header("User-Agent"), unpack('L', $c->peeraddr), $c->peerport);
     $ct = "text/plain";
    }
    elsif($r->url->path eq "/scrape")
    {
     # Scrape URL
     my $args = $r->url->query || "";
     ($rv, $content_length, $content) = $tracker->cxn_scrape($args, unpack('L', $c->peeraddr), $c->peerport);
     if($args =~ /html=1/)
     {
      $ct = "text/html";
     }
     elsif($args =~ /xml=1/)
     {
      $ct = "text/xml";
     }
     else
     {
      $ct = "text/plain";
     }
    }
    elsif($r->url->path eq "/details")
    {
     ($rv, $content_length, $content) = $tracker->cxn_details($r->url->query, unpack('L', $c->peeraddr), $c->peerport);
     $ct = "text/html";
    }
    else
    {
     $ct = "text/plain";
     $content = "File not found.\n";
     $content_length = length($content);
     $rv = 404;
    }

	$content||='';
    
    $c->send_basic_header($rv);
    $c->print("Content-Type: $ct\n\n");
    
    if($content_length)
    {
     $c->print($content);
    }
    else
    {
     $c->print("No content.\n");
    }
    
    print "[", scalar(localtime()), "] ", $c->peerhost(), " \"", $r->method, " ", $r->uri, "\" $rv $content_length\n";
    
    $c->close;
   }
  }
 }
 else
 {
  die "Failed to start tracker instance.";
 }
}
else
{
 die "Failed to start HTTP daemon instance.";
}


=pod

=head1 NAME

bttrack.pl - Sample scripe that uses LibBTT to run as a tracker.

=head1 SYNOPSIS

	bttrack.pl <data_directory> <port> [-master]

=head1 DESCRIPTION

bttrack.pl is an extremely simple BitTorrent tracker, written as an example on how to use
Net::BitTorrent::LibBT::Tracker to run a tracker independant of another webserver.
    
bttrack.pl runs single-threaded, using HTTP::Daemon to read the requets, then passing them
off to Net::BitTorrent::LibBT::Tracker. It is bound to be slow. It is more for a programming
example than for actual use.

=head1 SEE ALSO

L<Net::BitTorrent::LibBT::Tracker>, L<http://www.crackerjack.net/mod_bt/>, L<http://perl.apache.org/>

=cut