{ package Bittorrent::TrackerLib::Protocol;
    $VERSION = 0.05;
    
    
    use strict;
    use warnings;
    
    use Bittorrent::Bencode qw(bencode);
    
    
    
    # new
    # Constructor
    # Usage:
    #	$protocol = new Bittorrent::TrackerLib::Protocol $tracker;
    sub new
    {
	my $class	= shift;
	my $tracker	= shift;
	my $self	= {};
	
	
	# error checking
	#die "First argument to constructor must be Bittorrent::TrackerLib object $!" if ref $tracker != "Bittorrent::TrackerLib";
	
	
	$self->{tracker}	= $tracker;
	
	
	# Config values to send with a scrape
	$self->{scrape_config}		= [];
	# File columns to send with each file in a scrape
	$self->{scrape_columns}		= [ "complete", "incomplete" ];
	
	
	# Config values to send with a peerlist
	$self->{peerlist_config} 	= [ "interval" ];
	# Peer columns to send with each peer in a peerlist
	$self->{peerlist_columns} 	= [ "ip", "port" ];
	
	
	return bless $self, $class;
    }
    
    
    
    # announce
    # Periodic client update to get a list of peers.
    # Usage:
    #	$bencoded_peerlist = $tracker->announce(
    #		"info_hash",			# REQUIRED: File info hash
    #		{ peer_id => value, 		# OPTIONAL: Peer data
    #		  event => value,
    #		  numwant => value, ... } );
    sub announce
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $peer_data	= shift;
	
	my $peer_id	= $peer_data->{peer_id};
	delete $peer_data->{peer_id};
	
	$peer_data->{numwant} = $self->tracker->config('max_peers') 
		if !$peer_data->{numwant};
	
	
	# error checking
	return $self->client_error("Bad info hash.")
		if length $info_hash != 40;
	return $self->client_error("No peer id.")
		if !$peer_id;
	return $self->client_error("Bad port.")
		if $peer_data->{'port'} <= 0 || $peer_data->{'port'} > 65535;
	
	
	$self->backend->set_peer($info_hash,$peer_id,$peer_data);
	
	
	$self->backend->delete_peer($info_hash,$peer_id) 
	    if 	$peer_data->{event} eq 'stopped' && 
	    	# Only delete user if IP addresses match
	       	(+{$self->backend->get_peer($info_hash,$peer_id)}->{ip} eq $peer_data->{ip});
	
	return $self->peerlist( $info_hash,$peer_data->{numwant} );
    }
    
    
    
    # backend
    # Returns the tracker backend.
    # Usage:
    #	$protocol->backend;
    sub backend
    {
	my $self	= shift;
	
	return $self->tracker->backend;
    }
    
    
    
    # client_error
    # Returns an error that can be understood by clients
    # Usage:
    #	$bencoded_error = $protocol->client_error($error);
    sub client_error
    {
	my $self	 = shift;
	my $error	 = shift;
	my $client_error = {};
	
	$self->tracker->error($error);
	
	$client_error->{'failure reason'} = $error;
	
	return bencode($client_error);
    }
    
    
    
    # decode_hash
    # Unpacks a hash from what a client sends to a more portable format.
    # Usage:
    #	$info_hash = $self->decode_hash($packed_hash);	# REQUIRED: Info hash
    sub decode_hash
    {
	my $self	= shift;
	my $hash	= shift;
	
	
	# error checking
	$self->tracker->error("Bad hash"), return 0
		if length $hash != 20 && length $hash != 40;
	
	
	return (length $hash == 20) ? quotemeta unpack("H*",$hash) : $hash;    
    }
    
    
    
    # encode_hash
    # Packs a hash from what decode_hash creates to the format that clients 
    # understand
    # Usage:
    #	$protocol->encode_hash($info_hash)		# REQUIRED: Info hash
    sub encode_hash
    {
	my $self	= shift;
	
	return (length $_[0] == 40) ? pack("H*",$_[0]) : $_[0];
    }
    
    
    
    # peerlist
    # Creates a bencoded peerlist to be sent to a client
    # Usage:
    #	$bencoded_peerlist = $tracker->peerlist(
    #		$info_hash,			# REQUIRED: File info hash
    #		$max_peers)			# OPTIONAL: Maximum peers
    sub peerlist
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $numwant	= shift || $self->tracker->config("max_peers");
	my $peerlist	= {};
	
	
	# error checking
	return $self->client_error("Bad info hash.")
		if length $info_hash != 40;
	
	
	
	$peerlist->{$_} 	= $self->tracker->config($_) 
		    for @{$self->{peerlist_config}};
	$peerlist->{peers} 	= [];
	
	my $total_peers	= $self->backend->find_peer($info_hash);
	
	
	# Don't bother with randomness if there aren't enough peers
	if ($numwant >= $total_peers)
	{
	    my @peers = $self->backend->find_peer($info_hash);
	    
	    
	    for my $peer_id (@peers)
	    {
		next if !$peer_id;
		
		my %peer_data = $self->backend->get_peer($info_hash,$peer_id);
		
		# Remove lost peers
		$self->backend->delete_peer($info_hash,$peer_id), next
			if ($peer_data{last_update} < time - $self->tracker->config("interval") * 2);
		
		push @{$peerlist->{peers}}, {
		    "peer id"	=> $self->encode_hash($peer_id),
		    ip		=> $peer_data{ip},
		    port	=> $peer_data{port},
		    };
	    }
	}
	else
	{
	    # Random start points
	    my @rand_start = (int rand($total_peers)) x 10;
	    
	    for (0..9)
	    {
		my $start = $rand_start[$_];
		my $limit = ($_ == 9) ? $numwant / 9 : $numwant % 9;
		my @peers = $self->backend->find_peer($info_hash,{limit => "$limit,$start"});
		
		
		for my $peer_id (@peers)
		{
		    next if !$peer_id;
		    
		    my %peer_data = $self->backend->get_peer($info_hash,$peer_id);
		    
		    # Remove lost peers
		    $self->backend->delete_peer($info_hash,$peer_id), next
			    if ($peer_data{last_update} < time - $self->tracker->config("interval") * 2);
		    
		    push @{$peerlist->{peers}}, {
			"peer id"	=> $self->encode_hash($peer_id),
			ip		=> $peer_data{ip},
			port		=> $peer_data{port},
			};
		}
		
	    }
	
	}
	
	return bencode($peerlist);
    }
    
    
    
    # scrape
    # Creates a bencoded scrape responce to be sent to a client
    # Usage:
    #	$tracker->scrape(@info_hashes)		# OPTIONAL: List of files
    sub scrape
    {
	my $self	= shift;
	my @files	= @_;
	@files = $self->backend->all_peerlists if !@files;
	
	my $scrape	= {};
	
	
	$scrape->{$_} = $self->tracker->config($_) for @{$self->{scrape_config}};
	
	
	for my $info_hash (@files)
	{
	    
	    return $self->client_error("Not tracking this file: $info_hash") 
	    	if !grep(/$info_hash/,$self->backend->all_peerlists);
	    
	    
	    my $incomplete = $self->backend->find_peer($info_hash,{where => "left > 0"});
	    my $complete = $self->backend->find_peer($info_hash,{where => "left == 0"});
	    
	    my $file_data = {complete => $complete, incomplete => $incomplete};
	    
	    $self->backend->set_file($info_hash,$file_data);
	    
	    $scrape->{files}->{$self->encode_hash($info_hash)} = $file_data;
	}
	
	
	return bencode($scrape);
    }
    
    
    
    # tracker
    # Returns the tracker that's running this protocol
    # Usage:
    #	$protocol->tracker;
    sub tracker
    {
	my $self	= shift;
	
	return $self->{tracker};
    }
    
    
    
}




=pod

=head1 NAME

Bittorrent::TrackerLib::Protocol - Default protocol handler for Bittorrent::TrackerLib



=head1 DESCRIPTION

This module is the standard protocol handler for the Bittorrent::TrackerLib module.

It is intended to be used by a Bittorrent::TrackerLib object, which has methods for handling configuration and errors, as well as the backend.



=head1 USAGE

This module is loaded by Bittorrent::TrackerLib automatically, so there's no need to load it explicitly.



=head1 DESIGN

This section outlines how to design your own Bittorrent::TrackerLib::Protocol module. Below are all the required methods and prototypes. It is possible to change the prototype of a method, but try to avoid it whenever possible.

If you want your protocol handler to have new methods, they can be accessed from the Bittorrent::TrackerLib module with the C<protocol> method $tracker->protocol->new_method().



=head2 new

=over 4

$protocol = new Bittorrent::TrackerLib::Protocol $tracker;

=back

Creates a new protocol object. Must be passed a tracker to access its backend (if anyone knows a better way to do this, please let me know).



=head2 announce

=over 4

$bencoded_peerlist = $protocol->announce($info_hash,\%peer_data);

=back

An announce is basically set_peer and peerlist. The first argument to announce should be an info hash, the second argument is a hashref of peerdata. Announce returns a bencoded peerlist (the same as peerlist).

The peerdata MUST contain the following keys:

=over 4

=item peer_id

Decoded peer id. (decode with decode_hash).

=item ip

Usually figured out by the server, but sometimes the client must send an IP (if on a local network for example).

=item port

Port other clients should try to connect to.

=back

Some keys in the peer data have special meaning to announce. The B<event> key can be one of the following values: "started" means this client is joining or rejoining the swarm, "completed" means this client is done downloading and is now seeding, "stopped" means this client is leaving the swarm, and a null value (the most common) is a normal announce. The module will automatically delete the peer from the peerlist when event is "stopped," but it will still return a peerlist. The original tracker still sends the client a peerlist when event=stopped, but it's probably not necessary. The B<numwant> key is how many peers the client wants. Not all clients send numwant, so it defaults to the max_peers tracker->config value. If numwant is greater than max_peers, we'll use max_peers.

If a critical error occurs, will return a $protocol->client_error string containing the error. The error message itself is available through the tracker object ($tracker->error).



=head2 backend

=over 4

$backend = $protocol->backend;

=back

Returns the tracker's backend. Used for calling backend functions such as find_file, find_peer, get_file, get_peer, etc...



=head2 client_error

=over 4

$bencoded_error = $protocol->client_error($error_msg);

=back

Returns a bencoded error message that clients can understand. See the SEE ALSO area, Bittorrent Protocol section for more information. Also sets the Tracker->error message for the benefit of the tracker.

This method makes it safe for programmers to say C<print $tracker->announce(...)> or C<print $tracker->scrape(...)>.



=head2 decode_hash

=over 4

$protocol->decode_hash($info_hash);

=back

Unpacks the binary string that BitTorrent clients send into a 40-character hexidecimal string that's easier to use. Only a packed hash will be unpacked. If an unpacked hash is passed, will return the same value.



=head2 encode_hash

=over 4

$protocol->encode_hash($info_hash)

=back

Packs a 40-character hexidecimal string into a 20-byte binary structure to be sent to BitTorrent clients. C<announce>, C<peerlist>, and C<scrape> all call this function automatically, so you shouldn't need to.



=head2 peerlist

=over 4

$bencoded_peerlist = $tracker->peerlist($info_hash, $num_peers);

=back

Peerlist gathers a random list of peers for a file. The first argument is an info_hash, the second (optional) argument is the number of peers to return. If the second argument is missing, it defaults to the max_peers tracker->config value.

The randomness is determined by picking ($num_peers)/10 random start points and taking 10 peers from each start point.

Peerlist also deletes any lost peers. A peer is considered "lost" if they haven't announced in C<interval*2> seconds.

If a critical error occurs, will return a $protocol->client_error string containing the error. The error message itself is available through the tracker object ($tracker->error).



=head2 scrape

=over 4

$bencoded_scrape = $tracker->scrape;			# Scrape all files

$bencoded_scrape = $tracker->scrape(@info_hashes);	# Scrape list of files

=back

Scrape gathers information about the files currently being tracked. The method accepts a list of info hashes as an optional argument.

Scrape automatically updates two columns in the file summary table: C<complete>, the number of completed peers, and C<incomplete>, the number of incomplete peers.

If a critical error occurs, will return a $protocol->client_error string containing the error. The error message itself is available through the tracker object ($tracker->error).



=head2 tracker

=over 4

$tracker = $protocol->tracker;

=back

Gets the tracker that's using this protocol. Used for calling tracker methods such as for configuration and error handling.



=head1 TRACKER PROTOCOL

Here's a quick (and probably inaccurate) summary of the BitTorrent Client-to-Tracker protocol. 



=head2 announce

Clients announce themselves at intervals, using HTTP GET and requesting the announce page.

 GET announce?query_string

The query_string has the following standard fields.

=over 4

=item info_hash

The 20 byte sha1 hash of the bencoded form of the info value from the metainfo file. Note that this is a substring of the metainfo file. This value will almost certainly have to be URL escaped. (The decode_hash function is used to change the de-URL-escaped into something more usable).

=item peer_id

A string of length 20 which this downloader uses as its id. Each downloader generates its own id at random at the start of a new download. This value will also almost certainly have to be escaped. (The decode_hash function can also be used here).

=item ip

An optional parameter giving the IP (or dns name) which this peer is at. Generally used for the origin if it's on the same machine as the tracker.

=item port

The port number this peer is listening on. Common behavior is for a downloader to try to listen on port 6881 and if that port is taken try 6882, then 6883, etc. and give up after 6889.

=item event

This is an optional key which maps to C<started>, C<completed>, or C<stopped> (or empty, which is the same as not being present). If not present, this is one of the announcements done at regular intervals. An announcement using C<started> is sent when a download first begins, and one using C<completed> is sent when the download is complete. No C<completed> is sent if the file was complete when started. Downloaders send an announcement using C<stopped> when they cease downloading.

=item uploaded

The total amount uploaded so far, encoded in base ten ascii.

=item downloaded

The total amount downloaded so far, encoded in base ten ascii.

=item left

The number of bytes this peer still has to download, encoded in base ten ascii. Note that this can't be computed from downloaded and the file length since it might be a resume, and there's a chance that some of the downloaded data failed an integrity check and had to be re-downloaded.

=back

So the client sends something like this:

 GET announce?info_hash=...&peer_id=...&...&event=started

The tracker will process this announce and send back a bencoded dictionary with the following structure (you can feed this structure to Bittorrent::Bencode).

=over 4

 $peerlist = {
     	      interval 	=> 3600,
	      peers	=> [
	     			{
				 "peer id"	=> $peer_id,
				 ip		=> $ip,
				 port		=> $port,
				},
				
				{
				"peer id"	=> $peer_id,
				ip		=> $ip,
				port		=> $port,
				},
				...
			    ]
 	     };

=back

C<interval> is the number of seconds the peer should wait before reannouncing (though a peer may reannounce sooner to get more peers). C<peers> is a list of peer data hashes.

So the tracker sends this bencoded data back to the client and the client connects to the peers to begin downloading the file.



=head2 scrape

The scrape interface is used by websites and some clients to get data about some or all of the files a tracker is tracking.

Using HTTP, the client requests the scrape page.

 GET scrape?info_hash=...&info_hash=...

The info_hash part of the query string is optional and allows a client to help save the tracker from expensive scrape requests. A scrape with no query string will return every file being tracked, which could get to be quite lengthy.

The tracker sends back a bencoded dictionary with the following structure. (you can feed this structure to Bittorrent::Bencode)

=over 4

 $scrape = {
	    files 	=> [
			    $info_hash	=> {
					    complete 	=> $completed,
					    incomplete	=> $incomplete,
					   },
			    $info_hash	=> {
					    complete 	=> $completed,
					    incomplete	=> $incomplete,
					   },
					   ...
			   ]
 	   }

=back

For a more thorough explanation may I suggest the SEE ALSO section?
For information on bencoding, read perldoc Bittorrent::Bencode



=head1 SEE ALSO

=over 4

=item L<http://bitconjurer.org/BitTorrent/protocol.html>

Official protocol documentation

=item perldoc Bittorrent::Bencode

=item perldoc Bittorrent::TrackerLib

=back



=head1 AUTHOR

Doug Bell (doug@hawkaloogie.com). Any inaccuracies in the module or the documentation, please let me know and I'll fix them.



=head1 COPYRIGHT

Copyright (c)2004, Doug Bell. This module is free software and can be modified/distributed under the same terms as Perl itself.



=head1 HISTORY

v0.05 - ??/??/2004 - 

v0.04 - 02/19/2004 - Fixed a stupid error...

v0.03 - 02/17/2004 - Updated docs, error checking in announce, scrape, and peerlist, added client_error, improved Tracker<->Protocol<->Backend relationship, fixed scrape

v0.02 - 02/15/2004 - Semi-stable release

v0.01 - 02/02/2004 - Released to comp.lang.perl for testing and feedback



=cut