patcher для rtorrent, на основе патчера псевдотрекер Опции

[kolobok3D]

Версия 1.1
Конфиг:

Код

/usr/local/scripts/tr_patcher/>more patcher.conf
# Директория, за которой следит patcher.
fdirectory = /data/rtorrent/torrents

# Директория, в которую patcher скидывает торренты после добавления ретрекеров.
tdirectory = /data/rtorrent/.torrents

# Директория session из конфига rTorrent
sdirectory = /data/rtorrent/.session

# Город
gorod = 2

# Провайдер
prov = 1

Опции запуска:

Код

Проверяет папку fdirectory на наличие торрентов, патчит найденные и сохраняет в tdirectory.
./patcher.pl -p

Код

Патчит уже добавленныe в rTorrent торренты (перед запуском нужно остановить rTorrent).
./patcher.pl -c

Код

Обновляет список ретрекеров и проверяет их доступность.
./patcher.p -u

При первом запуске автоматически обновляет список ретрекеров и проверяет их доступность.

Для работы нужен перл собранный с поддержкой threads и модули LWP::Simple Text::Iconv.
скачать

[FreeM@N]

Спасибо, нужно будет затестить...

Скрипт для проверки ретрекеров выглядит примерно вот так:
Это немного модифицированная версия скрипта ShurShur

CODE

#!/usr/bin/perl
use LWP::Simple;
use IO::Socket;
use POSIX;
# no Text::Iconv on Windows
#use Text::Iconv;
use strict;
no utf8;

# hack: remove zero bytes from ASCII characters in UTF-16
sub conv {
my ($s)_;
$s=~tr/\0//d;
return $s;
}

# extract urls with Text::Iconv
#my $u2k=new Text::Iconv("utf-16","koi8-r//translit");
#my @list=sort grep {/http:/} split /[\n\s]+/,$u2k->convert(get "http://iphonez.su/torrent/trackers.ini");

# extract urls with hack
#my @list=sort grep {/http:/} split /[\n\s]+/,conv(get "http://re-tracker.ru/trackerssimple.ini");
my $subject = conv(get "http://re-tracker.ru/trackerssimple.ini");
my @list;
while ($subject =~ m!(http://[^/]+/[^\s]+)!ig) {
push(@list, $&);
# $result = $&
}
@list = sort(@list);
my $p="";
my $out="";
binmode STDOUT,":bytes";
for my $t(@list) {
# print "$t\n";
next if $t eq $p;
$p=$t;
$t=~m#//(.+?)\d+)/#;
my $s=new IO::Socket::INET(PeerAddr=>$1,PeerPort=>$2,Timeout=>2);
if($s) {
$out .= "$t\n";
print "GOOD $t\n";
close $s;
} else {
print "FAIL $t\n";
}
}
print "MY:\n\n$out";