Posted by Security is just an illusion at Tuesday, March 05, 2013
Read our previous post
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