Skip to content

Commit

Permalink
Ultra-commit to bring basic client operations (request, send, and han…
Browse files Browse the repository at this point in the history
…dle incoming piece data) to NB. Oooo. Ahhh. Hrmmm... it's still summer, right?
  • Loading branch information
sanko committed Sep 5, 2010
1 parent da328ab commit 62b27d0
Show file tree
Hide file tree
Showing 18 changed files with 446 additions and 262 deletions.
4 changes: 2 additions & 2 deletions MANIFEST
Expand Up @@ -17,6 +17,8 @@ lib/Net/BitTorrent/Peer.pm
lib/Net/BitTorrent/Protocol/BEP03.pod
lib/Net/BitTorrent/Protocol/BEP03/Bencode.pm
lib/Net/BitTorrent/Protocol/BEP03/Metadata.pm
lib/Net/BitTorrent/Protocol/BEP03/Metadata/Piece.pm
lib/Net/BitTorrent/Protocol/BEP03/Metadata/Piece/Block.pm
lib/Net/BitTorrent/Protocol/BEP03/Packets.pm
lib/Net/BitTorrent/Protocol/BEP03/Peer.pm
lib/Net/BitTorrent/Protocol/BEP03/Peer/Incoming.pm
Expand All @@ -42,8 +44,6 @@ lib/Net/BitTorrent/Storage/File.pm
lib/Net/BitTorrent/Storage/Node.pm
lib/Net/BitTorrent/Torrent.pm
lib/Net/BitTorrent/Torrent/Generator.pm
lib/Net/BitTorrent/Torrent/Piece.pm
lib/Net/BitTorrent/Torrent/Piece/Block.pm
lib/Net/BitTorrent/Torrent/PieceSelector.pm
lib/Net/BitTorrent/Torrent/PieceSelector/Endgame.pm
lib/Net/BitTorrent/Torrent/PieceSelector/Hybrid.pm
Expand Down
69 changes: 51 additions & 18 deletions lib/Net/BitTorrent/Peer.pm
Expand Up @@ -52,6 +52,9 @@ package Net::BitTorrent::Peer;
seed => 'is_full',
_check_interest => sub {
my $s = shift;
#return $s->_unset_interesting if $s->is_seed;
#warn $s->_wanted_pieces->to_Enum;
$s->_wanted_pieces->Norm
? $s->_set_interesting
: $s->_unset_interesting;
Expand Down Expand Up @@ -90,21 +93,48 @@ package Net::BitTorrent::Peer;
default => sub { [] }
);
has 'requests' => (
is => 'ro',
isa => 'ArrayRef[Net::BitTorrent::Torrent::Piece::Block]',
traits => ['Array'],
handles => {_add_request => 'push',
_clear_requests => 'clear',
_count_requests => 'count'
},
default => sub { [] }
is => 'ro',
isa =>
'ArrayRef[Net::BitTorrent::Protocol::BEP03::Metadata::Piece::Block]',
traits => ['Array'],
handles => {_add_request => 'push',
_clear_requests => 'clear',
_count_requests => 'count',
_first_request => 'first',
_delete_request => 'delete'
},
default => sub { [] }
);
around '_delete_request' => sub {
my ($c, $s, $i, $o, $l) = @_;
return $c->($s, $i) if !blessed $i;
my $x = 0;
$s->_find_request(
sub {
$x++;
$_->index == $i && $_->offset == $o && $_->length == $l;
}
);
return $c->($s, $x);
};
sub _find_request {
my ($s, $i, $o, $l) = @_;
my $x = 0;
my $p = $s->_first_request(
sub {
$x++;
$_->index == $i && $_->offset == $o && $_->length == $l;
}
);
wantarray ? [$p, $x] : $p;
}
around '_add_request' => sub {
my ($c, $s, $b) = @_;
return if $s->choked;
return if $s->remote_choked;
$c->($s, $b); # XXX - also let the parent client know
# XXX - also let the parent client know
require Scalar::Util;
Scalar::Util::weaken($s->requests->[-1]);
$s->_send_request($b);
$b->_set_peer($s);
};
Expand Down Expand Up @@ -186,13 +216,16 @@ package Net::BitTorrent::Peer;
);
# Utility methods
sub _check_unique_connection { # XXX - Rename this method
#return;
my ($s) = @_;
return
if scalar(grep { $_->_has_peer_id && $_->peer_id eq $s->peer_id }
$s->torrent->peers
) <= 1;
sub _check_unique_connection {
my $s = shift;
return 1
if scalar(
grep {
$_->_has_peer_id
&& $_->_id ne $s->_id
&& $_->peer_id eq $s->peer_id
} $s->torrent->peers
) == 0;
$s->disconnect(sprintf '%s already has connection for this torrent',
$s->peer_id);
}
Expand Down
65 changes: 25 additions & 40 deletions lib/Net/BitTorrent/Protocol/BEP03/Metadata.pm
Expand Up @@ -18,48 +18,33 @@ package Net::BitTorrent::Protocol::BEP03::Metadata;
predicate => '_has_metadata',
init_arg => undef, # cannot set this with new()
coerce => 1,
trigger => sub {
my ($self, $new_value, $old_value) = @_;
if (@_ == 2) { # parse files and trackers
$self->tracker->add_tier([$new_value->{'announce'}])
if $new_value->{'announce'};
if (defined $new_value->{'announce-list'}) {
$self->tracker->add_tier($_)
for @{$new_value->{'announce-list'}};
}

#
my @files;
if (defined $new_value->{'info'}{'files'})
{ # Multi-file .torrent
$self->storage->_set_files($new_value->{'info'}{'files'});
$self->storage->_set_root($new_value->{'info'}{'name'});
}
else { # single file torrent; use the name
$self->storage->_set_files(
[{path => [$new_value->{'info'}{'name'}],
length => $new_value->{'info'}{'length'}
}
]
);
}

#
if ($_[0]->metadata->{'info'}{'private'}) {
require
Net::BitTorrent::Protocol::BEP27::Private::Metadata;
Net::BitTorrent::Protocol::BEP27::Private::Metadata->meta
->apply($_[0]);
}
return 1;
trigger => sub { shift->_trigger_metadata(@_) }
);

sub _trigger_metadata { # Subclasses should override this and call super
my ($self, $new_value, $old_value) = @_;
if (@_ == 2) { # parse trackers
$self->tracker->add_tier([$new_value->{'announce'}])
if $new_value->{'announce'};
if (defined $new_value->{'announce-list'}) {
$self->tracker->add_tier($_)
for @{$new_value->{'announce-list'}};
}
warn 'Someone changed the metadata!';
my $info_hash = $self->info_hash;
$self->_reset_info_hash;
warn sprintf '%s is now %s', $info_hash->to_Hex,
$self->info_hash->to_Hex;

#
if ($_[0]->metadata->{'info'}{'private'}) {
require Net::BitTorrent::Protocol::BEP27::Private::Metadata;
Net::BitTorrent::Protocol::BEP27::Private::Metadata->meta
->apply($_[0]);
}
return 1;
}
);
warn 'Someone changed the metadata!';
my $info_hash = $self->info_hash;
$self->_reset_info_hash;
warn sprintf '%s is now %s', $info_hash->to_Hex,
$self->info_hash->to_Hex;
}
has 'raw_data' => (
isa => 'NBTypes::Bencode',
lazy_build => 1,
Expand Down
@@ -1,14 +1,14 @@
{

package Net::BitTorrent::Torrent::Piece;
package Net::BitTorrent::Protocol::BEP03::Metadata::Piece;
use Moose;
our $MAJOR = 0.074; our $MINOR = 0; our $DEV = 1; our $VERSION = sprintf('%1.3f%03d' . ($DEV ? (($DEV < 0 ? '' : '_') . '%03d') : ('')), $MAJOR, $MINOR, abs $DEV);
sub BUILD {1}
has 'index' => (isa => 'Int',
is => 'ro',
required => 1
);
has 'selector' => (
has 'piece_selector' => (
isa => 'Net::BitTorrent::Torrent::PieceSelector',
is => 'ro',
required => 1,
Expand All @@ -22,8 +22,8 @@

sub _build_length {
my $s = shift;
return $s->torrent->length % $s->torrent->piece_length
if $s->index == $s->torrent->piece_count;
return $s->torrent->size % $s->torrent->piece_length
if $s->index == $s->torrent->piece_count - 1;
return $s->torrent->piece_length;
}
has 'priority' => (
Expand All @@ -43,24 +43,27 @@
return $max > $s->length ? $s->length : $max;
}
has 'blocks' => (
isa => 'ArrayRef[Net::BitTorrent::Torrent::Piece::Block]',
is => 'ro',
lazy_build => 1,
traits => ['Array'],
handles => {
isa =>
'ArrayRef[Net::BitTorrent::Protocol::BEP03::Metadata::Piece::Block]',
is => 'ro',
lazy_build => 1,
traits => ['Array'],
handles => {
_first_unassigned_block => ['first', sub { !$_->_has_peer }],
_all_unassigned_blocks => ['grep', sub { !$_->_has_peer }]
}
_all_unassigned_blocks => ['grep', sub { !$_->_has_peer }],
_first_incompete_block => ['first', sub { !$_->_complete }],
_all_incomplete_blocks => ['grep', sub { !$_->_complete }]
}
);
after 'BUILD' => sub { shift->blocks };

sub _build_blocks {
my $s = shift;
require Net::BitTorrent::Torrent::Piece::Block;
require Net::BitTorrent::Protocol::BEP03::Metadata::Piece::Block;
my $offset = 0;
my @blocks = map {
my $b =
Net::BitTorrent::Torrent::Piece::Block->new(
Net::BitTorrent::Protocol::BEP03::Metadata::Piece::Block->new(
piece => $s,
offset => $offset,
length => $s->block_length
Expand All @@ -69,7 +72,7 @@
$b
} 1 .. int($s->length / $s->block_length);
push @blocks,
Net::BitTorrent::Torrent::Piece::Block->new(
Net::BitTorrent::Protocol::BEP03::Metadata::Piece::Block->new(
piece => $s,
offset => $offset,
length => int($s->length % $s->block_length)
Expand Down
43 changes: 43 additions & 0 deletions lib/Net/BitTorrent/Protocol/BEP03/Metadata/Piece/Block.pm
@@ -0,0 +1,43 @@
{

package Net::BitTorrent::Protocol::BEP03::Metadata::Piece::Block;
use Moose;
our $MAJOR = 0.074; our $MINOR = 0; our $DEV = 1; our $VERSION = sprintf('%1.3f%03d' . ($DEV ? (($DEV < 0 ? '' : '_') . '%03d') : ('')), $MAJOR, $MINOR, abs $DEV);
has 'offset' => (isa => 'Int',
is => 'ro',
required => 1
);
has 'piece' => (
isa => 'Net::BitTorrent::Protocol::BEP03::Metadata::Piece',
is => 'ro',
required => 1,
weak_ref => 1,
handles => {
index => 'index',
piece_selector => 'piece_selector',
_write => sub {
my ($s, $d) = @_;
return $s->_set_complete
if $s->piece_selector->torrent->storage->write($s->index,
$s->offset, $d);
}
}
);
has 'length' => (isa => 'Int',
is => 'ro',
required => 1
);
has 'peer' => (isa => 'Net::BitTorrent::Peer',
is => 'ro',
writer => '_set_peer',
predicate => '_has_peer',
weak_ref => 1
);
has '_complete' => (isa => 'Bool',
traits => ['Bool'],
is => 'ro',
handles => {_set_complete => 'set'},
default => 0
);
}
1;

0 comments on commit 62b27d0

Please sign in to comment.