LEAK REACKTOR 2.85 AUTO TRADER SOURCE CODE
Next Clean out,got it from same Vuln Guy Fuck you fusa Ic3 and the rest
use Win32::Console;
#use Win32::Registry;
use Time::HiRes qw(gettimeofday tv_interval);
use IO::Socket;
use Config::IniFiles;
use DBI;
use POSIX;
use Win32::GUI;
use Win32::GUI::Loft::Design;
use constant WM_COPYDATA => 74;
use constant WM_CLOSE => 0x00000010;
use LWP;
$STDOUT = new Win32::Console(STD_OUTPUT_HANDLE);
$STDOUT->Cls($FG_GREEN);
use threads;
use threads::shared;
$ircnick=&generate_random_string(6);
$ircnick="tnt$ircnick";
print "USING PATH $0\n";
$mainpath=$0;
@path=split(/\\/,$0);
$file=$path[-1];
$mainpath=~s/$file//i;
chdir $mainpath;
#package Foo::Server;
#use HTTP::Server::Simple::CGI;
#our @ISA = qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::Authen);
#our $CALLBACK;
#sub handle_request { $CALLBACK->(@_) }
#use HTTP::Server::Simple::Static;
#use HTTP::Server::Simple::Authen;
use Config::INI::Reader;
#use Ananke::SqlLink;
package main;
use Win32::SystemInfo;
use String::CRC32;
use Math::BaseCalc;
sub httpd_thread {
$configini = new Config::IniFiles( -file => "inifiles\\main.ini" ) || die "CANNOT FIND MAIN.INI";
$httpd = $configini->val("general","httpserver");
$httpdport = $configini->val("general","httpdport");
if ( $httpd ) { Foo::Server->new($httpdport)->run(); print "HTTP SERVER STARTED\n"; }
}
&load_main_win;
$configini = new Config::IniFiles( -file => "inifiles\\main.ini" ) || system "CANNOT FIND MAIN.INI";
defined(my $splash = $Win32::GUI::Loft::window{reaktorv1});
$splash->rlsname->Text("Starting REAKTOR...");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$splash->rlsname->Text("Opened SQL Link to LocalHost");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$prebot_type=$configini->val("prebot","use");
if ( !($prebot_type)) { $prebot_type="internal"; }
if ( $prebot_type eq "external" ) {
$sqlpb=1;
$sqlip=$configini->val("prebot","ip");
$sqlport=$configini->val("prebot","port");
$sqluser=$configini->val("prebot","user");
$sqldb=$configini->val("prebot","db");
$sqlpass=$configini->val("prebot","passwd");
$sqladd=$configini->val("prebot","addtodb");
$sqltables=$configini->val("prebot","tables");
$sql_table_time=$configini->val("prebot","time");
$sql_table_name=$configini->val("prebot","name");
$sql_table_section=$configini->val("prebot","section");
print "using external SQL prebot\n";
} else {
$sqlpb=0;
print "using Internal SQLlite prebot\n";
}
print "loaded ini file\n";
$configini = new Config::IniFiles( -file => "inifiles\\main.ini" ) || system "CANNOT FIND MAIN.INI";
$splash->rlsname->Text("Loaded Main.ini");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$httpd = $configini->val("general","httpserver");
$chainsini = new Config::IniFiles( -file => "inifiles\\chains.db2" ) || system "CANNOT LOAD CHAINS FILE";
&rehash_information;
$splash->rlsname->Text("Loaded All Site Information");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$configini = new Config::IniFiles( -file => "inifiles\\main.ini" ) || system "CANNOT FIND MAIN.INI";
$CHANGE_TV = $configini->val("general","change_tv_sections");
$CHANGE_MOVIE = $configini->val("general","change_movie_sections");
if ( $CHANGE_TV ) { print "TV GENRE SECTIONS ENABLED\n"; }
if ( $CHANGE_MOVIE ) { print "MOVIE SECTION CHANGE -- ON\n"; }
if (!($configini)) { system "CONFIG INI FILE NOT FOUND\n"; }
open(CODES, "codes.txt");@codes=<CODES>;close(CODES);
open(CCODES, "ccodes.txt");@ccodes=<CCODES>;close(CCODES);
$splash->rlsname->Text("Loaded CCodes.txt");
$Win32::GUI::Loft::window{reaktorv1}->Show();
my($sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO);
$LOADED_sections=$configini->val("general","sections");
$LOADED_globalskip=$configini->val("general","globalskip");
$splash->rlsname->Text("Global Skiplist Opened");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$race_from_pre_sections = $configini->val("general","race_from_pre");
$splash->rlsname->Text("RACEING $race_from_pre_sections FROM PREBOT...");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$http_thrd = threads->new( \&httpd_thread );
$http_thrd->detach;
$random_string=&generate_random_string(6);
$PORTNO = $configini->val("general","port");
$HOST = $configini->val("general","host");
$PORTNO=~s, ,,ig;
$HOST=~s, ,,ig;
$MAXLEN = 256;
$udpsock = IO::Socket::INET->new(LocalHost => $HOST, LocalPort => $PORTNO, Proto => 'udp');
$splash->rlsname->Text("Opend UDP ON $HOST:$PORTNO");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$splash->rlsname->Text("WAITING FOR FIRST CONNECTION .. STAND BY");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$TCPPORTNO = $configini->val("general","tcpport");
$TCPHOST = $configini->val("general","tcphost");
$TCPPORTNO=~s, ,,ig;
$TCPHOST=~s, ,,ig;
my $tcpsock = new IO::Socket::INET (
LocalHost => $TCPHOST,
LocalPort => $TCPPORTNO,
proto => 'tcp',
Listen => 1,
Reuse => 1,
);
$main_thread=threads->self;
$tcp_thrd = threads->new( \&recieve_tcp );
$MAXLEN=32;
while ($udpsock->recv($newmsg, $MAXLEN)) {
my($port, $ipaddr) = sockaddr_in($udpsock->peername);
print "GOT UDP OF $newmsg\n";
$hishost = gethostbyaddr($ipaddr, AF_INET);
print "GOT STATUS SENDING $TCPHOST $TCPPORTNO $hishost $0 NOW\n";
$udpsock->send("!status $TCPHOST $TCPPORTNO $0\n");
$splash->rlsname->Text("Recieved !status command..");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$udpsock->close;
($cmd,$nick)=split(/ /,$newmsg);
}
$splash->rlsname->Text("Thread pool updated");
$Win32::GUI::Loft::window{reaktorv1}->Show();
$tooltips=$version;
$version="Reaktor V1.5 *cracked* by LAUS";
my $lastpre :shared;
my $lastrace :shared;
my $numraces :shared;
$numraces=0;
$splash->rlsname->Text("READY... $version");
$Win32::GUI::Loft::window{reaktorv1}->Show();
Win32::GUI::Dialog();
$tcp_thrd->detach();
my $DOS = Win32::GUI::GetPerlWindow();
Win32::GUI::Show($DOS);
print "Thanks for using REAKTOR V1.05\n";
die "end now\n";
system;
sub generate_random_string {
my $length_of_randomstring=shift;# the length of
# the random string to generate
my @chars=('a'..'z','A'..'Z','0'..'9','_');
my $random_string;
foreach (1..$length_of_randomstring)
{
# rand @chars will generate a random
# number between 0 and scalar @chars
$random_string.=$chars[rand @chars];
}
return $random_string;
}
sub recieve_tcp {
$tcp_connection = $tcpsock->accept();
print $tcp_connection "REAKTOR V1.5 CONSONLE WINDOW\n";
while(<$tcp_connection>) {
my $got_input = $_;
$newmsg=$got_input;
$newmsg=~s,(\r|\n),,ig;
## Filter Area
$newmsg=~s,\d\d\d\d-\d\d-\d\d/,,ig;
$newmsg=~s,xxx/,,ig;
$newmsg=~s,\d\d\d\d/,,ig;
$newmsg=~s,\d\d-\d\d\d\d/,,ig;
$newmsg=~s,/d/d-\d\d/,,ig;
if ( $newmsg=~m,^rehash$,i ) { &rehash_information; warn "REHASH SITES CALLED FROM MIRC\n"; next; }
if ( $newmsg=~m,!getaffils,i ) {
($cmd, $item)=split(/ /,$newmsg);
$affil_sites=&find_affils_for_race("something-something-$item");
print $tcp_connection "!affillist $affil_sites\n";
next;
}
if ( $newmsg=~m,!manualrace,i ) {
($cmd, $section, $rlsname)=split(/ /,$newmsg);
print "doing manual chain race now\n";
$chk_pretime{$rlsname}="";
if ( $racebot_sortsection{$rlsname} ) { $section=$racebot_sortsection{$rlsname}; } else {
$section=~s,([^\w|-]),,ig;
$origsect=$section;
if ( length($rlsname) < 5 ) { next; }
$sections=$LOADED_sections;
if ( $section=~m,$sections,i ) { $section = $1; }
if ( $section=~m,MP3,i ) { $section="MP3"; }
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$section=&sort_race_section($section, $rlsname);
$section=uc($section);
$racebot_sortsection{$rlsname}=$section;
}
debug("$nick : $site : RACE BOT OUTPUT :: FOUND NEW RACE $rlsname");
my $itemset = "$site~$rlsname";
$timer{$itemset} = [gettimeofday];
$info=&check_single_site($site,$section,$rlsname,0);
print $tcp_connection "!MANUALrace $section $rlsname\n";
$mainwin->rlsname->Text("$rlsname");
$mainwin->section->Text("$section");
do_chains_for_race($rlsname,$section,1,0,0,1,1);
next;
}
if ( $newmsg=~m,(REAKTORDIE),i ) {
defined(my $win = $Win32::GUI::Loft::window{reaktorv1});
Win32::GUI::SendMessage($win, WM_CLOSE, 0, 0);
print "AUTO KILLED FROM MIRC\n";
last;
}
if ( $newmsg=~m,!sortsect,i ) {
($cmd,$section,$rlsname)=split(/ /,$newmsg);
$sections=$LOADED_sections;
if ( $section=~m,$sections,i ) { $section = $1; }
if ( $section=~m,MP3,i ) { $section="MP3"; }
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$section2=&sort_race_section($section, $rlsname);
$section=&sort_race_section($section, $rlsname);
$section=uc($section);
print $tcp_connection "!sorted Section To $section for $rlsname\n";
print "!sorted Section To $section for $rlsname\n";
next;
}
if ($newmsg=~m,!addpre, ) {
($cmd,$chan,$nick,$sect,$rlsname)=split(/ /,$newmsg);
while ( $rlsname=~m,(\W$|^\W),g ) { $rlsname=~s,(\W$|^\W),,g; }
if ( $prebot_sortsection{$rlsname} ) { $section=$prebot_sortsection{$rlsname}; } else {
$section="";
$sections=$LOADED_sections;
if ( $sect=~m,$sections,i ) { $section = $1; }
$section=&sort_race_section($section, $rlsname);
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$prebot_sortsection{$rlsname}=$section;
}
if ( !($dbase2)) { &do_sql2; }
$prebotqry2->execute("%$rlsname%");
$found=0;
while ( @row = $prebotqry2->fetchrow_array ) { $found=1; }
if ( !($found )) {
my $unixtime = mktime (localtime);
$prebotinsert2->execute($unixtime, $rlsname, $section, $nick, $chan);
print $tcp_connection "!addpre $section $rlsname $nick $chan\n";
if ( $sqladd ) {
if ( $sqlpb ) {
# if ( !($mysql)) {
# $mysql = new Ananke::SqlLink({
# 'type' => 'mysql',
# 'db' => $sqldb,
# 'host' => $sqlip,
# 'port' => $sqlport,
# 'username' => $sqluser,
# 'passwd' => $sqlpass,
# });
# }
$q = "INSERT INTO prebots($sqltables) VALUES (\"$unixtime\",\"$rlsname\",\"$section\",\"$nick\",\"$chan\")";
#$mysql->do($q); undef $q;
}
}
$nowtime=mktime (localtime);
#$ip="sql.fuas.co.uk:36000";
#$mainini = new Config::IniFiles( -file => "inifiles\\main.ini" );
#$Fnick = $mainini->val('general', 'forum_nick' );
#$s = new IO::Socket::INET(PeerAddr => $ip, Proto => 'udp');
#if ( $s ) { print $s "!addpre $section $rlsname $Fnick"; }
if ( $need_pretime_confirm{$rlsname} ) {
$wait_time=$need_pretime_confirm{$rlsname};
$waiting_time=$nowtime-$wait_time;
if ( $waiting_time < 15 ) {
do_chains_for_race($rlsname,$section,1,0,0,1,1);
print $tcp_connection "!waitrace $section $rlsname $nick_$chan\n";
} else { $need_pretime_confirm{$rlsname}=""; }
}
if ( $race_from_pre_sections ) {
if ( $section=~m,$race_from_pre_sections$,i ) {
if ( &checkrace($rlsname,$section) eq "RACED" ) { next; }
print $tcp_connection "PRERACEING $section $rlsname FROM PREBOT\n";
$mainwin->rlsname->Text("$rlsname");
$mainwin->section->Text("$section");
do_chains_for_race($rlsname,$section,1,0,0,0,0);
}
}
next;
}
next;
}
################### new race below
if ( $newmsg=~m,!checkmaninfo,i ) {
($cmd,$section,$rls)=split(/ /,$newmsg);
@info=&find_pretime($rls);
($pttime,$ptrls,$ptsection,$ptbot)=@info;
$nowtime=mktime (localtime);
$pretime = $nowtime - $pttime;
print $tcp_connection "!manchk PRETIME: $pretime seconds ago\n";
$tvrage=0;
$imdb=0;
if ( $section=~m,TV,i ) { $tvrage=1; }
if ( $section=~m,XVID|DVDR|X264,i ) { $imdb=1; }
if ( $tvrage == 1 ) { $imdb=0; }
if ( $rls=~m,MDVDR,i ) { $imdb=0; }
if ( $tvrage == 1 ) {
@tvinfo2=&check_tvrage($rls);
print $tcp_connection "!manchk TVRAGE: @tvinfo2\n";
}
if ( $imdb == 1 ) {
$imdbinfo=&new_imdb($rls);
print $tcp_connection "!manchk IMDB: $imdbinfo\n";
}
$race_sections=&return_section($section);
$race_sections=~s,(^\W),,g;
$allowedsites=&check_allow($rls,$section,$race_sections);
print $tcp_connection "!manchk ALLOWED: $allowedsites\n";
next;
}
### DO NEW RACE
if ( $newmsg=~m,!newrace,i ) {
($cmd, $nick, $site, $section, $rlsname)=split(/ /,$newmsg);
$chk_pretime{$rlsname}="";
if ( $racebot_sortsection{$rlsname} ) { $section=$racebot_sortsection{$rlsname}; } else {
$section=~s,([^\w|-]),,ig;
$origsect=$section;
if ( length($rlsname) < 5 ) { next; }
$sections=$LOADED_sections;
if ( $section=~m,$sections,i ) { $section = $1; }
if ( $section=~m,MP3,i ) { $section="MP3"; }
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$section=&sort_race_section($section, $rlsname);
$section=uc($section);
$racebot_sortsection{$rlsname}=$section;
}
debug("$nick : $site : RACE BOT OUTPUT :: FOUND NEW RACE $rlsname");
my $itemset = "$site~$rlsname";
$timer{$itemset} = [gettimeofday];
$info=&check_single_site($site,$section,$rlsname,1);
if ( &checkrace($rlsname,$section) eq "RACED" ) {
print $tcp_connection "!oldrace $section $rlsname $site $nick $info $section $ptbot\n";
next;
}
print $tcp_connection "!newrace $section $rlsname $site $nick $info $section\n";
$mainwin->rlsname->Text("$rlsname");
$mainwin->section->Text("$section");
if ( $race_from_pre_sections ) {
if ( !($rlsname=~m,/(CD\d|SAMPLE|SUBS),i )) {
if ( $section=~m,$race_from_pre_sections,i ) { next; }
}
}
$numraces++;
do_chains_for_race($rlsname,$section,1,0,0);
next;
}
############ Manaual race below
if ( $newmsg=~m,!manual,i ) {
($cmd,$section,$rlsname,$sites)=split(/ /,$newmsg);
debug("MANUAL TRADE OF $rlsname $section $sites");
$info=&send_chain_2_rush($rlsname,$section,$sites,"MANUAL");
next;
}
###### AFFILIATED RACE BELOW
if ( $newmsg=~m,!affilrace,i ) {
($cmd, $nick, $site, $section, $rlsname, $group)=split(/ /,$newmsg);
if ( length($rlsname) < 5 ) { next; }
if ( $affilbot_sortsection{$rlsname} ) { $section=$affilbot_sortsection{$rlsname}; } else {
$sections=$LOADED_sections;
if ( $section=~m,$sections,i ) { $section = $1; }
if ( $section=~m,MP3,i ) { $section="MP3"; }
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$section=&sort_race_section($section, $rlsname);
$section=uc($section);
$affilbot_sortsection{$rlsname}=$section;
}
if ( !($dbase2)) { &do_sql2; }
$prebotqry2->execute("%$rlsname%");
$found=0;
while ( @row = $prebotqry2->fetchrow_array ) { $found=1; }
if ( !($found )) {
my $unixtime = mktime (localtime);
$prebotinsert2->execute($unixtime, $rlsname, $section, $nick, $chan);
print $tcp_connection "!addpre $section $rlsname $nick $chan\n";
}
# $ip="sql.fuas.co.uk:36000";
# $s = new IO::Socket::INET(PeerAddr => $ip, Proto => 'udp');
# $mainini = new Config::IniFiles( -file => "inifiles\\main.ini" );
# $Fnick = $mainini->val('general', 'forum_nick' );
# if ( $s ) { print $s "!addsite $section $rlsname $Fnick"; }
my $itemset = "$SITENAME~$rlsname";
$timer{$itemset} = [gettimeofday];
$info=&check_single_site($site,$section,$rlsname,0);
$inifile="inifiles//$site.ini";
$mainini = new Config::IniFiles( -file => $inifile );
$affils = $mainini->val("general","siteaffils");
@groups=split(/-/,$rls);
$group1=$groups[-1];
if ( !($affils=~m,($group),i )) {
print "WRITING AFFIL $group -- $group1 TO SITE $site\n";
$affils2 = $mainini->newval('general', 'siteaffils',"$affils $group");
$mainini->RewriteConfig;
}
print $tcp_connection "!affil $section $rlsname $site $nick $info\n";
if ( &checkrace($rlsname,$section) eq "RACED" ) { next; }
do_chains_for_race($rlsname,$section,1,0,0);
next;
}
###### COMPLETED RACE BELOW
if ( $newmsg=~m,!comprace,i ) {
($cmd, $nick, $site, $sect, $rlsname)=split(/ /,$newmsg);
if ( length($rlsname) < 5 ) { next; }
if ( $compbot_sortsection{$rlsname} ) { $section=$compbot_sortsection{$rlsname}; } else {
$sections=$LOADED_sections;
if ( $sect=~m,$sections,i ) { $section = $1; }
if ( $section=~m,MP3,i ) { $section="MP3"; }
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$section=&sort_race_section($section, $rlsname);
$section=uc($section);
$compbot_sortsection{$rlsname}=$section;
}
my $itemset = "$site~$rlsname";
if ( $timer{$itemset}) {
$elapsed = tv_interval ($timer{$itemset});
$timer{$itemset}="";
} else { $elapsed = "UNKNOWN"; }
debug("$nick : $site : RACE BOT OUTPUT :: RACE COMPLETE");
print $tcp_connection "!COMPLETE $section $rlsname $site $nick $elapsed\n";
next;
}
###### NUKED RACE BELOW
if ( $newmsg=~m,!nukerace,i ) {
($cmd, $nick, $site, $sect, $rlsname)=split(/ /,$newmsg);
if ( $nukebot_sortsection{$rlsname} ) { $section=$nukebot_sortsection{$rlsname}; } else {
$sections=$LOADED_sections;
if ( $sect=~m,$sections,i ) { $section = $1; }
if ( $section=~m,MP3,i ) { $section="MP3"; }
if ( !($section)) { print $tcp_connection "!nosect SECTION MISSING FROM $newmsg FROM $chan\n"; next }
$section=&sort_race_section($section, $rlsname);
$section=uc($section);
$nukebot_sortsection{$rlsname}=$section;
}
$info=&check_single_site($site,$section,$rlsname,1);
debug("$nick :: RACE BOT OUTPUT :: FOUND NUKE RACE $rlsname");
print $tcp_connection "!nukerace $section $rlsname $site $nick $info\n";
next;
}
if ( $newmsg=~m,!imdb,i ) {
($cmd,$rlsname)=split(/ /,$newmsg);
$imdbinfo=&new_imdb($rlsname);
print $tcp_connection "!imdb $imdbinfo\n";
next;
}
##### DO SEND CHAINS FROM MANUAL
print "TCP: $got_input\n";
}
close($tcpsock);
}
sub debug {
if ( $tcp_connection ) { print $tcp_connection "!debug @_\n"; }
}
sub do_pftp_chain {
$rlsname=$_[0];
if ( $rlsname=~m,/\w,i ) { return 0;}
$section=$_[1];
$chain=$_[2];
$pftpchain=$_[3];
$fxp=$_[4];
if ( !($pftpchain )) { $pftpchain="pftp"; }
$chain=~s,^\W;,,;
@pchains="";
@pchains=split(";",$chain);
@allowed=();
@affils=();
@finalchains=();
$loop="YES";
foreach $ssite (@pchains) {
if ( $ssite eq "-" ) { $loop="NO"; next; }
my $test=&check_single_site($ssite,$section,$rlsname,0);
if ( $test=~m,YES,i ) { push (@allowed,$ssite); }
if ( $test=~m,AFFIL,i ) { push (@affils,$ssite); }
}
$numsites=@allowed;
if (( $numsites < 2 ) && ( !(@affils))) { return 0; }
if ( !($numsites)) { return 0; }
$sitenum=1;
if ( @affils ) { $afil=$affils[0]; }
if ( $affils[0] ) { unshift(@allowed,$affils[0]); $loop="NO"; }
foreach $chain_site (@allowed) {
if ( $chain_site eq "-" ) { $loop = "NO"; next; }
$chain="";
$site1=$chain_site; $site2=$allowed[$sitenum];
if (!($site2)) { next; }
if (!($site1)) { next; }
if ( $site1 eq $site2 ) { next; }
$chain="$site1,$site2";
if ( $chain ) { push (@finalchains,$chain); }
$sitenum++;
}
if ( $loop eq "YES" ) {
if ( $site2 ) { $site1=$site2; }
$site2=$allowed[0];
if ( $site1 ne $site2 ) { $chain="$site1,$site2"; push (@finalchains,$chain); }
}
$fchain=join(",",@finalchains);
if ( !($fchain)) { return 0; }
my $mainini = new Config::IniFiles( -file => "inifiles//main.ini" );
$pftpport=$mainini->val($pftpchain, 'pftpport'); $pftpip=$mainini->val($pftpchain, 'pftpip');
$pftppass=$mainini->val($pftpchain, 'pftppass'); $pftpline=$mainini->val($pftpchain, 'pftpline');
if ( !($pftpport) ) { return 0; }
$pftpline=~s,section,$section,; $pftpline=~s,rlsname,$rlsname,;
$pftpline=~s,sites,$fchain,; $pftpline="$pftppass $pftpline";
$ipaddr = inet_aton($pftpip); $portaddr = sockaddr_in($pftpport, $ipaddr);
if ( $MySocket ) { $MySocket->close; }
$MySocket=new IO::Socket::INET->new(PeerPort=>$pftpport,
Proto=>'udp',
PeerAddr=>$pftpip);
if ( $fxp ) { $MySocket->send($pftpline); select(undef, undef, undef, 0.3); }
if ( $show ) { $chkwin->chains_out->AddString("PFTP: $fchain"); }
if ( $tcp_connection ) { print $tcp_connection "!pftpsent $section $rlsname $fchain PFTP\n"; }
return 0;
}
sub do_chains_for_race {
$rlsname=$_[0];
$section=$_[1];
$fxp=$_[2];
$ret=$_[3];
$show=$_[4];
$manual=$_[5];
$prebot_race=$_[6];
$check_pretime=1;
if ( $manual ) { $check_pretime="n"; }
if ( $prebot_race ) { $check_pretime="n"; }
if ( $show ) {
$chkwin = $Win32::GUI::Loft::window{REAKTORCHK};
$chkwin->chains_out->Reset;
}
$chain_race_affils=""; $regex_affil_line="";
$chain_race_affils=&find_affils_for_race($rlsname,$section);
$chain_race_affils=~s,^\s|\s$,,ig;
@current_affils=();
if ( $chain_race_affils ) {
$regex_affil_line="($chain_race_affils)";
$regex_affil_line=~s, ,|,ig;
@current_affils=split(" ",$chain_race_affils);
}
#warn "got $regex_affil_line for $rlsname\n";
@chain_affils=();
$chain_affils="";
if ( $chain_race_affils ) { @chain_affils=split(/ /,$chain_race_affils); debug("USING AFFILS $chain_race_affils");}
foreach $afil (@chain_affils) {
$tmpini = new Config::IniFiles( -file => "inifiles\\$afil.ini" );
$no_affil = $tmpini->val("general","affil_slots");
if (!($no_affil)) { $no_affil=1; }
if ( $no_affil ne -1 ) {
$times_to_use_affil{"$afil"}=$no_affil;
} else { $times_to_use_affil{"$afil"}=0; }
}
@tmp_holder=();
@chain_affils=();
@chain_affils=@tmp_holder;
$race_sections=&return_section($section);
$race_sections=~s,(^\W),,g;
if ( $show ) {
defined(my $chkwin = $Win32::GUI::Loft::window{REAKTORCHK});
$check_pretime=$chkwin->CR_PRETIME_CHECK->Checked;
}
$allowedsites=&check_allow($rlsname,$section,$race_sections,$check_pretime);
$allowedsites=~s,^\s|\s$,,ig;
@asite_tmp=split(" ",$allowedsites);
$info=&findchain($section,$rlsname);
if ( $show ) { $chkwin->chkrls_chainname->Text($info); }
@chains=&findnamedchain($info);
($CHNAME,$CHSECT,$CHDET,$CHSTRING)=@chains;
@chainloop=split("/",$CHSTRING);
$chainnum=0;
$affil_loop=0;
$allowed_regex="";
if ( $allowedsites ) {
$allowed_regex="($allowedsites)";
$allowed_regex=~s, ,|,ig;
$allowed_regex=~s,\(\|,\(,ig;
$allowed_regex=~s,\|\),\),ig;
$allowed_regex2=$allowed_regex;
$allowed_regex2=~s,\|,(\W\|;\|^)\|(\\W\|;\|\$),ig;
$allowed_regex2=~s,\)$,\(\W\|;\|^)\),,ig;
$allowed_regex2=~s,^\(,\(\(\W\|;\|^),,ig;
}
$static_allowed="$allowedsites $chain_race_affils";
$divider='$|^';
$allo_regex_tmp=join($divider,(@asite_tmp));
$allo_regex_tmp='^'. $allo_regex_tmp .'$';
foreach $chain (@chainloop) {
@matches=();
@schain=split(";",$chain);
if ( $regex_affil_line ) {
$divider='$|^';
$affil_regex_tmp=join($divider,(@current_affils));
$affil_regex_tmp='^'. $affil_regex_tmp .'$';
#@affil_chain=$chain=~m,$regex_affil_line,ig;
@affil_chain = grep(/$affil_regex_tmp/,@schain);
#print "USING AFFILS: @current_affils\nREGEX: $affil_regex_tmp\nAFFIL_CHAIN: @affil_chain\n";
} else { @affil_chain=(); }
$chainnum++;
@allowed=();
# print "CHAIN IS @schain\nREGEX $allo_regex_tmp\n";
@allowed_try2=();
@matches = grep(/$allo_regex_tmp/,@schain);
$first_chain_site=$schain[0];
$loopchain=1;
$static_chain=0;
$dynamic_affils=0;
$sendchain="";
if ( $chain=~m,(^|\W)-($|\W),ig ) { $loopchain=0; }
if ( $first_chain_site=~m,\?,i ) { next; }
if ( $first_chain_site=~m,\%,i ) { $static_chain=1; }
if ( $first_chain_site=~m,\#,i ) { $dynamic_affils=1; }
if ( $first_chain_site eq "-" ) { $loopchain=0; } else {
if ( $first_chain_site=~m,(\W),i ) {
$fs=$1;
$configini = new Config::IniFiles( -file => "inifiles\\main.ini" ) || system "CANNOT FIND MAIN.INI";
$pftpchain = $configini->val("pftpsym",$fs);
if ( $pftpchain ) {
if ( $pftpchain=~m,pftp,i ) {
&do_pftp_chain($rlsname,$section,$chain,$pftpchain,$fxp,$show); }
next;
}
}
}
$done_chains=0;
if ( $static_chain ) {
$static_allowed="$allowedsites $chain_race_affils";
$sa2=$static_allowed;
$sa2=~s,^\s|\s$,,ig;
@asite_tmp_sa=split(" ",$sa2);
$divider='$|^';
$allo_regex_sa=join($divider,(@asite_tmp_sa));
$allo_regex_sa='^'. $allo_regex_sa .'$';
if ( $static_allowed ) {
$static_allowed="($static_allowed)";
$static_allowed=~s, ,\|,ig;
$static_allowed=~s,\|\|,\|,ig;
$static_allowed=~s,\(\|,\(,ig;
$static_allowed=~s,\|\),\),ig;
}
@matches=$chain=~m,$static_allowed,ig;
@matches = grep(/$allo_regex_sa/,@schain);
$site1=$matches[0];
$last_site=$matches[-1];
if ( $site1 ne $last_site ) {
if ( $loopchain == 1 ) { push (@matches,$site1); }
$sendchain=join(";",(@matches));
$loopchain=0;
$done_chains=1;
}
$loopchain=0;
$done_chains=1;
}
if ( !($done_chains)) {
#not done chains
if ( $dynamic_affils ) {
if ( $chain_race_affils ) {
@affils=split(" ",$chain_race_affils);
$current_tmp_affil="";
foreach $afil_site (@affils) {
if ( !($current_tmp_affil)) {
if ( $times_to_use_affil{$afil_site} ) {
$times_to_use_affil{$afil_site}--;
$current_tmp_affil=$afil_site;
$loopchain=0;
}
}
}
unshift (@matches,$current_tmp_affil);
$sendchain=join(";",(@matches));
$sendchain=~s,^;,,ig;
$sendchain=~s,;$,,ig;
$sendchain=~s,;;,;,ig;
}
if ( !($current_tmp_affil)) {
$sendchain=join(";",(@matches));
$sendchain=~s,^;,,ig;
$sendchain=~s,;$,,ig;
$sendchain=~s,;;,;,ig;
if ( $loopchain ) {
@tmp_splits=split(";",$sendchain);
$num=@tmp_splits;
if ( $num>1 ) {
$firstsite=$tmp_splits[0];
$sendchain="$sendchain;$firstsite";
}
}
}
$done_chains=1;
}
#end of done match
}
if ( !($done_chains)) {
if ( $affil_chain[0] ) {
my $affil_to_use=$affil_chain[0];
unshift (@matches,$affil_to_use);
$sendchain=join(";",(@matches));
$loopchain=0;
}
$site1=$matches[0];
$last_site=$matches[-1];
if ( $site1 ne $last_site ) {
if ( $loopchain == 1 ) { push (@matches,$site1); }
}
$sendchain=join(";",(@matches));
$sendchain=~s,^;,,ig;
$sendchain=~s,;$,,ig;
$sendchain=~s,;;,;,ig;
}
if ( !($sendchain) ) { $sendchain=join(";",(@matches)); }
$mainini_scal = new Config::IniFiles( -file => "inifiles\\main.ini" ) || next;
$debug = $mainini_scal->val("general","debug");
$sendchain=~s,(^|\W)-($|\W),,ig;
if ( $debug ) {
print "
GOT HERE WITH $chain
NAME: $rlsname
SECTION $section
LOOP: $loopchain
AFFIL: $affilchain $regex_affil_line -- USE: @affil_chain
ALLOWED: $allowedsites
ALLOWED REGEX: $allowed_regex
STATIC CHAIN: $static_chain
DYNAMIC_AFFILS: $dynamic_affils
TO SEND: @matches -- $sendchain
\n";
}
if ($sendchain=~m,\w,i ) {
if ( $fxp ) { $info=&send_chain_2_rush($rlsname,$section,$sendchain,$CHNAME); print $tcp_connection "!show CHAIN: $rlsname $section $sendchain $CHNAME\n"; }
if ( $show ) {
$chkwin = $Win32::GUI::Loft::window{REAKTORCHK};
$chkwin->chains_out->AddString("USE : $chain");
$chkwin->chains_out->AddString("SENT: $sendchain");
}
} else {
if ( $fxp ) { debug("NO SITES IN THIS CHAIN ALLOWED $chain $rlsname $section"); }
if ( $show ) { $chkwin->chains_out->AddString("NONE: $chain"); }
}
}
return @chainloop;
}
sub check_allow {
my $rlsname=$_[0];
my $section=$_[1];
my $gasites=$_[2];
my $chkrls=$_[0];
my $check_pretime=$_[3];
#if ( !($check_pretime)) { $check_pretime=1; } else { $check_pretime=0; }
($chkrls,$extra)=split(/\//,$chkrls);
my $allowed="";
@agroups=split(/ /,$gasites);
foreach $asite (@agroups) {
if ( $asite ) {
my $test=&check_single_site($asite,$section,$rlsname,$check_pretime);
if ( $test=~m,yes,i ) { $allowed="$allowed $asite"; }
}
}
return $allowed;
}
sub find_affils_for_race {
my $arls = shift;
my $asect = shift;
if ( $affils_4_race{$arls} ) { return $affils_4_race{$arls}; }
$arls=~s,/(CD\d|COVERS|SAMPLE|subs|DISK|DISC|PART)$,,i;
$affillist="";
$sitelist = $mainhash{"sites"};
@sitelist=split(/ /,$sitelist);
foreach $site (@sitelist) {
@siteinfos=(split(/,/,$siteinfo{$site}));
$affils=@siteinfos[11]; $sections=@siteinfos[1]; $trade=@siteinfos[10];
@sectinfos=(split(/,/,$sectionhash{"$site,$asect"}));
$sectrade=@sectinfos[2];
if ( !($sections=~m,$asect,ig)) { next; }
if ( $trade == 1 ) { next; }
if ( $sectrade == 1 ) { next; }
if ( $affils eq undef ) { next; }
$rgaffil=$affils;
$rgaffil=~s, ,\|,ig;
$rgaffil=~s,\|\|,\|,ig;
$rgaffil=~s,$\|,,ig;
$rgaffil=~s,\|^,,ig;
$rgaffil="($rgaffil)";
if ( $arls=~m,-($rgaffil)($|INT|_INT),i) {
if ( $affillist ) { $affillist="$affillist $site"; next; } else { $affillist="$site"; next; }
}
}
@sitelist="";
$sitelist="";
$myaffils="";
$affils_4_race{$arls}=$affillist;
return $affillist;
}
sub out_2_file {
open(APPFH, ">>pdebug.log") || system "Opening output.txt: $!";
$debug_out =$_[0];
chomp($debug_out);
print APPFH "$debug_out\n";
close(APPFH);
}
sub checkrace {
my $dbase="raced.db";
my $raceinfo = DBI->connect("dbi:SQLite:dbname=$dbase","","");
$sth = $raceinfo->prepare ("create table IF NOT EXISTS raceinfo(time,section,name)");
$sth->execute();
my $time = mktime (localtime);
$rlsname = $_[0];
$section = $_[1];
my $insert = $raceinfo->prepare("INSERT INTO raceinfo(time,section,name) VALUES (?,?,?)");
my $qry = $raceinfo->prepare("SELECT time,name FROM raceinfo WHERE name like ? ORDER BY time DESC LIMIT 3");
my $chk_rls = "$rlsname";
$qry->execute( $chk_rls );
$exist =0;
while ( @row = $qry->fetchrow_array ) { $exist = 1; }
if ( $exist == 1 ) { return "RACED"; }
$insert->execute( $time, $section, $rlsname);
return "OK";
}
sub do_sql2 {
$dbase2="prebot.db";
$prebase2 = DBI->connect("dbi:SQLite:dbname=$dbase2","","") || &pberror;
$sth2 = $prebase2->prepare ("create table IF NOT EXISTS prebots(time varchr(20),name varchr(100),section varchr(30),bot varchr(20),chan)");
$sth2->execute();
$prebotinsert2 = $prebase2->prepare("INSERT INTO prebots(time,name,section,bot,chan) VALUES (?,?,?,?,?)");
$prebotqry2 = $prebase2->prepare("SELECT time,name,section,bot FROM prebots WHERE name like ? ORDER BY time DESC LIMIT 1");
}
sub find_need_mirc {
if ( !($mircpath)) { $need = "mircpath"; }
if ( !($rushopt)) { $need = "$need rushopt"; }
if ( !($rushskip)) { $need = "$need rushskip"; }
if ( !($opensites)) { $need = "$need opensites"; }
if ( !($closedsites)) { $need = "$need closedsites"; }
if ( !($prebots)) { $need = "$need prebots"; }
if ( !($need)) { $need="NONE"; }
return $need;
}
sub custom_race_section {
if ( !(%sectionini)) {
tie %sectionini, 'Config::IniFiles', ( -file => "sections.ini" );
}
my $section=$_[0];
$section=uc($section);
my $nwsec = $sectionini{"sections"}{$section};
if ( $nwsec ) { return $nwsec; }
debug("not in sections.ini $section");
return $section;
}
sub sort_race_section {
my $section=$_[0]; my $rlsname=$_[1]; my $startsect=$_[0];
$section=uc($section);
$mainini_scal = new Config::IniFiles( -file => "inifiles\\main.ini" ) || next;
$debug = $mainini_scal->val("general","section_debug");
if ( $debug ) { warn "SECTION DEBUG: BASE-$section RLSNAME-$rlsname\n"; }
my $sectionini = new Config::IniFiles( -file => "sections\\section.cha" );
if ( $LOADED_sections ) { if ( $section=~m,$LOADED_sections,i ) { $section =$1; } }
if ( $startsect=~m,DAY,i ) { $section="0-DAY"; }
if ( $sectionini->SectionExists("GLOBAL")
No comments:
Post a Comment