#!/usr/bin/perl -w
package Net::BitTorrent;
{
use strict;
use warnings;
use Scalar::Util qw[blessed weaken refaddr];
use List::Util qw[max];
use Time::HiRes;
use Socket qw[/inet_/ SOCK_STREAM SOCK_DGRAM SOL_SOCKET PF_INET SOMAXCONN
/pack_sockaddr_in/ SO_REUSEADDR];
use Carp qw[carp];
use Digest::SHA qw[sha1_hex];
use POSIX qw[];
sub _EWOULDBLOCK { $^O eq q[MSWin32] ? 10035 : POSIX::EWOULDBLOCK() }
sub _EINPROGRESS { $^O eq q[MSWin32] ? 10036 : POSIX::EINPROGRESS() }
use lib q[../../lib];
use Net::BitTorrent::Util qw[:bencode :compact];
use Net::BitTorrent::Torrent;
use Net::BitTorrent::Peer;
use Net::BitTorrent::DHT;
use Net::BitTorrent::Version;
use version qw[qv];
our $VERSION_BASE = 50; our $UNSTABLE_RELEASE = 0; our $VERSION = sprintf(($UNSTABLE_RELEASE ? q[%.3f_%03d] : q[%.3f]), (version->new(($VERSION_BASE))->numify / 1000), $UNSTABLE_RELEASE);
my (@CONTENTS) = \my (
%_tcp, %_udp,
%_schedule, %_tid,
%_event, %torrents,
%_connections, %peerid,
%_max_ul_rate, %_k_ul,
%_max_dl_rate, %_k_dl,
%_dht, %_use_dht,
%__UDP_OBJECT_CACHE, %_peers_per_torrent,
%_connections_per_host, %_half_open,
#############################################################
%_encryption_mode
);
my %REGISTRY;
sub _MSE_DISABLED {0}
sub _MSE_ENABLED {1}
sub _MSE_FORCED {2}
sub new {
my ($class, $args) = @_;
my $self = bless \$class, $class;
my ($host, @ports) = (q[0.0.0.0], (0));
# Defaults
$_max_ul_rate{refaddr $self} = 0;
$_k_ul{refaddr $self} = 0;
$_max_dl_rate{refaddr $self} = 0;
$_k_dl{refaddr $self} = 0;
$_peers_per_torrent{refaddr $self} = 100;
$_half_open{refaddr $self} = 8;
$_connections_per_host{refaddr $self} = 1;
$torrents{refaddr $self} = {};
$_tid{refaddr $self} = qq[\0] x 5;
$_use_dht{refaddr $self} = 1;
$_encryption_mode{refaddr $self} = _MSE_ENABLED;
# Internals
$_connections{refaddr $self} = {};
$_schedule{refaddr $self} = {};
$_dht{refaddr $self} = Net::BitTorrent::DHT->new({Client => $self});
$peerid{refaddr $self} = Net::BitTorrent::Version::gen_peerid();
if (defined $args) {
if (ref($args) ne q[HASH]) {
carp q[Net::BitTorrent->new({}) requires ]
. q[parameters to be passed as a hashref];
return;
}
$host = $args->{q[LocalHost]}
if defined $args->{q[LocalHost]};
@ports
= defined $args->{q[LocalPort]}
? (ref($args->{q[LocalPort]}) eq q[ARRAY]
? @{$args->{q[LocalPort]}}
: $args->{q[LocalPort]}
)
: @ports;
}
# Try opening a matching set of ports
for my $port (@ports) {
last
if $self->_socket_open_tcp($host, $port)
&& $self->_socket_open_udp($host, $port);
}
# Clear everything just in case
$self->_reset_bandwidth;
weaken($REGISTRY{refaddr $self} = $self);
$$self = $peerid{refaddr $self};
return $self;
}
# Accessors | Private
sub _tcp { return $_tcp{refaddr +shift} }
sub _udp { return $_udp{refaddr +shift} }
sub _connections { return $_connections{refaddr +shift} }
sub _max_ul_rate { return $_max_ul_rate{refaddr +shift} }
sub _max_dl_rate { return $_max_dl_rate{refaddr +shift} }
sub _peers_per_torrent { return $_peers_per_torrent{refaddr +shift} }
sub _half_open { return $_half_open{refaddr +shift} }
sub _connections_per_host {
return $_connections_per_host{refaddr +shift};
}
sub _dht { return $_dht{refaddr +shift} }
sub _use_dht {
my ($s) = @_;
return $_udp{refaddr $s} && $_use_dht{refaddr $s};
}
sub _tcp_port {
my ($self) = @_;
return if not defined $_tcp{refaddr $self};
my ($port, undef)
= unpack_sockaddr_in(getsockname($_tcp{refaddr $self}));
return $port;
}
sub _tcp_host {
my ($self) = @_;
return if not defined $_tcp{refaddr $self};
my (undef, $packed_ip)
= unpack_sockaddr_in(getsockname($_tcp{refaddr $self}));
return inet_ntoa($packed_ip);
}
sub _udp_port {
my ($self) = @_;
return if not defined $_udp{refaddr $self};
my ($port, undef)
= unpack_sockaddr_in(getsockname($_udp{refaddr $self}));
return $port;
}
sub _udp_host {
my ($self) = @_;
return if not defined $_udp{refaddr $self};
my (undef, $packed_ip)
= unpack_sockaddr_in(getsockname($_udp{refaddr $self}));
return inet_ntoa($packed_ip);
}
sub _encryption_mode {
my ($self) = @_;
return $_encryption_mode{refaddr $self};
}
# Setters | Private
sub _set_encryption_mode {
my ($self, $value) = @_;
if (not defined $value
or ( ($value != _MSE_DISABLED)
and ($value != _MSE_ENABLED)
and ($value != _MSE_FORCED))
)
{ carp
q[Net::BitTorrent->_set_encryption_mode( VALUE ) requires an integer value];
return;
}
return $_encryption_mode{refaddr $self} = $value;
}
sub _set_max_ul_rate { # BYTES per second
my ($self, $value) = @_;
if (not defined $value or $value !~ m[^\d+$] or !$value) {
carp
q[Net::BitTorrent->_set_max_ul_rate( VALUE ) requires an integer value];
return;
}
return $_max_ul_rate{refaddr $self} = $value;
}
sub _set_max_dl_rate { # BYTES per second
my ($self, $value) = @_;
if (not defined $value or $value !~ m[^\d+$]) {
carp
q[Net::BitTorrent->_set_max_dl_rate( VALUE ) requires an integer value];
return;
}
return $_max_dl_rate{refaddr $self} = $value;
}
sub _set_peers_per_torrent {
my ($self, $value) = @_;
if (not defined $value or $value !~ m[^\d+$] or $value < 1) {
carp
q[Net::BitTorrent->_set_peers_per_torrent( VALUE ) requires an integer value];
return;
}
return $_peers_per_torrent{refaddr $self} = $value;
}
sub _set_half_open {
my ($self, $value) = @_;
if (not defined $value or $value !~ m[^\d+$] or $value < 1) {
carp
q[Net::BitTorrent->_set_half_open( VALUE ) requires an integer value];
return;
}
return $_half_open{refaddr $self} = $value;
}
sub _set_connections_per_host {
my ($self, $value) = @_;
if (not defined $value or $value !~ m[^\d+$] or $value < 1) {
carp
q[Net::BitTorrent->_set_connections_per_host( VALUE ) requires an integer value];
return;
}
return $_connections_per_host{refaddr $self} = $value;
}
sub _set_use_dht {
my ($self, $value) = @_;
if (not defined $value or $value !~ m[^[10]$]) {
carp
q[Net::BitTorrent->_set_use_dht( VALUE ) requires a bool value];
return;
}
return $_use_dht{refaddr $self} = $value;
}
# Accessors | Public
sub peerid { my ($self) = @_; return $peerid{refaddr $self} }
sub torrents { my ($self) = @_; return $torrents{refaddr $self} }
# Methods | Public
sub do_one_loop {
my ($self, $timeout) = @_;
$self->_process_schedule;
$timeout
= defined $timeout && $timeout =~ m[^(\-1|\d+)\.?\d*$]
? $timeout < 0
? undef
: $timeout
: 1;
my ($rin, $win, $ein) = (q[], q[], q[]);
PUSHSOCK: for my $fileno (keys %{$_connections{refaddr $self}}) {
vec($rin, $fileno, 1) = 1
if $_connections{refaddr $self}{$fileno}{q[Mode]} =~ m[r];
vec($win, $fileno, 1) = 1
if $_connections{refaddr $self}{$fileno}{q[Mode]} =~ m[w];
vec($ein, $fileno, 1) = 1;
}
my ($nfound, $timeleft) = select($rin, $win, $ein, $timeout);
$self->_process_connections(\$rin, \$win, \$ein)
if $nfound and $nfound != -1;
return 1;
}
# Methods | Private
sub _reset_bandwidth {
my ($self) = @_;
$self->_schedule({Time => time + 1,
Code => \&_reset_bandwidth,
Object => $self
}
);
#warn sprintf q[Speed report: Up: %5dB/s | Down: %5dB/s],
# $_k_ul{refaddr $_[0]},
# $_k_dl{refaddr $_[0]};
return $_k_dl{refaddr $_[0]} = $_k_ul{refaddr $_[0]} = 0;
}
sub _add_connection {
my ($self, $connection, $mode) = @_;
if (not defined $connection) {
carp q[Net::BitTorrent->_add_connection() requires an object];
return;
}
if (not blessed $connection) {
carp
q[Net::BitTorrent->_add_connection() requires a blessed object];
return;
}
my $_sock = $connection->_socket;
if ((not $_sock) or (ref($_sock) ne q[GLOB])) { return; }
if ((!$mode) || ($mode !~ m[^(?:ro|rw|wo)$])) {
carp
q[Net::BitTorrent->_add_connection(SOCKET, MODE) requires a mode parameter];
return;
}
return $_connections{refaddr $self}{fileno $_sock} = {
Object => $connection,
Mode => $mode
};
}
sub _remove_connection {
my ($self, $connection) = @_;
if (not defined $connection) {
carp q[Net::BitTorrent->_remove_connection() requires an object];
return;
}
if (not blessed $connection) {
carp
q[Net::BitTorrent->_remove_connection() requires a blessed object];
return;
}
my $socket = $connection->_socket;
return if not defined $socket;
return delete $_connections{refaddr $self}{fileno $socket};
}
sub _socket_open_tcp {
my ($self, $host, $port) = @_;
if ( not $self
|| not blessed $self
|| not $self->isa(q[Net::BitTorrent]))
{ carp
q[Net::BitTorrent->_socket_open_tcp(HOST, PORT) requires a blessed object];
return;
}
if ((!$_tcp{refaddr $self}) && (!$host)) {
carp q[Net::BitTorrent::_socket_open_tcp( ) ]
. q[requires a hostname];
return;
}
if (defined $port and $port !~ m[^\d+$]) {
carp q[Net::BitTorrent::_socket_open_tcp( ) ]
. q[requires an integer port number];
return;
}
my $_packed_host = undef;
$host ||= q[0.0.0.0];
$port ||= 0;
$port =~ m[^(\d+)$];
$port = $1;
if ( $host
and $host
!~ m[^(?:(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.]?){4})$])
{ my ($name, $aliases, $addrtype, $length, @addrs)
= gethostbyname($host)
or return;
$_packed_host = $addrs[0];
}
else { $_packed_host = inet_aton($host) }
socket(my ($_tcp), PF_INET, SOCK_STREAM, getprotobyname(q[tcp]))
or return;
# - What is the difference between SO_REUSEADDR and SO_REUSEPORT?
# [http://www.unixguide.net/network/socketfaq/4.11.shtml]
# - setsockopt - what are the options for ActivePerl under Windows NT?
# [http://perlmonks.org/?node_id=63280]
# setsockopt($_tcp, SOL_SOCKET, SO_REUSEADDR, pack(q[l], 1))
# or return;
# SO_REUSEPORT is undefined on Win32... Boo...
#if ($reuse_port and defined SO_REUSEPORT) { # XXX - undocumented
# setsockopt($_udp, SOL_SOCKET, SO_REUSEPORT, pack(q[l], 1))
# or return;
#}
bind($_tcp, pack_sockaddr_in($port, $_packed_host))
or return;
listen($_tcp, 1) or return;
$_connections{refaddr $self}{fileno $_tcp} = {Object => $self,
Mode => q[ro],
}
or return;
if ( defined $_tcp{refaddr $self}
&& fileno $_tcp{refaddr $self}
&& defined $_connections{refaddr $self}
{fileno $_tcp{refaddr $self}})
{ delete $_connections{refaddr $self}{fileno $_tcp{refaddr $self}};
close $_tcp{refaddr $self};
}
return $_tcp{refaddr $self} = $_tcp;
}
sub _socket_open_udp {
my ($self, $host, $port) = @_;
if ( not $self
|| not blessed $self
|| not $self->isa(q[Net::BitTorrent]))
{ carp
q[Net::BitTorrent->_socket_open_udp(HOST, PORT) requires a blessed object];
return;
}
if ((!$_tcp{refaddr $self}) && (!$host)) {
carp q[Net::BitTorrent::_socket_open_udp( ) ]
. q[requires a hostname];
return;
}
if (defined $port and $port !~ m[^\d+$]) {
carp q[Net::BitTorrent::_socket_open_udp( ) ]
. q[requires an integer port number];
return;
}
my $_packed_host = undef;
$host ||= q[0.0.0.0];
#$port = $port ? $port : $_udp{refaddr $self} ? $self->_udp_port : 0;
$port ||= 0;
$port =~ m[^(\d+)$];
$port = $1;
if ( $host
and $host
!~ m[^(?:(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.]?){4})$])
{ my ($name, $aliases, $addrtype, $length, @addrs)
= gethostbyname($host)
or return;
$_packed_host = $addrs[0];
}
else { $_packed_host = inet_aton($host) }
socket(my ($_udp), PF_INET, SOCK_DGRAM, getprotobyname(q[udp]))
or return;
# - What is the difference between SO_REUSEADDR and SO_REUSEPORT?
# [http://www.unixguide.net/network/socketfaq/4.11.shtml]
# - setsockopt - what are the options for ActivePerl under Windows NT?
# [http://perlmonks.org/?node_id=63280]
# setsockopt($_udp, SOL_SOCKET, SO_REUSEADDR, pack(q[l], 1))
# or return;
# SO_REUSEPORT is undefined on Win32... Boo...
#if ($reuse_port and defined SO_REUSEPORT) { # XXX - undocumented
# setsockopt($_udp, SOL_SOCKET, SO_REUSEPORT, pack(q[l], 1))
# or return;
#}
bind($_udp, pack_sockaddr_in($port, $_packed_host))
or return;
$_connections{refaddr $self}{fileno $_udp} = {Object => $self,
Mode => q[ro],
}
or return;
if ( $_udp{refaddr $self}
&& fileno $_udp{refaddr $self}
&& defined $_connections{refaddr $self}
{fileno $_udp{refaddr $self}})
{ delete $_connections{refaddr $self}{fileno $_udp{refaddr $self}};
close $_udp{refaddr $self};
}
return $_udp{refaddr $self} = $_udp;
}
sub _process_connections {
my ($self, $rin, $win, $ein) = @_;
if (!( ($rin and ref $rin and ref $rin eq q[SCALAR])
and ($win and ref $win and ref $win eq q[SCALAR])
and ($ein and ref $ein and ref $ein eq q[SCALAR])
)
)
{ carp
q[Malformed parameters to Net::BitTorrent::_process_connections(RIN, WIN, EIN)];
return;
}
POPSOCK: foreach my $fileno (keys %{$_connections{refaddr $self}}) {
next POPSOCK unless defined $_connections{refaddr $self}{$fileno};
if ( $_tcp{refaddr $self}
&& $fileno == fileno $_tcp{refaddr $self})
{ if (vec($$rin, $fileno, 1) == 1) {
vec($$rin, $fileno, 1) = 0;
if (scalar(
grep {
$_->{q[Object]}->isa(q[Net::BitTorrent::Peer])
&& !$_->{q[Object]}->torrent
} values %{$_connections{refaddr $self}}
) < $_half_open{refaddr $self}
)
{ accept(my ($new_socket), $_tcp{refaddr $self})
or next POPSOCK;
Net::BitTorrent::Peer->new({Socket => $new_socket,
Client => $self
}
);
}
}
}
elsif ( $_udp{refaddr $self}
&& $fileno == fileno $_udp{refaddr $self})
{ if (vec($$rin, $fileno, 1) == 1) {
vec($$rin, $fileno, 1) = 0;
my $paddr
= recv($_udp{refaddr $self}, my ($data), 1024, 0)
or next POPSOCK;
if ($__UDP_OBJECT_CACHE{refaddr $self}{$paddr}{q[Object]})
{ $__UDP_OBJECT_CACHE{refaddr $self}{$paddr}{q[Object]}
->_on_data($paddr, $data)
or
delete $__UDP_OBJECT_CACHE{refaddr $self}{$paddr}
{q[Object]};
next POPSOCK;
}
else {
for my $_tor (values %{$torrents{refaddr $self}}) {
for my $_tier (@{$_tor->trackers}) {
my ($tracker) = grep {
$_->isa(
q[Net::BitTorrent::Torrent::Tracker::UDP]
)
and $_->_packed_host eq $paddr
} @{$_tier->urls};
if ( $tracker
&& $tracker->_on_data($paddr, $data))
{ $__UDP_OBJECT_CACHE{refaddr $self}{$paddr}
= {Object => $tracker};
weaken($__UDP_OBJECT_CACHE{refaddr $self}
{$paddr}{q[Object]});
next POPSOCK;
}
}
}
}
if ( $_use_dht{refaddr $self}
&& $_dht{refaddr $self}->_on_data($paddr, $data))
{ $__UDP_OBJECT_CACHE{refaddr $self}{$paddr}
= {Object => $_dht{refaddr $self}};
weaken($__UDP_OBJECT_CACHE{refaddr $self}{$paddr}
{q[Object]});
}
next POPSOCK;
}
}
else {
my $read = (($_max_dl_rate{refaddr $self}
? max(0,
( $_max_dl_rate{refaddr $self}
- $_k_dl{refaddr $self}
)
)
: (2**15)
) * vec($$rin, $fileno, 1)
);
my $write = (($_max_ul_rate{refaddr $self}
? max(0,
( $_max_ul_rate{refaddr $self}
- $_k_ul{refaddr $self}
)
)
: (2**15)
) * vec($$win, $fileno, 1)
);
my $error = vec($$ein, $fileno, 1)
&& ( $^E
&& ($^E != _EINPROGRESS)
&& ($^E != _EWOULDBLOCK));
if ($read || $write || $error) {
my ($this_r, $this_w)
= $_connections{refaddr $self}{$fileno}{q[Object]}
->_rw($read, $write, $error);
$_k_dl{refaddr $self} += defined $this_r ? $this_r : 0;
$_k_ul{refaddr $self} += defined $this_w ? $this_w : 0;
vec($$rin, $fileno, 1) = 0;
vec($$win, $fileno, 1) = 0;
vec($$ein, $fileno, 1) = 0;
}
}
}
return 1;
}
# Methods | Private | Torrents
sub _locate_torrent {
my ($self, $infohash) = @_;
carp q[Bad infohash for Net::BitTorrent->_locate_torrent(INFOHASH)]
&& return
if $infohash !~ m[^[\d|a-f]{40}$]i;
return $torrents{refaddr $self}{lc $infohash}
? $torrents{refaddr $self}{lc $infohash}
: undef;
}
# Methods | Public | Torrents
sub add_torrent {
my ($self, $args) = @_;
if (ref($args) ne q[HASH]) {
carp
q[Net::BitTorrent->add_torrent() requires params passed as a hash ref];
return;
}
$args->{q[Client]} = $self;
my $torrent = Net::BitTorrent::Torrent->new($args);
return if not defined $torrent;
return if $self->_locate_torrent($torrent->infohash);
return $torrents{refaddr $self}{$torrent->infohash} = $torrent;
}
sub remove_torrent {
my ($self, $torrent) = @_;
if ( not blessed($torrent)
or not $torrent->isa(q[Net::BitTorrent::Torrent]))
{ carp
q[Net::BitTorrent->remove_torrent(TORRENT) requires a blessed Net::BitTorrent::Torrent object];
return;
}
for my $_peer ($torrent->peers) {
$_peer->_disconnect(
q[Removing .torrent torrent from local client]);
}
$torrent->stop; # XXX - Should this be here?
return delete $torrents{refaddr $self}{$torrent->infohash};
}
# Methods | Public | Callback system
sub on_event {
my ($self, $type, $method) = @_;
carp sprintf q[Unknown callback: %s], $type
unless ___check_event($type);
$_event{refaddr $self}{$type} = $method;
}
# Methods | Private | Callback system
sub _event {
my ($self, $type, $args) = @_;
carp sprintf
q[Unknown event: %s. This is a bug in Net::BitTorrent; Report it.],
$type
unless ___check_event($type);
return $_event{refaddr $self}{$type}
? $_event{refaddr $self}{$type}($self, $args)
: ();
}
# Functions | Private | Callback system
sub ___check_event {
my $type = shift;
return scalar grep { $_ eq $type } qw[
ip_filter
incoming_packet outgoing_packet
peer_connect peer_disconnect
peer_read peer_write
tracker_connect tracker_disconnect
tracker_read tracker_write
tracker_success tracker_failure
piece_hash_pass piece_hash_fail
file_open file_close
file_read file_write
file_error
];
}
# Methods | Private | Internal event scheduler
sub _schedule {
my ($self, $args) = @_;
if ((!$args) || (ref $args ne q[HASH])) {
carp
q[Net::BitTorrent->_schedule() requires params to be passed as a HashRef];
return;
}
if ((!$args->{q[Object]}) || (!blessed $args->{q[Object]})) {
carp
q[Net::BitTorrent->_schedule() requires a blessed 'Object' parameter];
return;
}
if ((!$args->{q[Time]}) || ($args->{q[Time]} !~ m[^\d+(?:\.\d+)?$])) {
carp
q[Net::BitTorrent->_schedule() requires an integer or float 'Time' parameter];
return;
}
if ((!$args->{q[Code]}) || (ref $args->{q[Code]} ne q[CODE])) {
carp q[Net::BitTorrent->_schedule() requires a 'Code' parameter];
return;
}
my $tid = $self->_generate_token_id();
$_schedule{refaddr $self}{$tid} = {Timestamp => $args->{q[Time]},
Code => $args->{q[Code]},
Object => $args->{q[Object]}
};
weaken $_schedule{refaddr $self}{$tid}{q[Object]};
return $tid;
}
sub _cancel {
my ($self, $tid) = @_;
if (!$tid) {
carp q[Net::BitTorrent->_cancel( TID ) requires an ID];
return;
}
if (!$_schedule{refaddr $self}{$tid}) {
carp sprintf
q[Net::BitTorrent->_cancel( TID ) cannot find an event with TID == %s],
$tid;
return;
}
return delete $_schedule{refaddr $self}{$tid};
}
sub _process_schedule {
my ($self) = @_;
for my $job (keys %{$_schedule{refaddr $self}}) {
if ($_schedule{refaddr $self}{$job}->{q[Timestamp]} <= time) {
&{$_schedule{refaddr $self}{$job}->{q[Code]}}(
$_schedule{refaddr $self}{$job}->{q[Object]})
if defined $_schedule{refaddr $self}{$job}->{q[Object]};
delete $_schedule{refaddr $self}{$job};
}
}
return 1;
}
# Methods | Private | Various
sub _generate_token_id {
return if defined $_[1];
my ($self) = @_;
$_tid{refaddr $self} ||= qq[\0] x 4;
my ($len) = ($_tid{refaddr $self} =~ m[^([a-z]+)]);
$_tid{refaddr $self} = (
($_tid{refaddr $self} =~ m[^z*(\0*)$])
? ($_tid{refaddr $self} =~ m[\0]
? pack(q[a] . (length $_tid{refaddr $self}),
(q[a] x (length($len || q[]) + 1))
)
: (q[a] . (qq[\0] x (length($_tid{refaddr $self}) - 1)))
)
: ++$_tid{refaddr $self}
);
return $_tid{refaddr $self};
}
sub _build_reserved {
my ($self) = @_;
my @reserved = qw[0 0 0 0 0 0 0 0];
$reserved[5] |= 0x10; # Ext Protocol
$reserved[7] |= 0x04; # Fast Ext
return join q[], map {chr} @reserved;
}
sub as_string {
my ($self, $advanced) = @_;
my $dump
= !$advanced ? $peerid{refaddr $self} : sprintf <<'END',
Net::BitTorrent
Peer ID: %s
DHT is %sabled (Node ID: %s)
TCP Address: %s:%d
UDP Address: %s:%d
----------
Torrents in queue: %d
%s
----------
END
$peerid{refaddr $self},
$_use_dht{refaddr $self} ? q[En] : q[Dis],
unpack(q[H*], $_dht{refaddr $self}->node_id),
$self->_tcp_host, $self->_tcp_port, $self->_udp_host,
$self->_udp_port, (scalar keys %{$torrents{refaddr $self}}), join(
qq[\r\n],
map {
sprintf q[%40s (%d: %s)], $_->infohash, $_->status,
$_->_status_as_string()
} values %{$torrents{refaddr $self}}
);
return defined wantarray ? $dump : print STDERR qq[$dump\n];
}
sub CLONE {
for my $_oID (keys %REGISTRY) {
my $_obj = $REGISTRY{$_oID};
my $_nID = refaddr $_obj;
for (@CONTENTS) {
$_->{$_nID} = $_->{$_oID};
delete $_->{$_oID};
}
delete $_schedule{$_nID};
weaken($REGISTRY{$_nID} = $_obj);
delete $REGISTRY{$_oID};
}
return 1;
}
DESTROY {
my ($self) = @_;
close($_tcp{refaddr $self}) if $_tcp{refaddr $self};
close($_udp{refaddr $self}) if $_udp{refaddr $self};
foreach my $conn (values %{$_connections{refaddr $self}}) {
close($conn->{q[Object]}->_socket) if $conn->{q[Object]};
}
for (@CONTENTS) { delete $_->{refaddr $self}; }
return delete $REGISTRY{refaddr $self};
}
1;
}
=pod
=head1 NAME
Net::BitTorrent - BitTorrent peer-to-peer protocol class
=head1 Synopsis
use Net::BitTorrent;
my $client = Net::BitTorrent->new();
$client->on_event(
q[piece_hash_pass],
sub {
my ($self, $args) = @_;
printf(qq[pass: piece number %04d of %s\n],
$args->{q[Index]}, $args->{q[Torrent]}->infohash);
}
);
my $torrent = $client->add_torrent({Path => q[a.legal.torrent]})
or die q[Cannot load .torrent];
$torrent->hashcheck; # Verify any existing data
$client->do_one_loop() while 1;
=head1 Description
L<Net::BitTorrent|Net::BitTorrent> is a class based implementation of the
BitTorrent Protocol for distributed data exchange.
=head1 Constructor
=over 4
=item C<new ( { [ARGS] } )>
Creates a L<Net::BitTorrent|Net::BitTorrent> object. This constructor
expects arguments as a hashref, using key-value pairs, all of which are
optional. The most common are:
=over 4
=item C<LocalHost>
Local host bind address. The value must be an IPv4 ("dotted quad") IP-
address of the C<xxx.xxx.xxx.xxx> form.
Default: C<0.0.0.0> (any address)
=item C<LocalPort>
TCP and UDP port opened to remote peers for incoming connections. If
handed a list of ports (ex. C<{ LocalPort =E<gt> [6952, 6881..6889] }>),
L<Net::BitTorrent|Net::BitTorrent> will traverse the list, attempting to
open on each of the ports until we succeed or run out of ports.
Default: C<0> (any available, chosen by the OS)
=back
=back
=head1 Methods
Unless stated, all methods return either a C<true> or C<false> value,
with C<true> meaning that the operation was a success. When a method
states that it returns some other specific value, failure will result in
C<undef> or an empty list.
=over 4
=item C<add_torrent ( { ... } )>
Loads a .torrent file and adds the
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent> object to the
client's queue.
Aside from the C<Client> parameter (which is filled in automatically),
this method hands everything off to
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent>'s constructor, so
see L<Net::BitTorrent::Torrent::new( )|Net::BitTorrent::Torrent/"new ( { [ARGS] } )">
for a list of expected parameters.
This method returns the new
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent> object on success.
See also: L<torrents ( )|/"torrents ( )">,
L<remove_torrent ( )|/"remove_torrent ( TORRENT )">,
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent>
=item C<do_one_loop ( [TIMEOUT] )>
Processes the internal schedule and handles activity of the various
socket-containing objects (L<peers|Net::BitTorrent::Peer>,
L<trackers|Net::BitTorrent::Torrent::Tracker>,
L<DHT|Net::BitTorrent::DHT>). This method should be called frequently
to be of any use at all.
The optional TIMEOUT parameter is the maximum amount of time, in seconds,
possibly fractional, C<select()> is allowed to wait before returning.
This TIMEOUT defaults to C<1.0> (one second). To wait indefinitely,
TIMEOUT should be C<-1.0> (C<...-E<gt>do_one_loop(-1)>).
=item C<on_event ( TYPE, CODEREF )>
Net::BitTorrent provides a convenient callback system. To set a callback,
use the C<on_event( )> method. For example, to catch all attempts to read
from a file, use C<$client-E<gt>on_event( 'file_read', \&on_read )>.
See the L<Events|/Events> section for a list of events sorted by their
related classes.
=item C<peerid ( )>
Returns the L<Peer ID|Net::BitTorrent::Version/"gen_peerid ( )">
generated to identify this L<Net::BitTorrent|Net::BitTorrent> object
internally, with remote L<peers|Net::BitTorrent::Peer>, and
L<trackers|Net::BitTorrent::Torrent::Tracker>.
See also: wiki.theory.org (http://tinyurl.com/4a9cuv),
L<Peer ID Specification|Net::BitTorrent::Version/"Peer ID Specification">
=item C<remove_torrent ( TORRENT )>
Removes a L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent> object
from the client's queue.
=begin future
Before the torrent torrent is closed, we announce to the tracker that we
have 'stopped' downloading and a callback to store the current state is
called.
=end future
See also: L<torrents ( )|/"torrents ( )">,
L<add_torrent ( )|/"add_torrent ( { ... } )">,
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent>
=item C<torrents ( )>
Returns the list of queued L<torrents|Net::BitTorrent::Torrent>.
See also: L<add_torrent ( )|/"add_torrent ( { ... } )">,
L<remove_torrent ( )|/"remove_torrent ( TORRENT )">
=back
=head1 Events
When triggered, client-wide callbacks receive two arguments: the
C<Net::BitTorrent> object and a hashref containing pertinent information.
For per-torrent callbacks, please see
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent/"Events">
This is the current list of events and the information passed to
callbacks.
Note: This list is subject to change. Unless mentioned specifically,
return values from callbacks do not affect behavior.
=head2 Net::BitTorrent::Peer
=over
=item C<ip_filter>
This gives a client author a chance to block or accept connections with
a peer before an initial handshake is sent. The argument hash contains
the following key:
=over
=item C<Address>
IPv4:port (or, on rare occasions, hostname:port) address of the potential peer.
=back
Note: The return value from your C<ip_filter> callback determines how we
proceed. An I<explicitly false> return value (ie C<0>) means this peer
should not be contacted and (in the case of an incoming peer) the
connection is dropped.
=item C<peer_connect>
Triggered when we have both sent and received a valid handshake with
the remote peer. The argument hash contains the following keys:
=over
=item C<Peer>
The remote L<peer|Net::BitTorrent::Peer> with whom we have established
a connection.
=back
=item C<peer_disconnect>
Triggered when a connection with a remote peer is lost or terminated.
The argument hash contains the following keys:
=over
=item C<Peer>
The remote L<peer|Net::BitTorrent::Peer> with whom we have established
a connection.
=item C<Reason>
When possible, this is a 'user friendly' string.
=back
=item C<peer_read>
This is triggered whenever we receive data from a remote peer via TCP.
The argument hash contains the following keys:
=over
=item C<Peer>
The L<peer|Net::BitTorrent::Peer> who sent the packet.
=item C<Length>
The amount of data, in bytes, sent by the peer.
=back
=item C<peer_write>
This is triggered whenever we send data to a remote peer via TCP. The
argument hash contains the following keys:
=over
=item C<Peer>
The L<peer|Net::BitTorrent::Peer> on the receiving end of this data.
=item C<Length>
The amount of data, in bytes, sent to the remote peer.
=back
=item C<outgoing_packet>
Triggered when we send a packet to a remote peer. The argument hash
contains the following keys:
=over
=item C<Payload>
The parsed data sent in the packet (when applicable) in a hashref.
=item C<Peer>
The remote L<peer|Net::BitTorrent::Peer> receiving this data.
=item C<Type>
The type of packet sent. These values match the packet types exported
from L<Net::BitTorrent::Protocol|Net::BitTorrent::Protocol/":types">.
=back
=item C<incoming_packet>
Triggered when we receive a packet to a remote peer. The argument hash
contains the following keys:
=over
=item C<Payload>
The parsed data sent in the packet (when applicable) in a hashref.
=item C<Peer>
The remote L<peer|Net::BitTorrent::Peer> sending this data.
=item C<Type>
The type of packet sent. These values match the packet types exported
from L<Net::BitTorrent::Protocol|Net::BitTorrent::Protocol/":types">.
=back
=back
=head2 Net::BitTorrent::Torrent::File
=over
=item C<file_error>
Triggered when we run into an error handling the file in some way. The
argument hash contains the following keys:
=over
=item C<File>
The L<file|Net::BitTorrent::Torrent::File> object related to this fault.
=item C<Message>
The error message describing what (may have) gone wrong.
=back
=item C<file_open>
Triggered every time we open a file represented in a
L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent> object. The argument
hash contains the following keys:
=over
=item C<File>
The L<file|Net::BitTorrent::Torrent::File> object.
=item C<Mode>
How the file is opened. To simplify things, C<Net::BitTorrent> currently
uses 'r' for read access and 'w' for write.
=back
=item C<file_close>
Triggered every time we close a file. The argument hash contains the
following key:
=over
=item C<File>
The L<file|Net::BitTorrent::Torrent::File> object.
=back
=item C<file_write>
Triggered every time we write data to a file. The argument hash contains
the following keys:
=over
=item C<File>
The L<file|Net::BitTorrent::Torrent::File> object.
=item C<Length>
The actual amount of data written to the file.
=back
=item C<file_read>
Triggered every time we read data from a file. The argument hash
contains the following keys:
=over
=item C<File>
The L<file|Net::BitTorrent::Torrent::File> object related to this fault.
=item C<Length>
The actual amount of data written to the file.
=back
=back
=head2 Net::BitTorrent::Torrent::Tracker::HTTP/Net::BitTorrent::Torrent::Tracker::UDP
Note: The tracker objects passed to these callbacks will either be a
L<Net::BitTorrent::Torrent::Tracker::HTTP|Net::BitTorrent::Torrent::Tracker::HTTP>
or a
L<Net::BitTorrent::Torrent::Tracker::UDP|Net::BitTorrent::Torrent::Tracker::UDP>.
=over
=item C<tracker_connect>
Triggered when we connect to a remote tracker. The argument hash
contains the following keys:
=over
=item C<Tracker>
The tracker object related to this event.
=item C<Event>
If defined, this describes why we are contacting the tracker. See the
BitTorrent specification for more.
=back
Note: This callback is only triggered from
L<TCP|Net::BitTorrent::Torrent::Tracker::HTTP> trackers, as
L<UDP|Net::BitTorrent::Torrent::Tracker::UDP> is 'connection-less.'
=item C<tracker_disconnect>
Triggered when we disconnect from a remote tracker. The argument hash
contains the following key:
=over
=item C<Tracker>
The tracker object related to this event.
=back
Note: This callback is only triggered from
L<TCP|Net::BitTorrent::Torrent::Tracker::HTTP> trackers, as
L<UDP|Net::BitTorrent::Torrent::Tracker::UDP> is 'connection-less.'
=item C<tracker_success>
Triggered when an announce attempt succeeds. The argument hash contains
the following keys:
=over
=item C<Tracker>
The tracker object related to this event.
=item C<Payload>
The data returned by the tracker in a hashref. The content of this
payload based on what we receive from the tracker but these are the
typical keys found therein:
=over
=item C<complete>
The number of seeds in the swarm according to the tracker.
=item C<incomplete>
The number of leeches in the swarm according to the tracker.
=item C<peers>
A L<compact|Net::BitTorrent::Util/"compact ( LIST )"> list of peers in the swarm.
=item C<min_interval>
The minimum amount of time before we should contact the tracker again.
=back
=back
=item C<tracker_failure>
Triggered when an announce attempt fails. The argument hash contains the
following keys:
=over
=item C<Tracker>
The tracker object related to this event.
=item C<Reason>
The reason given by the remote tracker (when applicable) or as defined
by C<Net::BitTorrent> on socket errors.
=back
=item C<tracker_write>
Triggered when we write data to a remote tracker. The argument hash
contains the following keys:
=over
=item C<Tracker>
The tracker object related to this event.
=item C<Length>
The amount of data sent to the remote tracker.
=back
=item C<tracker_read>
Triggered when data is read from a tracker. The argument hash contains
the following keys:
=over
=item C<Tracker>
The tracker object related to this event.
=item C<Length>
The amount of data received from the remote tracker.
=back
=back
=head2 Net::BitTorrent::Torrent
=over
=item C<piece_hash_fail>
Triggered when a piece fails to validate. The argument hash contains the
following keys:
=over
=item C<Torrent>
The L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent> object related to
this event.
=item C<Index>
The zero-based index of the piece that failed to match the hash defined
for it in the .torrent metadata.
=back
=item C<piece_hash_pass>
Triggered when a previously missing piece validates. The argument hash
contains the following keys:
=over
=item C<Torrent>
The L<Net::BitTorrent::Torrent|Net::BitTorrent::Torrent> object related
to this event.
=item C<Index>
The zero-based index of the piece that was verified against the .torrent
metadata.
=back
=item C<as_string ( [ VERBOSE ] )>
Returns a 'ready to print' dump of the object's data structure. If
called in void context, the structure is printed to C<STDERR>.
C<VERBOSE> is a boolean value.
=back
=head1 Bugs
Numerous, I'm sure.
Please see the section entitled
"L<Bug Reporting|Net::BitTorrent::Notes/"Bug Reporting">" in
L<Net::BitTorrent::Notes|Net::BitTorrent::Notes> if you've found one.
=head1 Notes
=head2 Support Links
Please refer to
L<Net::BitTorrent::Notes|Net::BitTorrent::Notes/"Support and Information Links for C<Net::BitTorrent>">.
=head2 Dependencies
L<Net::BitTorrent|Net::BitTorrent> requires L<version|version> and
L<Digest::SHA|Digest::SHA> to function and relies upon
L<Module::Build|Module::Build> for installation. As of perl 5.10, these
are all CORE modules; they come bundled with the distribution.
=head2 Examples
For a demonstration of L<Net::BitTorrent|Net::BitTorrent>, see
F<scripts/bittorrent.pl>.
=head2 Installation
See L<Net::BitTorrent::Notes|Net::BitTorrent::Notes/"Installation">.
=head1 See Also
http://bittorrent.org/beps/bep_0003.html - BitTorrent Protocol
Specification
L<Net::BitTorrent::Notes|Net::BitTorrent::Notes> - Random stuff. More
jibba jabba.
L<Peer ID Specification|Net::BitTorrent::Notes/"Peer ID Specification"> -
The standard used to identify L<Net::BitTorrent|Net::BitTorrent> in the
wild.
=head1 Acknowledgments
Bram Cohen, for designing the base protocol and letting the community
decide what to do with it.
L Rotger
C<#bittorrent> on Freenode for letting me idle.
Michel Valdrighi for b2
=head1 Author
Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/
CPAN ID: SANKO
=head1 License and Legal
Copyright (C) 2008-2009 by Sanko Robinson E<lt>sanko@cpan.orgE<gt>
This program is free software; you can redistribute it and/or modify
it under the terms of The Artistic License 2.0. See the F<LICENSE>
file included with this distribution or
http://www.perlfoundation.org/artistic_license_2_0. For
clarification, see http://www.perlfoundation.org/artistic_2_0_notes.
When separated from the distribution, all POD documentation is covered
by the Creative Commons Attribution-Share Alike 3.0 License. See
http://creativecommons.org/licenses/by-sa/3.0/us/legalcode. For
clarification, see http://creativecommons.org/licenses/by-sa/3.0/us/.
Neither this module nor the L<Author|/Author> is affiliated with
BitTorrent, Inc.
=for svn $Id: BitTorrent.pm d3c97de 2009-09-12 04:31:46Z sanko@cpan.org $
=cut