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(/\,/, $data_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{debug} );
			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{CurrentState} 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( $param{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( $param{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( $param{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 "Recursive"));
	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}."]	$options{$linea}\n" if(!($options_detail{$linea} eq " "));
		print "	-".$linea."  ".$options_detail{$linea}." 	$options{$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
.