use strict;
no strict "subs";
use Win32::Service;
use Socket;
use LWP::UserAgent;
system("cls") if ($ENV{OS});
my $script = "IISScanner";
my $version = "0.01";
my $written = "13 Mar 2002";
my $revised = "13 Mar 2002";
my $writer = "Oscar Alarcon R";
my $Error_code = 1;
my($equipo, $status_servicio, $status_http, $port_ok);
my %options = (
"l" => "Archive of machine list to be Scanning.",
"m" => "UNC Path Machine name.",
"log" => "Log File name.",
"help" => "This Screen.",
"nops" => "No port Scanning, only scanning port 80."
);
my %options_detail = (
"l" => "Archive",
"m" => "\\\\UNCName",
"log" => "Archive",
"help" => " ",
"nops" => " "
);
my $example = $script." -m:\\server1 -nops -log:c:\\temp\\web.log";
$~ = BANNER;
write;
my %param;
(%param)=&TAKE_Param();
&SINTAX_Error() if($param{help});
&ECHO_Param() if($param{debug});
print "SYSM >< Calling TAKE_HostName\n" if( $param{debug} );
my(@list_server)=&TAKE_HostName();
print "SYSM >< Calling CHEK_Proccess\n" if( $param{debug} );
my(@list_out)=&CHEK_Proccess(@list_server);
$~ = INFORME;
if($param{log}){
print "SYSM >< Printing Log $param{log}\n" if( $param{debug} );
open(LOG_HEADER, ">$param{log}");
write(LOG_HEADER);
close(LOG_HEADER);
open(LOG, ">>$param{log}");
}
foreach my $data_equ (@list_out){
chomp($data_equ);
($equipo, $status_servicio, $status_http, $port_ok)=split(/\,/, $d
+ata_equ);
write;
write(LOG);
}
if($param{log}){
close(LOG);
}
print "[END CODE]\n" if( $param{debug} );
exit;
sub CHEK_Proccess {
my(@servers) = @_;
my(@output) = ();
print "IN CHEK_Proccess\n" if( $param{debug} );
foreach my $linea (@servers){
chomp($linea);
print " DATA << $linea\n" if( $param{debug} );
print " SYSM >< Calling SCAN_IISSrv\n" if( $param{debug} );
my($status)=&SCAN_IISSrv($linea);
if( $status eq "OK" ){
print " SYSM >< Calling SCAN_Ports\n" if( $param{de
+bug} );
my(@ports_server)=&SCAN_Ports($linea);
foreach my $port_v (@ports_server){
chomp($port_v);
print " SYSM >< Calling SCAN_Https\n" if( $
+param{debug} );
my($status2)=&SCAN_Https($linea, $port_v);
if( $status2 eq "OK" ){
my $temporal = $linea.",".$status.",".$status2.","
+.$port_v;
push(@output, $temporal);
}
}
}
}
print "OUT CHEK_Proccess\n" if( $param{debug} );
return(@output);
}
sub SCAN_IISSrv {
my($machine) = @_;
my $result = "FAIL";
my @service_l = ( "W3SVC", "IISADMIN" );
my %status1 = ();
my %status2 = ();
print " IN SCAN_IISSrv\n" if( $param{debug} );
print " DATA << $machine\n" if( $param{debug} );
print " SYSM >< Scanning Services\n" if( $param{debug}
+);
Win32::Service::GetStatus($machine, $service_l[0], \%status1);
+
Win32::Service::GetStatus($machine, $service_l[1], \%status2);
+
print " SYSM >< Check Status of Services\n" if( $param{
+debug} );
$result = "OK" if( $status1{CurrentState} eq 4 && $status2{Current
+State} eq 4 );
print " DATA >> $result\n" if( $param{debug} );
print " OUT SCAN_IISSrv\n" if( $param{debug} );
return($result);
}
sub SCAN_Ports {
my($machine) = @_;
my(@listado_p) = ();
my(@ports) = ();
print " IN SCAN_Ports\n" if( $param{debug} );
print " DATA << $machine\n" if( $param{debug} );
if( $param{nops}){
@ports = ( 80 );
}else{
@ports = ( 80 .. 100, 940 .. 1000, 10000 );
}
foreach my $port (@ports){
chomp($machine, $port);
$machine =~ s/\\//eg;
print " SYSM >< Scanning Port $port\n" if( $par
+am{debug} );
socket(TO_SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
+;
my $internet_addr = inet_aton($machine);
my $paddr = sockaddr_in($port, $internet_addr);
if(connect(TO_SERVER, $paddr)){
print " DATA >> $port is Active\n" if( $par
+am{debug} );
push(@listado_p, $port);
close(TO_SERVER);
}
}
print " OUT SCAN_Ports\n" if( $param{debug} );
return(@listado_p);
}
sub SCAN_Https {
my($machine, $port) = @_;
my $result = "FAIL";
$machine =~ s/\\//eg;
my $url = "http://".$machine.":".$port."/";
print " IN SCAN_Https\n" if( $param{debug} );
print " DATA << $machine on $port\n" if( $param
+{debug} );
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new(GET => $url);
my $respons = $ua->request($request);
$ua->proxy(['http', 'ftp'] , $url);
my $h = new HTTP::Headers;
my %accepts = $h->clone;
if ($respons->is_success) {
print " DATA >> $port is Active\n" if( $par
+am{debug} );
$result = "OK";
}
print " OUT SCAN_Https\n" if( $param{debug} );
return($result);
}
sub TAKE_HostName {
my(@hostname) = ();
print "IN TAKE_HostName\n" if( $param{debug} );
if( $param{l} ){
open(SRC, "<$param{l}")|| ($Error_code = 0);
if( $Error_code eq 0){
print " SYSM >< Cant Open $param{l}\n" if( $param{debug
+} );
print " Brutal EXIT !\n" if( $param{debug} );
exit;
}
print " SYSM >< Read archive $param{l}\n" if( $param{debug}
+ );
while(<SRC>){
my $linea = $_;
chomp($linea);
print " DATA >> $linea\n" if( $param{debug} );
push(@hostname, $linea );
}
close(SRC);
}else{
print " Read DATA $param{m}\n" if( $param{debug} );
print " DATA >> $param{m}\n" if( $param{debug} );
push(@hostname, $param{m} );
}
print "OUT TAKE_HostName\n" if( $param{debug} );
return(@hostname);
}
sub TAKE_Param{
if( @ARGV ){
foreach my $parame ( @ARGV ){
chomp($parame);
my($key, $content, $content2)=split( /:/, $parame);
if($key =~ /-/ || $key =~ /\//){
$key = lc($key);
$key =~ s/-//eg if($key =~ /-/);
$key =~ s/\///eg if($key =~ /\//);
$content = " " if(!$content);
$param{$key} = $content if(!($key eq "log"));
$param{$key} = $content.":".$content2 if($key eq "log"
+);
}else{
&SINTAX_Error();
}
}
}else{
&SINTAX_Error();
}
&SINTAX_Error("Recursive") if($param{"l"} && $param{"m"});
return(%param);
}
sub ECHO_Param{
print " Debugging Option \n\n";
print " [INPUT Trace] \n";
foreach my $key ( keys(%param) ){
if(!(lc($key) eq "debug")){
chomp($key);
print " $options{$key} => $param{$key}\n" if(!($
+param{$key} eq " "));
print " $options{$key}\n" if($param{$key} eq " ");
}
}
print "\n";
print "[BEGIN CODE]\n";
return();
}
sub SINTAX_Error{
my($Error) = @_;
print " Sintax Error\n\n" if(!$param{help} && !($Error eq "Recursi
+ve"));
print " Critical Sintax Error\n\n Recursive parameter YOU DONT USE
+ -l parameter whith -m parameter !\n\n" if($Error eq "Recursive");
print " Help Screen \n\n" if($param{help});
print " Usage $script [ OPTIONS ]\n";
print "\n";
foreach my $linea ( keys(%options) ){
chomp($linea);
print " -".$linea.":[".$options_detail{$linea}."] $optio
+ns{$linea}\n" if(!($options_detail{$linea} eq " "));
print " -".$linea." ".$options_detail{$linea}." $optio
+ns{$linea}\n" if($options_detail{$linea} eq " ");
}
print "\n Example :\n $example\n";
exit;
}
format BANNER =
@<<<<<<<<<<<<< @<<<<<<<<< Revised : @<<<<
+<<<<<<<<<<
$script, $version, $revised
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<
+<<<<<<<<<<
$writer, $written
----------------------------------------------------------------------
+----------
Machine Srv IIS HTTP Port
.
format INFORME =
@<<<<<<<<<<<<< @<<<<<<<<<<< @<<<<<<<<< @<<<<<<<<<
$equipo, $status_servicio, $status_http, $port_ok
.
format LOG_HEADER =
@<<<<<<<<<<<<< @<<<<<<<<< Revised : @<<<<
+<<<<<<<<<<
$script, $version, $revised
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<
+<<<<<<<<<<
$writer, $written
----------------------------------------------------------------------
+----------
Machine Srv IIS HTTP Port
.
format LOG =
@<<<<<<<<<<<<< @<<<<<<<<<<< @<<<<<<<<< @<<<<<<<<<
$equipo, $status_servicio, $status_http, $port_ok
.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.