AnyEvent-BitTorrent
view release on metacpan or search on metacpan
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
builder => '_build_peerid'
);
sub _build_peerid {
return pack(
'a20',
(sprintf(
'-AB%01d%01d%01d%1s-%7s%-5s',
($VERSION =~ m[^v?(\d+)\.(\d+)\.(\d+)]),
($VERSION =~ m[[^\d\.^v]] ? 'U' : 'S'),
(join '',
map {
['A' .. 'Z', 'a' .. 'z', 0 .. 9, qw[- . _ ~]]->[rand(66)]
} 1 .. 7
),
[qw[KaiLi April Aaron Sanko]]->[rand 4]
)
)
);
}
has bitfield => (is => 'ro',
lazy => 1,
builder => '_build_bitfield',
isa => Str,
init_arg => undef,
);
sub _build_bitfield { pack 'b*', "\0" x shift->piece_count }
sub wanted {
my $s = shift;
my $wanted = '';
for my $findex (0 .. $#{$s->files}) {
my $prio = !!$s->files->[$findex]{priority};
for my $index ($s->_file_to_range($findex)) {
vec($wanted, $index, 1) = $prio && !vec($s->bitfield, $index, 1);
}
}
AE::log debug => '->wanted() => ' . unpack 'b*', $wanted;
$wanted;
}
sub complete {
my $s = shift;
-1 == index substr(unpack('b*', $s->wanted), 0, $s->piece_count + 1), 1;
}
sub seed {
my $s = shift;
-1 == index substr(unpack('b*', $s->bitfield), 0, $s->piece_count + 1), 0;
}
sub _left {
my $s = shift;
$s->piece_length * scalar grep {$_} split '',
substr unpack('b*', $s->wanted), 0, $s->piece_count + 1;
}
has $_ => (is => 'ro',
isa => Int,
default => sub {0},
writer => '_set_' . $_
) for qw[uploaded downloaded];
has infohash => (is => 'ro',
lazy => 1,
builder => '_build_infohash',
isa => $INFOHASH,
init_arg => undef
);
sub _build_infohash { sha1(bencode(shift->metadata->{info})) }
has metadata => (is => 'ro',
lazy_build => 1,
builder => '_build_metadata',
lazy => 1,
isa => HashRef,
init_arg => undef
);
sub _build_metadata {
my $s = shift;
#return if ref $s ne __PACKAGE__; # Applying roles makes deep rec
open my $fh, '<', $s->path;
sysread $fh, my $raw, -s $fh;
my $metadata = bdecode $raw;
AE::log debug => sub {
require Data::Dump;
'_build_metadata() => ' . Data::Dump::dump($metadata);
};
$metadata;
}
sub name { shift->metadata->{info}{name} }
sub pieces { shift->metadata->{info}{pieces} }
sub piece_length { shift->metadata->{info}{'piece length'} }
sub piece_count {
my $s = shift;
my $count = $s->size / $s->piece_length;
int($count) + (($count == int $count) ? 1 : 0);
}
has basedir => (
is => 'ro',
lazy => 1,
isa => Str,
required => 1,
default => sub { File::Spec->rel2abs(File::Spec->curdir) },
trigger => sub {
my ($s, $n, $o) = @_;
$o // return;
$s->_clear_files; # So they can be rebuilt with the new basedir
}
);
has files => (is => 'ro',
lazy => 1,
builder => '_build_files',
isa => ArrayRef [HashRef],
init_arg => undef,
clearer => '_clear_files'
);
sub _build_files {
my $s = shift;
defined $s->metadata->{info}{files} ?
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
my $trackers = [
map {
{urls => $_,
complete => 0,
incomplete => 0,
peers => '',
peers6 => '',
announcer => undef,
ticker => AE::timer(
1,
15 * 60,
sub {
return if $s->state eq 'stopped';
$s->announce('started');
}
),
failures => 0
}
} defined $s->metadata->{announce} ? [$s->metadata->{announce}]
: (),
defined $s->metadata->{'announce-list'}
? @{$s->metadata->{'announce-list'}}
: ()
];
AE::log trace => sub {
require Data::Dump;
'$trackers before shuffle => ' . Data::Dump::dump($trackers);
};
$shuffle->($trackers);
$shuffle->($_->{urls}) for @$trackers;
AE::log trace => sub {
require Data::Dump;
'$trackers after shuffle => ' . Data::Dump::dump($trackers);
};
$trackers;
}
sub announce {
my ($s, $e) = @_;
return if $a++ > 10; # Retry attempts
for my $tier (@{$s->trackers}) {
$tier->{announcer} //= $s->_announce_tier($e, $tier);
}
}
sub _announce_tier {
my ($s, $e, $tier) = @_;
my @urls = grep {m[^https?://]} @{$tier->{urls}};
return if $tier->{failures} > 5;
return if $#{$tier->{urls}} < 0; # Empty tier?
return if $tier->{urls}[0] !~ m[^https?://.+];
local $AnyEvent::HTTP::USERAGENT
= 'AnyEvent::BitTorrent/' . $AnyEvent::BitTorrent::VERSION;
my $_url = $tier->{urls}[0] . '?info_hash=' . sub {
local $_ = shift;
s/([^A-Za-z0-9])/sprintf("%%%2.2X", ord($1))/ge;
$_;
}
->($s->infohash)
. ('&peer_id=' . $s->peerid)
. ('&uploaded=' . $s->uploaded)
. ('&downloaded=' . $s->downloaded)
. ('&left=' . $s->_left)
. ('&port=' . $s->port)
. '&compact=1'
. ($e ? '&event=' . $e : '');
AE::log debug => 'Announce URL: ' . $_url;
http_get $_url, sub {
my ($body, $hdr) = @_;
AE::log trace => sub {
require Data::Dump;
'Announce response: ' . Data::Dump::dump($body, $hdr);
};
$tier->{announcer} = ();
if ($hdr->{Status} =~ /^2/) {
my $reply = bdecode($body);
if (defined $reply->{'failure reason'}) { # XXX - Callback?
push @{$tier->{urls}}, shift @{$tier->{urls}};
$s->_announce_tier($e, $tier);
$tier->{'failure reason'} = $reply->{'failure reason'};
$tier->{failures}++;
}
else { # XXX - Callback?
$tier->{failures} = $tier->{'failure reason'} = 0;
$tier->{peers}
= compact_ipv4(
uncompact_ipv4($tier->{peers} . $reply->{peers}))
if $reply->{peers};
$tier->{peers6}
= compact_ipv6(
uncompact_ipv6($tier->{peers6} . $reply->{peers6}))
if $reply->{peers6};
$tier->{complete} = $reply->{complete};
$tier->{incomplete} = $reply->{incomplete};
$tier->{ticker} = AE::timer(
$reply->{interval} // (15 * 60),
$reply->{interval} // (15 * 60),
sub {
return if $s->state eq 'stopped';
$s->_announce_tier($e, $tier);
}
);
}
}
else { # XXX - Callback?
$tier->{'failure reason'}
= "HTTP Error: $hdr->{Status} $hdr->{Reason}\n";
$tier->{failures}++;
push @{$tier->{urls}}, shift @{$tier->{urls}};
$s->_announce_tier($e, $tier);
}
}
}
has _choke_timer => (
is => 'bare',
isa => Ref,
init_arg => undef,
required => 1,
default => sub {
my $s = shift;
AE::timer(
15, 45,
sub {
return if $s->state ne 'active';
AE::log trace => 'Choke timer...';
my @interested
= grep { $_->{remote_interested} && $_->{remote_choked} }
values %{$s->peers};
# XXX - Limit the number of upload slots
for my $p (@interested) {
$p->{remote_choked} = 0;
$s->_send_encrypted($p->{handle}, build_unchoke());
AE::log trace => 'Choked %s', $p->{peerid};
}
# XXX - Send choke to random peer
}
);
}
);
has _fill_requests_timer => (
is => 'bare',
isa => Ref,
init_arg => undef,
required => 1,
default => sub {
my $s = shift;
AE::timer(
15, 10,
sub { # XXX - Limit by time/bandwidth
return if $s->state ne 'active';
AE::log trace => 'Request fill timer...';
my @waiting
= grep { defined && scalar @{$_->{remote_requests}} }
values %{$s->peers};
return if !@waiting;
my $total_sent = 0;
while (@waiting && $total_sent < 2**20) {
my $p = splice(@waiting, rand @waiting, 1, ());
AE::log trace => 'Chosen peer: %s...', $p->{peerid};
while ($total_sent < 2**20 && @{$p->{remote_requests}}) {
my $req = shift @{$p->{remote_requests}};
AE::log
trace =>
'Filling request i:%d, o:%d, l:%d for %s',
@$req;
# XXX - If piece is bad locally
# if remote supports fast ext
# send reject
# else
# simply return
# else...
$s->_send_encrypted(
$p->{handle},
build_piece(
$req->[0], $req->[1],
$s->_read($req->[0], $req->[1], $req->[2])
)
);
$total_sent += $req->[2];
}
}
$s->_set_uploaded($s->uploaded + $total_sent);
}
);
}
);
has _peer_timer => (is => 'ro',
lazy => 1,
isa => Ref,
init_arg => undef,
clearer => '_clear_peer_timer',
builder => '_build_peer_timer'
);
sub _build_peer_timer {
my $s = shift;
AE::timer(
1, 15,
sub {
return if !$s->_left;
AE::log trace => 'Attempting to connect to new peer...';
# XXX - Initiate connections when we are in Super seed mode?
my @cache = map {
$_->{peers} ? uncompact_ipv4($_->{peers}) : (),
$_->{peers6} ?
uncompact_ipv6($_->{peers6})
: ()
} @{$s->trackers};
return if !@cache;
for my $i (1 .. @cache) {
last if $i > 10; # XXX - Max half open
last
if scalar(keys %{$s->peers}) > 100; # XXX - Max peers
my $addr = splice @cache, rand $#cache, 1;
$s->_new_peer($addr);
}
}
);
}
sub _new_peer {
my ($s, $addr) = @_;
AE::log trace => 'Connecting to %s:%d', @$addr;
my $handle;
$handle = AnyEvent::Handle->new(
connect => $addr,
on_prepare => sub {60},
on_error => sub {
my ($hdl, $fatal, $msg) = @_;
# XXX - callback
AE::log
error => 'Socket error: %s (Removing peer)',
$msg;
$s->_del_peer($hdl);
},
on_connect_error => sub {
my ($hdl, $fatal, $msg) = @_;
$s->_del_peer($hdl);
# XXX - callback
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
=item ...a list of integers. You could use this to check a range of pieces (a
single file, for example).
$client->hashcheck( 1 .. 5, 34 .. 56 );
=item ...a single integer. Only that specific piece is checked.
$client->hashcheck( 17 );
=item ...nothing. All data related to this torrent will be checked.
$client->hashcheck( );
=back
As pieces pass or fail, your C<on_hash_pass> and C<on_hash_fail> callbacks are
triggered.
=head2 C<start( )>
Sends a 'started' event to trackers and starts performing as a client is
expected. New connections are made and accepted, requests are made and filled,
etc.
=head2 C<stop( )>
Sends a stopped event to trackers, closes all connections, stops attempting
new outgoing connections, rejects incoming connections and closes all open
files.
=head2 C<pause( )>
The client remains mostly active; new connections will be made and accepted,
etc. but no requests will be made or filled while the client is paused.
=head2 C<infohash( )>
Returns the 20-byte SHA1 hash of the value of the info key from the metadata
file.
=head2 C<peerid( )>
Returns the 20 byte string used to identify the client. Please see the
L<spec|/"PeerID Specification"> below.
=head2 C<port( )>
Returns the port number the client is listening on.
=head2 C<size( )>
Returns the total size of all L<files|/"files( )"> described in the torrent's
metadata.
=head2 C<name( )>
Returns the UTF-8 encoded string the metadata suggests we save the file (or
directory, in the case of multi-file torrents) under.
=head2 C<uploaded( )>
Returns the total amount uploaded to remote peers.
=head2 C<downloaded( )>
Returns the total amount downloaded from other peers.
=head2 C<left( )>
Returns the approximate amount based on the pieces we still
L<want|/"wanted( )"> multiplied by the L<size of pieces|/"piece_length( )">.
=head2 C<piece_length( )>
Returns the number of bytes in each piece the file or files are split into.
For the purposes of transfer, files are split into fixed-size pieces which are
all the same length except for possibly the last one which may be truncated.
=head2 C<bitfield( )>
Returns a packed binary string in ascending order (ready for C<vec()>). Each
index that the client has is set to one and the rest are set to zero.
=head2 C<wanted( )>
Returns a packed binary string in ascending order (ready for C<vec()>). Each
index that the client has or simply does not want is set to zero and the rest
are set to one.
This value is calculated every time the method is called. Keep that in mind.
=head2 C<complete( )>
Returns true if we have downloaded everything we L<wanted|/"wanted( )"> which
is not to say that we have all data and can L<seed|/"seed( )">.
=head2 C<seed( )>
Returns true if we have all data related to the torrent.
=head2 C<files( )>
Returns a list of hash references with the following keys:
=over
=item C<length>
Which is the size of file in bytes.
=item C<path>
Which is the absolute path of the file.
=item C<priority>
Download priority for this file. By default, all files have a priority of
C<1>. There is no built in scale; the higher the priority, the better odds a
piece from it will be downloaded first. Setting a file's priority to C<1000>
while the rest are still at C<1> will likely force the file to complete before
any other file is started.
( run in 1.718 second using v1.01-cache-2.11-cpan-b16cb0d3907 )