Skip to content

Instantly share code, notes, and snippets.

@uniacid
Forked from phracker/tracker_modify.pl
Created January 13, 2017 18:45
Show Gist options
  • Save uniacid/03cce897d05ad15048ddb217d7494751 to your computer and use it in GitHub Desktop.
Save uniacid/03cce897d05ad15048ddb217d7494751 to your computer and use it in GitHub Desktop.
#!/usr/bin/perl
#
# tracker_modify.pl 0.01
# Add/delete trackers recursively from all torrents.
# Free to copy and mutilate any way you like :)
#
# Originally from http://publicbt.com/tracker_modify.pl
sub usage {
print <<EOF
Usage: perl tracker_modify.pl [OPTIONS...] <-a add_file> <-d delete_file> <directory>
Requires an add_file or delete_file or both.
Main Options:
-a add_file File location of tracker list to add.
(seperate tiers by empty line just like a uTorrent tracker list!)
-d delete_file File location of tracker hostname list to delete.
(hostnames only, supports regular expression)
directory Directory to recursively scan for torrents to modify
Optional flags:
-e .extension Match files with extension, use null for all files (default .torrent)
-deladd Add tracker list only to torrents with a delete match (default disabled)
-noconfirm Do not confirm the modifying process (default disabled)
Examples:
> perl tracker_modify.pl -a add_file /home/user/torrent
Add trackers to all files with extension .torrent in /home/user/torrent
> perl tracker_modify.pl -e null -deladd -a add_file -d delete_file /home/user/torrent
Add trackers only to files that have a delete match, all extensions in /home/user/torrent
----------add_file example----------
udp://tracker.openbittorrent.com:80/announce
udp://tracker.publicbt.com:80/announce
------------------------------------
Notice the blank line between tiers! LEAVE BLANK LINE BETWEEN EACH SEPERATE TRACKER!!!
---------delete_file example--------
.thepiratebay.org\$
.prq.to\$
moviex.info\$
^91.191.138.
------------------------------------
List of hostnames to remove. ^ = beginning \$ = end of hostname, first line is basically
*.thepiratebay.org and the last line 91.191.138.*
EOF
;
exit(0);
}
$ext = '.torrent';
foreach $i (@ARGV) {
$argv_enext = 1 if ($i =~ /^-e/);
$argv_anext = 1 if ($i =~ /^-a/);
$argv_dnext = 1 if ($i =~ /^-d$/);
$noconf = 1 if ($i =~ /^-noconfirm/);
$deladd = 1 if ($i =~ /^-deladd/);
next if ($i =~ /^-/);
if ($argv_enext) {
undef($argv_enext);
$ext = $i;
$ext = '' if ($i eq 'null');
}
if ($argv_anext) {
undef($argv_anext);
open(FILE,$i) || die "Unable to open $i";
@add_list = <FILE>;
close(FILE);
}
if ($argv_dnext) {
undef($argv_dnext);
open(FILE,$i) || die "Unable to open $i";
@del_list = <FILE>;
close(FILE);
}
$directory = $i;
}
die "Must have add_list & del_list for -deladd, which will only add to torrents that have a delete match" if ($deladd && (!$add_list[0] || !$del_list[0]));
print "Unable to open directory: $directory\n" if (!-d $directory && $directory);
&usage if (!-d $directory);
if (!$add_list[0] && !$del_list[0]) {
print "You must have an add file or delete file or both.\n";
&usage;
}
if (!$noconf) {
print "Scanning directory (will confirm changes before modifying)\n\n";
sleep(2);
}
@final = ();
&dirscan($directory);
$total_files = $#final + 1;
print "\nTotal torrents: $total_files\n";
if ($add_list[0]) {
print "Adding trackers:\n";
print $_ foreach (@add_list);
print "\n\n";
}
if ($del_list[0]) {
print "Deleting trackers (regular expression matching):\n";
print $_ foreach (@del_list);
print "\n\n";
}
print "File extension: $ext\n" if ($ext);
print "Run directory: $directory\n";
if (!$noconf) {
print "Continue to modify ? [y/n] ";
$yn = <STDIN>;
if ($yn !~ /^y/i) {
print "Cancelled\n";
exit(0);
}
}
if ($add_list[0]) {
@final_add = ();
@array_add = ();
foreach $l (@add_list) {
$l =~ s/(\n|^\s+|\s+$)//g;
if ($l !~ /[A-za-z0-9]/) {
push(@final_add,[@array_add]) if ($array_add[0] =~ /[A-Za-z0-9]/);
@array_add = ();
next;
}
push(@array_add,$l);
}
push(@final_add,[@array_add]) if ($array_add[0]);
}
if ($del_list[0]) {
$del_string = '';
foreach $i (@del_list) {
$i =~ s/(\n|^\s+|\s+$)//g;
$del_string .= $i.'|' if ($i =~ /[A-Za-z0-9]/);
}
chop $del_string;
}
foreach $f (@final) {
print $f.'...';
open(FIX,$f) || print "Unable to read $f";
my $decode = modify(join('',<FIX>));
close(FIX);
if ($decode) {
open(NEW,'>'.$f) || print "Unable to write to $f";
print NEW $decode;
close(NEW);
print "success";
}
else { print "no changes"; }
print "\n";
}
sub dirscan {
my $dir = shift;
my @dirlist;
$dir .= '/' if ($dir !~ /\/$/);
opendir(DIR,$dir) || print "Unable to open $dir\n";
while ($f = readdir(DIR)) {
next if ($f =~ /^\.\.?$/);
if (($f =~ /$ext$/||!$ext) && -f $dir.$f) {
print $dir.$f."\n";
push(@final,$dir.$f);
}
push(@dirlist,$dir.$f) if (-d $dir.$f && $f !~ /^\.\.?$/);
}
closedir(DIR);
foreach $ii (@dirlist) {
&dirscan($ii);
}
}
sub modify {
my $read_file = shift;
my $made_changes = 0;
my $read = bdecodefile($read_file);
my @announce = ();
my %used;
my $deladd_match = 0;
if (!$read) {
$read = bdecode($read_file);
}
if ($final_add[0]) {
if ($deladd) {
my $uhx = -1;
foreach $uh (@{$read->{'announce-list'}}) {
$uhx++;
foreach $uhh (@{$uh}) {
my $domain = $uhh;
$domain =~ s/.*:\/\///g;
$domain =~ s/(\/|:).*//g;
$deladd_match = 1 if ($domain =~ /$del_string/);
}
}
my $domain = $read->{'announce'};
$domain =~ s/.*:\/\///g;
$domain =~ s/(\/|:).*//g;
$deladd_match = 1 if ($domain =~ /$del_string/);
}
if (!$deladd || $deladd_match) {
$made_changes = 1;
unshift(@{$read->{'announce-list'}},@final_add);
}
}
if ($del_string) {
my $uhx = -1;
my $ahx = -1;
foreach $uh (@{$read->{'announce-list'}}) {
$uhx++;
my $uhhx = -1;
my $add_ahx = 0;
foreach $uhh (@{$uh}) {
$uhhx++;
my $domain = $uhh;
$domain =~ s/.*:\/\///g;
$domain =~ s/(\/|:).*//g;
if ($domain =~ /$del_string/ || $used{$uhh}) {
$made_changes = 1;
}
else {
if (!$add_ahx) {
$add_ahx = 1;
$ahx++;
}
$announce[$ahx] = [] if (!$announce[$ahx]);
push(@{$announce[$ahx]},$read->{'announce-list'}[$uhx][$uhhx]);
$used{$uhh} = 1;
}
}
}
$read->{'announce-list'} = [@announce];
if ($read->{'announce'}) {
my $domain = $read->{'announce'};
$domain =~ s/.*:\/\///g;
$domain =~ s/(\/|:).*//g;
if ($domain =~ /$del_string/) {
if ($final_add[0][0] =~ /[A-Za-z0-9]/) {
$read->{'announce'} = $final_add[0][0];
}
elsif ($read->{'announce-list'}[0][0] =~ /[A-Za-z0-9]/) {
$read->{'announce'} = $read->{'announce-list'}[0][0];
}
}
}
}
if ($made_changes) {
return bencode($read);
}
else {
return 0;
}
}
sub bencode {
my $data = shift;
my $enc = '';
if (ref($data) eq 'HASH') {
no locale;
foreach (sort(keys %{$data})) {
$enc .= bencode($_) . bencode($data->{$_});
}
return('d' . $enc . 'e');
}
if (ref($data) eq 'ARRAY') {
foreach (@{$data}) { $enc .= bencode($_); }
return('l' . $enc . 'e');
}
if ($data =~ /^\d+$/) {
return('i' . $data . 'e');
}
return(join(':', length($data), $data));
}
sub bdecodefile {
my $data = shift;
my $pref = shift;
my $c = substr($data, $$pref, 1);
if ($c eq 'd') {
# hash
$$pref++; # eat the 'd'
my %d = ();
while (substr($data, $$pref, 1) ne 'e') {
my $key = bdecodefile($data, $pref);
$d{$key} = bdecodefile($data, $pref);
if ($_btdead) {
undef($_btdead);
return 0;
}
}
$$pref++; # eat the 'e'
return(\%d);
} elsif ($c eq 'l') {
# list
$$pref++; # eat the 'l'
my @l = ();
while (substr($data, $$pref, 1) ne 'e') {
push(@l, bdecodefile($data, $pref));
if ($_btdead) {
undef($_btdead);
return 0;
}
}
$$pref++; # eat the 'e'
return(\@l);
} elsif ($c eq 'i') {
if (substr($data, $$pref) =~ /^i(\d+)e/s) {
# number
$$pref += length($1) + 2;
return($1);
} else { $_btdead = 1; return 0; }
} else {
# data buffer with length $len
if (my($len, $dat) = (substr($data, $$pref) =~ /^(\d+):(.*)/s)) {
my $dlen = length($dat);
if ($len > $dlen) { $_btdead = 1; return 0; }
$$pref += length($len) + 1; # move past length field + ':'
my $buf = substr($data, $$pref, $len);
$$pref += $len; # move past data buffer
return($buf);
} else { $_btdead = 1; return 0; }
}
}
sub _bdecode_chunk {
my ( $q, $r ); # can't declare 'em inline because of qr//-as-closure
my $str_rx = qr/ \G ( 0 | [1-9] \d* ) : ( (??{
# workaround: can't use quantifies > 32766 in patterns,
# so for eg. 65536 chars produce something like '(?s).{32766}.{32766}.{4}'
$q = int( $^N \/ 32766 );
$r = $^N % 32766;
$q--, $r += 32766 if $q and not $r;
"(?s)" . ( ".{32766}" x $q ) . ".{$r}"
}) ) /x;
if( m/$str_rx/xgc ) {
return $2;
}
elsif( m/ \G i ( 0 | -? [1-9] \d* ) e /xgc ) {
return $1;
}
elsif( m/ \G l /xgc ) {
my @list;
until( m/ \G e /xgc ) {
push @list, _bdecode_chunk();
}
return \@list;
}
elsif( m/ \G d /xgc ) {
my $last_key;
my %hash;
until( m/ \G e /xgc ) {
m/$str_rx/xgc;
my $key = $2;
$last_key = $key;
return 0 if ($bemustdie);
$hash{ $key } = _bdecode_chunk();
}
return \%hash;
}
else {
$bemustdie = 1;
}
}
sub bdecode {
local $_ = shift;
$bemustdie = 0;
my $data = _bdecode_chunk();
return $data;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment