#!/usr/bin/perl


# comments: michael@scanit.be

use strict;
use Getopt::Std;
use IO::Socket;
use MIME::Base64;       # for http authentication
use HTML::LinkExtor;	# for grabbing links

# ----------------------------------------------------------------------------- #
my ($port,$host,$request,$socket,$dir,$i,$extra,$zombie,$creds,$file,%options);
my ($fullpath, $randdata);
$port = 80; 
$i = 1;
$creds = "";
$fullpath = "";
$randdata = sprintf "%d", rand()*1000+10; # just to make sure the files don't exist.

print "iis remote directory settings check\n";
print "by michael\@scanit.be\n\n";

getopts('h:u:f:die', \%options);
checkoptions(\%options);

if(!defined $options{f}){
    # grab links from the default page, and so on
    getlinks("/");
    }
else {
    # read in $file (or stdin, if file eq '_')
    if($options{f} eq '_'){
	foreach (<>){ $dir = $_; try($dir); }
	} 
    else{
	open (FILE, $file) || die " error: cannot open file: $file: $!";
	while(FILE){ $dir = $_; try($dir); }    
	}
}

sub try($){
 	$zombie = 0;
	$extra = "";
	chop;
	$dir = $_;
	print "  $i:\tmode (";
	indexable($dir);
	if(!$zombie){
	    readable($dir);
	    writable($dir);
	    executable($dir);
	    scriptable($dir);
	    browsable($dir);
	    }
	print ") for $dir ";
	if ($extra ne ""){  print " " x (20 - length $dir); print "\t [ $extra]"; }
	print "\r\n";
	$i++;
}

unless (defined $options{e}){
    print "\n";
    printer();
    idc();
    ida();
    idq();
    htw();
    htr();
    print "\n";
    }

unless (defined $options{i}){ getip(); }
unless (defined $options{d}){ getdom(); }

if($fullpath ne ""){
    print "\n the full webserver path is: $fullpath\n";
    }
    

print "\n\n";

sub usage{ 
    print " usage: $0 -h <host>(:<port>) <-u user:pass> (-d) (-i) (-e) (-f <file>)\n\n"; 
    print "  -u : Basic Authentication credentials\n";
    print "  -i : don't try to grab (internal) IP address or netbios name.\n";
    print "  -d : don't try to grab domain name.\n";
    print "  -e : skips checks for installed extensions.\n";
    print "  -f : reads all harvested directories frome <file> (use \"_\" for stdin)\n\n";
    print " Example output: \n";
    print " 1:\tmode (ir--sb) for /.
\n";
    print " 2:\tmode (ir--sb) for /test.\n";
    print " 3:\tmode (------) for /images.     [ returned 404 - not found ]
\n";
    print " 4:\tmode (*r--sb) for /forum.      [ returned 302 - redirection ]
\n";
    print " 5:\tmode (*rwxsb) for /bb.         [ returned 500 - server error ]
\n\n";
    print "   \t      ^^^^^^\n";
    print "   \t      ||||||_ browsable (much false positives)\n";
    print "   \t      |||||__ can execute ASP scripts\n";
    print "   \t      ||||___ can execute .exe's, .dll's, .bat's, ...\n";
    print "   \t      |||____ writable\n";
    print "   \t      ||_____ readable\n";
    print "   \t      |______ indexable (or default document)\n\n";
    print " Example: cat dirs | $0 -h www.somehost.com:80 -u admin:crackme -f _\n";
    print "\n";
    exit(1); 
    }

sub probe($){
    my $request = shift;
    my $socket = IO::Socket::INET->new(	
				PeerAddr=>$host,
				PeerPort=>$port,
				Proto=>"tcp") || die "Connection refused.";
    send $socket, $request, 0;
    recv $socket, $request, 12, 0;
    close $socket;
    my @retval = split / /, $request;
    return $retval[1];
    }

sub fprobe($){ # full probe
    my $request = shift;
    my $socket = IO::Socket::INET->new(	
				PeerAddr=>$host,
				PeerPort=>$port,
				Proto=>"tcp") || die "Connection refused.";
    send $socket, $request, 0;
    recv $socket, $request, 512, 0;
    close $socket;;
    return $request;
    }

sub checkoptions(){
    my $options = shift;
    if(!defined $options->{h}){ usage(); } else { $host = $options{h}; }
    if($host =~ ":"){ ($host, $port) = split /:/, $host; }
    if($options{u}){ $creds = encode_base64($options{u}); }
    if($options{f} ne '_'){ $file = $options{f}; }
    if(!defined $options{i}) { 
	print "\n ip/netbios name disclosure will only if $host has basic auth.\n";
	}
}	

sub indexable($){
    my $dir = shift;
    $request  = "GET /$dir/ HTTP/1.0\r\n"; 
    $request .= "Host: $host\r\n";     
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";
    SWITCH: 
	{
	if (probe($request) eq "200"){ print "i"; }    
	if (probe($request) eq "403"){ print "-"; }    
	if (probe($request) eq "500"){ 
	    print "*"; 
	    $extra .= "returned 500 - server error "; 
	    }    
	if (probe($request) eq "401"){ 
	    print "?-----"; 
	    $extra .= "Basic authentication needed! ";
	    $zombie = 1;
	    }    
	if (probe($request) eq "302"){ 
	    print "*"; 
	    $extra .= "returned 302 - redirection "; 
	    }    
	if (probe($request) eq "404"){ 
	    print "------"; 
	    $extra = "returned 404 - not found"; 
	    $zombie = 1;
	    }    
	}
}

sub readable($){
    my $dir = shift;
    $request  = "GET /$dir/blah.txt HTTP/1.0\r\n"; 
    $request .= "Host: $host\r\n";     
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";
    SWITCH: 
	{
	if (probe($request) eq "404"){ print "r"; }    
	if (probe($request) eq "403"){ print "-"; }    
	}
}

sub writable($){
    my $dir = shift;
    $request  = "PUT /$dir/foo.txt HTTP/1.0\r\n"; 
    $request .= "Host: $host\r\n";     
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "Content-Length: 4\r\n\r\n";
    $request .= "boom\r\n";
    $request .= "\r\n";     
    SWITCH: 
	{
	if (probe($request) eq "201"){ print "w"; } # uploaded   
	if (probe($request) eq "200"){ print "w"; } # overwritten, oops :)
	if (probe($request) eq "403"){ print "-"; }    
	if (probe($request) eq "401"){ 
	    print "*"; 
	    $extra .= "writable, but not for you (IUSR). "; 
	    }    	
	}
}

sub executable($){
    my $dir = shift;
    $request  = "GET /$dir/foo.dll HTTP/1.0\r\n"; 
    $request .= "Host: $host\r\n";     
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    SWITCH:
	{
	if (probe($request) eq "500"){ print "x"; }    
	if (probe($request) eq "404"){ print "-"; }    
	}    
}

sub scriptable($){
    my $dir = shift;
    $request  = "GET /$dir/blah.asp HTTP/1.0\r\n"; 
    $request .= "Host: $host\r\n";     
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    SWITCH:
	{
	if (probe($request) eq "200"){ print "s"; }    
	if (probe($request) eq "404"){ print "s"; }    
	if (probe($request) eq "403"){ print "-"; }    
	} 
}

sub browsable($){
    my $dir = shift;
    $request  = "PROPFIND /$dir/ HTTP/1.0\r\n"; 
    $request .= "Host: $host\r\n";     
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "Content-Length: 0\r\n";
    $request .= "\r\n";     
    SWITCH:
	{
	if (probe($request) eq "207"){ print "b"; }    
	else{ print "-"; }    
	}    		
}

sub htr(){
    my $data;
    $request  = "GET /foo$randdata.htr HTTP/1.0\r\n";
    $request .= "Host: $host\r\n";
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    $data = fprobe($request);
    if($data =~ "The requested file could not be found."){
	print " $host has .htr extension enabled\n";
	}
}

sub printer(){
    my $data;
    $request  = "GET /foo$randdata.printer HTTP/1.0\r\n";
    $request .= "Host: $host\r\n";
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    $data = fprobe($request);
    if($data =~ "Error in web printer install"){
	print " $host has .printer extension enabled\n";
	}
}

sub idc(){
    my $data;
    $request  = "GET /foo$randdata.idc HTTP/1.0\r\n";
    $request .= "Host: $host\r\n";
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    $data = fprobe($request);
    if($data =~ "Error Performing Query"){
	print " $host has .idc extension enabled\n";
	}
}

sub ida(){
    my $data;
    $request  = "GET /foo$randdata.ida HTTP/1.0\r\n";
    $request .= "Host: $host\r\n";
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    $data = fprobe($request);
    if($data =~ "200"){
	if($data =~ "<HTML>The IDQ file"){
	    print " $host has .ida extension enabled\n";
	    }
	}
    my @temp = split / /, $data;
    $fullpath = substr($temp[13],0,(length($temp[13])-10));
}

sub idq(){
    my $data;
    $request  = "GET /foo$randdata.idq HTTP/1.0\r\n";
    $request .= "Host: $host\r\n";
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    $data = fprobe($request);
    if($data =~ "200"){
	if($data =~ "<HTML>The IDQ file"){
	    print " $host has .idq extension enabled\n";
	    }
	}
    my @temp = split / /, $data;
    $fullpath = substr($temp[13],0,(length($temp[13])-10));
}


sub htw(){
    my $data;
    $request  = "GET /foo$randdata.htw HTTP/1.0\r\n";
    $request .= "Host: $host\r\n";
    if($creds ne ""){ $request .= "Authentication: Basic $creds\r\n"; }
    $request .= "\r\n";     
    $data = fprobe($request);
    if($data =~ "200"){
	if($data =~ "The format of QUERY_STRING is invalid."){
	    print " $host has .htw extension enabled\n";
	    }
	}

}

sub cb(){
    my ($tag, $links) = @_;
    print "$tag @{[$links]}\n";
}

sub getlinks($){
    my $dir = shift;
    my $p = HTML::LinkExtor->new(\&cb, $host);
    $p->parse_file("/");
}

sub getip(){
    $request  = "PROPFIND / HTTP/1.0\r\n";
    $request .= "Host:\r\n";
    $request .= "Content-Length: 0\r\n\r\n";
    my $socket = IO::Socket::INET->new(	
				PeerAddr=>$host,
				PeerPort=>$port,
				Proto=>"tcp") || die "Connection refused.";
    send $socket, $request, 0;
    recv $socket, $request, 512, 0;
    if($request =~ "401"){
	if($request =~ /WWW-Authenticate: Basic realm=/){
	    my @temp = split /\"/,$request;
	    print " Internal IP/NetBIOS name: $temp[1]\n";
	}
    }
}

sub getdom(){
    $request  = "GET / HTTP/1.1\r\n";
    $request .= "Host: $host\r\n";
    $request .= "Authorization: Negotiate TlRMTVNTUAABAAAAB4IAoAAAAAAAAAAAAAAAAAAAAAA=\r\n\r\n";
    my $socket = IO::Socket::INET->new(	
				PeerAddr=>$host,
				PeerPort=>$port,
				Proto=>"tcp") || die "Connection refused.";
    send $socket, $request, 0;
    recv $socket, $request, 512, 0;
    if($request =~ "401"){
	if($request =~ /WWW-Authenticate: Negotiate /){
	    my @temp = split / /,$request;
	    my $data = substr($temp[12], 0, 160);
	    my $decoded = decode_base64($data);
	    if($decoded =~ "NTLM"){
		print "\n $host has NTML authentication.\n";
	    }
	}
    }
}