App-MHFS

 view release on metacpan or  search on metacpan

lib/MHFS/Plugin/BitTorrent/Tracker.pm  view on Meta::CPAN

    my $bdata = bencode($dictref);
    if($bdata) {
        $request->SendBytes('text/plain', $bdata);
    }
    else {
        say "Critical: Failed to bencode!";
        $request->Send404;
    }
}

sub new {
    my ($class, $settings, $server) = @_;
    my $ai = ($settings->{'BitTorrent::Tracker'} && $settings->{'BitTorrent::Tracker'}{'announce_interval'}) ? $settings->{'BitTorrent::Tracker'}{'announce_interval'} : undef;
    $ai //= 1800;

    my $self =  {'settings' => $settings, 'torrents' => \%{$settings->{'TORRENTS'}}, 'announce_interval' => $ai, 'fs' => $server->{'fs'}};
    bless $self, $class;
    say __PACKAGE__.": announce interval: ".$self->{'announce_interval'};

    if (exists $settings->{'PUBLICIP'}) {
        try { $self->{pubip} = parse_ipv4($settings->{'PUBLICIP'}); }
        catch ($e) {}
    }

    # load the existing torrents
    my $odres = opendir(my $tdh, $settings->{'MHFS_TRACKER_TORRENT_DIR'});
    if(! $odres){
        say __PACKAGE__.":failed to open torrent dir";
        return undef;
    }
    while(my $file = readdir($tdh)) {
        next if(substr($file, 0, 1) eq '.');
        my $fullpath = $settings->{'MHFS_TRACKER_TORRENT_DIR'}."/$file";
        my $torrentcontents = do {
            try { read_file($fullpath) }
            catch ($e) {
                say __PACKAGE__.": error reading $fullpath";
                return;
            }
        };
        my $torrent = MHFS::BitTorrent::Metainfo::Parse(\$torrentcontents);
        if(! $torrent) {
            say __PACKAGE__.": error parsing $fullpath";
            return undef;
        }
        $self->{'torrents'}{$torrent->{'infohash'}} = {};
        say __PACKAGE__.": added torrent ".$torrent->InfohashAsHex() . ' '.$file;
    }

    $self->{'routes'} = [
    ['/torrent/tracker', sub {
        my ($request) = @_;
        $self->announce($request);
    }],
    ['/torrent/create', sub {
        my ($request) = @_;
        $self->createTorrent($request);
    }],
    ];

    $self->{'timers'} = [
        # once an hour evict peers that left the swarm ungracefully
        [0, 3600, sub {
            my ($timer, $current_time, $evp) = @_;
            say __PACKAGE__.": evict peers timer";
            foreach my $infohash (keys %{$self->{'torrents'}}) {
                foreach my $peer (keys %{$self->{'torrents'}{$infohash}}) {
                    my $peerdata = $self->{'torrents'}{$infohash}{$peer};
                    if(($current_time - $peerdata->{'last_announce'}) > ($self->{'announce_interval'}+60)) {
                        $self->removeTorrentPeer($infohash, $peer, " timeout");
                    }
                }
            }
            return 1;
        }],
    ];

    return $self;
}

1;



( run in 0.438 second using v1.01-cache-2.11-cpan-39bf76dae61 )