package Net::BitTorrent::Protocol::BEP05::Node;
{
use Moose;
use Moose::Util::TypeConstraints;
use AnyEvent;
use lib '../../../../../lib';
use Net::BitTorrent::Types qw[NBTypes::DHT::NodeID];
use Net::BitTorrent::Protocol::BEP05::Packets qw[:all];
use 5.010.000;
our $MAJOR = 0.074; our $MINOR = 0; our $DEV = 4; our $VERSION = sprintf('%1.3f%03d' . ($DEV ? (($DEV < 0 ? '' : '_') . '%03d') : ('')), $MAJOR, $MINOR, abs $DEV);
#
sub BUILD {1}
#
has 'port' => (isa => 'Int', is => 'ro', required => 1);
has 'host' => (isa => 'Str', is => 'ro', required => 1);
has 'sockaddr' =>
(isa => 'Str', is => 'ro', required => 1, lazy_build => 1);
sub _build_sockaddr {
require Net::BitTorrent::Network::Utility;
Net::BitTorrent::Network::Utility::sockaddr($_[0]->host, $_[0]->port);
}
has 'ipv6' => (isa => 'Bool', is => 'ro', lazy_build => 1);
sub _build_ipv6 { length shift->sockaddr == 28 }
for my $dir (qw[in out]) {
has 'announce_peer_token_'
. $dir => (isa => 'HashRef[Str]',
is => 'ro',
traits => ['Hash'],
handles => {
'_set_announce_peer_token_' . $dir => 'set',
'_get_announce_peer_token_' . $dir => 'get',
'_del_announce_peer_token_' . $dir => 'delete',
'_has_announce_peer_token_' . $dir => 'defined'
},
default => sub { {} }
);
}
has 'v' =>
(isa => 'Str', is => 'ro', writer => '_v', predicate => '_has_v');
has 'bucket' => (isa => 'Net::BitTorrent::Protocol::BEP05::Bucket',
is => 'ro',
writer => 'assign_bucket',
weak_ref => 1,
predicate => 'has_bucket'
);
has 'routing_table' => (
isa => 'Net::BitTorrent::Protocol::BEP05::RoutingTable',
is => 'ro',
predicate => 'has_routing_table',
writer => '_routing_table',
weak_ref => 1,
lazy_build => 1,
handles => [qw[send dht tracker]]
);
around 'send' => sub {
my ($code, $self, $packet, $reply) = @_;
$code->($self, $self, $packet, !!$reply);
};
has 'nodeid' => (isa => 'NBTypes::DHT::NodeID',
is => 'ro',
writer => '_nodeid',
predicate => 'has_nodeid',
coerce => 1
);
after '_nodeid' => sub {
$_[0]->routing_table->assign_node($_[0]);
$_[0]->routing_table->del_node($_[0]) if !$_[0]->has_bucket;
};
has 'outstanding_requests' => (isa => 'HashRef[HashRef]',
is => 'ro',
traits => ['Hash'],
handles => {add_request => 'set',
get_request => 'get',
del_request => 'delete',
expire_request => 'delete',
is_expecting => 'defined'
},
init_arg => undef,
default => sub { {} }
);
after 'expire_request' => sub { shift->inc_fail };
around 'add_request' => sub {
my ($code, $self, $tid, $args) = @_;
require Scalar::Util;
Scalar::Util::weaken $self;
$args->{'timeout'} //= AE::timer(
20, 0,
sub {
$self->expire_request($tid) if $self; # May ((poof)) $self
}
);
$code->($self, $tid, $args);
};
has 'ping_timer' => (
isa => 'Ref', # ArrayRef|EV::Timer
builder => '_build_ping_timer',
is => 'ro',
init_arg => undef,
writer => '_ping_timer'
);
sub _build_ping_timer {
my ($self) = @_;
require Scalar::Util;
Scalar::Util::weaken $self;
AE::timer(60 * 10, 60 * 10, sub { $self->ping if $self });
}
has '_seen' => (isa => 'Str', is => 'rw', predicate => '_has_seen');
sub touch { shift->_seen(time) }
sub seen { return time - shift->_seen <= 15 * 60 }
for my $type (qw[get_peers find_node announce_peer]) {
has 'prev_'
. $type => (isa => 'HashRef[Int]',
is => 'rw',
default => 0,
lazy => 1,
default => sub { {} },
traits => ['Hash'],
handles => {'get_prev_' . $type => 'get',
'set_prev_' . $type => 'set',
'defined_prev_' . $type => 'defined'
}
);
}
after 'BUILD' => sub {
my ($self) = @_;
require Scalar::Util;
Scalar::Util::weaken $self;
$self->_ping_timer(AE::timer(rand(30), 0, sub { $self->ping }));
};
has 'birth' => (is => 'ro',
isa => 'Int',
init_arg => undef,
default => sub {time}
);
sub ping {
my ($self) = @_;
state $tid = 'a';
my $packet = build_dht_query_ping('p_' . $tid,
pack('H*', $self->dht->nodeid->to_Hex));
my $sent = $self->send($packet);
return $self->inc_fail() if !$sent;
$self->add_request('p_' . $tid, {type => 'ping'});
$tid++;
}
sub _reply_ping {
my ($self, $tid) = @_;
my $packet = build_dht_reply_ping($tid,
pack('H*', $self->dht->nodeid->to_Hex));
my $sent = $self->send($packet, 1);
$self->inc_fail() if !$sent;
return $sent;
}
sub find_node {
my ($self, $target) = @_;
return
if $self->defined_prev_find_node($target->to_Hex)
&& $self->get_prev_find_node($target->to_Hex)
> time - (60 * 15);
state $tid = 'a';
my $packet =
build_dht_query_find_node('fn_' . $tid,
pack('H*', $self->dht->nodeid->to_Hex),
pack('H*', $target->to_Hex)
);
my $sent = $self->send($packet);
return $self->inc_fail() if !$sent;
$self->add_request('fn_' . $tid,
{type => 'find_node', target => $target});
$tid++;
$self->set_prev_find_node($target->to_Hex, time);
}
sub _reply_find_node {
my ($self, $tid, $target) = @_;
require Net::BitTorrent::Protocol::BEP23::Compact;
my $nodes
= Net::BitTorrent::Protocol::BEP23::Compact::compact_ipv4(
map { [$_->host, $_->port] }
@{$self->routing_table->nearest_bucket($target)->nodes});
return if !$nodes;
my $packet =
build_dht_reply_find_node($tid, pack('H*', $target->to_Hex),
$nodes);
my $sent = $self->send($packet, 1);
$self->inc_fail() if !$sent;
return $sent;
}
sub get_peers {
my ($self, $info_hash) = @_;
return
if $self->defined_prev_get_peers($info_hash->to_Hex)
&& $self->get_prev_get_peers($info_hash->to_Hex)
> time - (60 * 15);
state $tid = 'a';
my $packet =
build_dht_query_get_peers('gp_' . $tid,
pack('H*', $self->dht->nodeid->to_Hex),
pack('H*', $info_hash->to_Hex)
);
my $sent = $self->send($packet);
return $self->inc_fail() if !$sent;
$self->add_request('gp_' . $tid,
{type => 'get_peers', info_hash => $info_hash});
$tid++;
$self->set_prev_get_peers($info_hash->to_Hex, time);
}
sub _reply_get_peers {
my ($self, $tid, $id) = @_;
if (!$self->_has_announce_peer_token_out($id->to_Hex)) {
state $announce_peer_token = 'aa';
$announce_peer_token = 'aa' if length $announce_peer_token == 3;
$self->_set_announce_peer_token_out($id->to_Hex,
$announce_peer_token++);
}
require Net::BitTorrent::Protocol::BEP23::Compact;
my $nodes
= Net::BitTorrent::Protocol::BEP23::Compact::compact_ipv4(
map { [$_->host, $_->port] }
@{$self->routing_table->nearest_bucket($id)->nodes});
my @values = grep { defined $_ } map {
Net::BitTorrent::Protocol::BEP23::Compact::compact_ipv4(
[$_->[0], $_->[1]])
} @{$self->tracker->get_peers($id) || []};
return if (!@values && !$nodes);
my $packet =
build_dht_reply_get_peers($tid,
$id->to_Hex,
\@values,
$nodes,
$self->_get_announce_peer_token_out(
$id->to_Hex
)
);
my $sent = $self->send($packet, 1);
$self->inc_fail() if !$sent;
return $sent;
}
sub announce_peer {
my ($self, $info_hash, $port) = @_;
return
if $self->defined_prev_announce_peer($info_hash->to_Hex)
&& $self->get_prev_announce_peer($info_hash->to_Hex)
> time - (60 * 30);
return if !$self->_has_announce_peer_token_in($info_hash->to_Hex);
state $tid = 'a';
my $packet =
build_dht_query_announce_peer(
'an_' . $tid,
pack('H*', $self->dht->nodeid->to_Hex),
pack('H*', $info_hash->to_Hex),
$self->_get_announce_peer_token_in($info_hash->to_Hex),
$port
);
my $sent = $self->send($packet);
return $self->inc_fail() if !$sent;
$self->add_request('an_' . $tid,
{type => 'announce_peer', info_hash => $info_hash});
$tid++;
$self->set_prev_announce_peer($info_hash->to_Hex, time);
}
sub _reply_announce_peer {
my ($self, $tid, $info_hash, $a_ref) = @_;
my $packet;
if ((!$self->_has_announce_peer_token_out($info_hash->to_Hex))
|| ($self->_get_announce_peer_token_out($info_hash->to_Hex) ne
$a_ref->{'token'})
)
{ $packet =
build_dht_reply_error($tid,
[203,
'Incorrect write token in announce_peer'
]
);
}
elsif (!$self->tracker->add_peer(
$info_hash, [$self->host, $a_ref->{'port'}]
)
)
{ $packet = build_dht_reply_error($tid,
[202, 'Failed to add peer to tracker']);
}
else {
$packet = build_dht_reply_announce_peer($tid,
pack('H*', $self->dht->nodeid->to_Hex));
}
my $sent = $self->send($packet, 1);
$self->inc_fail() if !$sent;
return $sent;
}
has 'fail' => (
isa => 'Int',
traits => ['Counter'],
default => 0,
is => 'ro',
handles => {inc_fail => 'inc'},
init_arg => undef,
trigger => sub {
my ($self, $new, $old) = @_;
$self->routing_table->del_node($self)
if $new == ($self->has_bucket ? 5 : 1);
}
);
}
1;
=pod
=head1 NAME
Net::BitTorrent::Protocol::BEP05::Node - A single node in a DHT routing table
=head1 Description
TODO
=head1 Author
Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/
CPAN ID: SANKO
=head1 License and Legal
Copyright (C) 2008-2010 by Sanko Robinson <sanko@cpan.org>
This program is free software; you can redistribute it and/or modify it under
the terms of
L<The Artistic License 2.0|http://www.perlfoundation.org/artistic_license_2_0>.
See the F<LICENSE> file included with this distribution or
L<notes on the Artistic License 2.0|http://www.perlfoundation.org/artistic_2_0_notes>
for clarification.
When separated from the distribution, all original POD documentation is
covered by the
L<Creative Commons Attribution-Share Alike 3.0 License|http://creativecommons.org/licenses/by-sa/3.0/us/legalcode>.
See the
L<clarification of the CCA-SA3.0|http://creativecommons.org/licenses/by-sa/3.0/us/>.
Neither this module nor the L<Author|/Author> is affiliated with BitTorrent,
Inc.
=for rcs $Id: Node.pm d9b2c6b 2010-09-12 03:05:02Z sanko@cpan.org $
=cut