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
.