#!/usr/bin/perl
#
# Really big, scary script by  rain forest puppy
# Notable input from #!adm, vacuum, Interrupt
# Greets to spinux; I used some of his ideas/code from nwrap
# It's a massive web-scanning scripting engine
# (emphasis on massive) -- read the dox for usage infoz

$whisker_version="1.1.1";
use Socket; use Getopt::Std; # hopefully these are standard :)

getopts("fs:n:vdp:h:l:H:Vu:iINS:E", \%args);

$verbose=1;  $debug=1;
$LOGGING=0;  $vhosts=0;

$verbose=0  unless defined $args{v};
$debug=0    unless defined $args{d};
$vhosts=1   if defined $args{V};

if(defined $args{p}){
	$proxy="1";
	@k=split(/\./, $args{p});
	$proxy_addy="$k[0].$k[1].$k[2].$k[3]";
	$proxy_port="$k[4]";}

if(defined($args{l})){
	$logfile=$args{l};
	$LOGGING=1;
	open(LOG, ">>$logfile") || die("Error opening log file.\n");}

# clear the screen...
if($LOGGING==0){ 
if($ENV{'OS'}=~/Win/i){system("cls");} else {system("clear");}}

wprint("-- whisker / v$whisker_version / rain.forest.puppy / ADM / wiretrip --\n");

if((!defined $args{n} && !defined $args{h}) && !defined $args{H} || !defined $args{s}){
print qq~Usage:  whisker -s script.file ((-n input.file) | (-h host) | (-H list))
		(-l log.file)

	-s specifies the script database file     **
	-n nmap output (machine format, v2.06+)   *
	-h scan single host (IP or domain)        *
	-H host list to scan (file)               *
	-V use virtual hosts when possible
	-v verbose.  Print more information
	-d debug. Print extra crud++ (to STDERR)
	-p proxy off x.x.x.x port y (HTTP proxy)
	-l log to file instead of stdout
	-u user input; pass XXUser to script
	-I IDS-spoof mode--encode URLs to bypass scanners
	-E IDS-evasive mode--more IDS obfuscation
	-i more info (exploit information and such)
	-N query Netcraft for server OS guess
	-S force server version (e.g. -S "Apache/1.3.6")

 	** required     * optional; one must exist
~; 
exit;}

$dbfile		=$args{s};
$nmapfile	=$args{n} if defined($args{n});
$singlehost	=$args{h} if defined($args{h});
$hostsfile	=$args{H} if defined($args{H});

if(!(-e $dbfile)){ print "How about specifing files that exist?!?\n\n"; exit;}

#global DATAS
%D=(); @hosts_to_scan=();

if (defined($args{S})){ $args{S}="Server: $args{S}\n";}

if (defined($args{H})){
	if(!(-e $hostsfile)){ die("How about specifing a file that exists?!?\n\n");}
	open(VIN,"<$hostsfile");
	while(<VIN>){ s/[^-a-zA-Z0-9\.]//g;	
		push @hosts_to_scan, $_;}
	close(VIN);}		

if (defined($args{h})){ push @hosts_to_scan, $singlehost;}

#control datas...so we can change these in the script, if needed
$D{'XXPort'}	=80;         	#port to scan...80 for normal webservers
$D{'XXRoot'}	="";         	#default prefix for URLs...
$D{'XXMeth'}	="HEAD";     	#how to retrieve the file...HEAD preferable
$D{'XXVer'}	="HTTP/1.0";  	#http version for us to use
$D{'XXDebug'}	=$debug;	#do we want debug output
$D{'XXVerbose'}	=$verbose;	#do we want verbose output
$D{'XXProxy'}	=0;		#are we using a proxy
$D{'IP'}	="";		#ip address
$D{'XXTarget'}	="";		#actual target ip (host/ip modified for proxy scans)
$D{'XXBadMeth'}	=1;		#bad method compensation if 400 or 500
$D{'XXSStr'}	="";		#return server software string
$D{'XXRet'}	="";		#http return code of page
$D{'XXRetStr'}	="";		#http return string
$D{'XXSVer'}	="";		#http version return from server
$D{'XXIDS'}	=0;		#whether or not to use IDS spoofing
$D{'XXForce'}	=0;		#force scan(), regardless of server
$D{'XXForceS'}	=0;		#force server() comparisons as well
$D{'XXCLLeak'}	="";		#content-location leak
$D{'XXIsIndex'} =0;		#is it a directory index?
$D{'XXStopOnDir'} =0;		#stop on a directory index
$D{'XXCLen'}	=0;		#content length
@DXX=();			#global array for stuff :)

if($proxy eq "1"){  #setup proxy stuff
  verbose("- Proxy: $proxy_addy Port: $proxy_port");
  $D{'XXProxy'}=1;
  $D{'XXProxy_addy'}=$proxy_addy;
  $D{'XXProxy2port'}=$D{'XXPort'};
  $D{'XXPort'}=$proxy_port;}

$D{'XXForce'}=1 if defined($args{f});

if(defined($args{I}) || defined($args{E})){
	wprint("- Using IDS spoofing...\n");
	$D{'XXIDS'}="1";}

$D{'XXUser'}	=$args{u};

if(defined($args{i})){$D{'XXInfo'}=1;}else{$D{'XXInfo'}=0;}

# unbuffer STDOUT & STDERR
select(STDERR); $| = 1; select(STDOUT); $| = 1;

# setup timeout alarm
$SIG{ALRM} = sub {die "timeout"};

open(INP,"<$dbfile") || die("Can't open scan database $dbfile\n");
@inp=<INP>; close(INP);
$inp_p=0; 	# current pointer
$inp_r=0; 	# lookahead pointer
$inp_c=@inp;	# count of lines


############################################################################
#  Preprocess the scan database logic here
#     @inp has the lines, $inp_c is the total count, $inp_p is the pointer

for($inp_p=0;$inp_p<=$inp_c;$inp_p++){
	$inp[$inp_p]=~s/^[ \t]*//; # kill leading whitespace

	# handle insert command
	if($inp[$inp_p]=~/^insert ([^ \t\r\n]+)/){
		if(-e $1){	open(IIN,"<$1");
		@in=<IIN>; 	close(IIN);}
		splice(@inp,$inp_p,1,@in);
		undef @in; $inp_c=@inp;}

	# setup 404 fingerprinting
	elsif($inp[$inp_p]=~/^fingerprint[ \t]+\.([a-zA-Z0-9]*)[ \t]+(skip|exit)/i){
		$D{"XXFP$1"}=$2;
		verbose("- Fingerprinting .$1; Action $2");
                if($D{'XXFPQueue'} eq ""){ $D{'XXFPQueue'}=$1;} else
                        { $D{'XXFPQueue'}.="\t$1";}}
} 

############################################################################

verbose("- Loaded script database of $inp_c lines");

if (defined($args{n})){
# read in nmap on generate the list of hosts to scan
open(NMAP, "<$nmapfile"); #yes, this is scary.  Don't worry about it.
while(<NMAP>){ %udp=%tcp=(), $udp=$tcp=0, $Index=$OS=$IP=$Name=$Host="";
(($$3{$1}=$2) && $$3++) while(m#([0-9]+)/([a-z]+)/(udp|tcp)/\w*/\w*///[,]*#g);
$$1=$2 while(m#([^ \t\n:]+):\W*([^\t\n]+)#g);
(($Smurf=$1) && next) if (m#Status: Smurf\W*\(\W*([0-9]+)#);
($Host=~m#([\w\.]+)\W*\(([^ \t]*)\)#) && (($IP=$1) && ($Name=$2));

if($tcp{80} eq "open"){ push @hosts_to_scan, $IP;}
} # end the while(<nmap>) loop
close(NMAP);
} #end if defined $args{n}

$hostcount=@hosts_to_scan;
if($hostcount < 1){ wprint("= No hosts found to scan!\n\n"); exit;}
debugprint("Checking $hostcount hosts");
undef $hostcount;

%Dbackup=%D; 	# this way we can restore before every host

foreach $host_to_check (@hosts_to_scan){
next if $host_to_check=~/^[\r\n]*$/;
%D=%Dbackup;	# rest everything leftover from the last script
$D{'XXSStr'}	=$args{S};	#return server software string (kludge)
$D{'XXRet'}	="";		#http return code of page
$D{'XXRetStr'}	="";		#http return string
$D{'XXSVer'}	="";		#http version return from server
$D{'XXinet_aton'} ="";		#cached inet_aton result

# shove the stuff into the global DATAS for use by the scripts
$D{'IP'}=$host_to_check;
$custom404="";
$D{'XXTarget'}=$host_to_check;

wprint("\n= - = - = - = - = - =\n");
wprint("= Host: $D{'XXTarget'}"); 
$vhosts ? wprint(" (virtual host)\n") : wprint("\n") ;

%checked=();
$D{'XXDirQuite'}=$D{'XXInitial'}=1;	# keeps it from printing output
&checkpage("/"); 	# need to initially check the roots
$D{'XXInitial'}=0;	# this is needed to set stuff up
%dirs=();
%redirects=(); 

if($D{'XXServerInject'} ne "exit"){

wprint("= $D{'XXSStr'}"); # print the server string
defined $args{N} ? &netcraft : print "\n";

@fpexts=split(/\t/, $D{'XXFPQueue'});
foreach $fpext (@fpexts){ fingerprint($fpext);}}

#code to parse the DB
for($inp_p=0;$inp_p<=$inp_c;$inp_p++){
 $l=$inp[$inp_p];
 $l=~ s/[\r\n]//g;        # no newline stuff
 $l=~s/^[ \t]*//;         # eat leading whitespace
 next if($l=~/^\#/);      # comment
 next if($l=~/^\}/);      # end of conditional '}' (depreciated)
 next if($l=~/^end/i); 	  # end of syntax conditional
 next if($l=~/^insert/i); # should have been parsed out
 next if($l=~/^fingerprint/i); # skip it anyway
 next if($l eq "");       # next if there's nothing left over
 $inline=$l;

 # we can 'slip' a commandline in to process
 if($D{'XXServerInject'} ne ""){
	$inp_p--; # roll back the pointer to redo the same command
	$inline=$D{'XXServerInject'}; # process our command 
	$D{'XXServerInject'}="";} # reset it so we don't loop endlessly

 debugprint("Parsing: $inp_p - $inline"); 

############################################################################
# These are the commands of whisker

# define data
if($inline=~/^set[ \t]+/i){ $inline=~/^set[ \t]+([^ \t]+)[ \t]*=[ \t]*([^\n]+)/;
	$tempsave2=$2; $tempsave1=$1;
	if($2=~/^\$([^ \t]+)/){ $D{$tempsave1}=$D{$1};
	} else { $data=$tempsave2; $data=~s/[ \t]//g;
		$D{$tempsave1}=$data;}
	undef $tempsave1; undef $tempsave2;
	next;}

# start a group definition
elsif($inline=~/^startgroup/i){
	$D{'XXGroup'}=1; next;}

# evaluate a group
elsif($inline=~/^ifgroup/i){
	if($D{'XXGroup'} eq 0){
           while($inp[$inp_p]!~/^endifgroup/i){
		$inp_p++;}
	} next; }

# eval
elsif($inline=~/^eval/i){ 
	my $evalin="";
        while($inp[$inp_p]!~/^endeval/i){
		$evalin.=$inp[$inp_p++];}
	eval($evalin); undef $evalin;
	next;}	

# exit this scan for this host
elsif($inline=~/^exit/i){ $inp_p=$inp_c+1; next;}

# exit the whole program
elsif($inline=~/^exitall/i){ exit;} # perl will clean up after us. :)

# print more info
elsif($inline=~/^info[ \t]+([^\n]+)/i){
	wprint ("- $1\n") if ($D{'XXInfo'}==1 && $D{'XXRet'}==200); next;}

# execute block if they want info
elsif($inline=~/^ifinfo/i){
	if($D{'XXInfo'}==0){ while($inp[$inp_p]!~/^endinfo/){
			$inp_p++; } } next;}

# print something (no prepended '-'/'='/'+')
elsif($inline=~/^print[ \t]+([^\n]+)/i){ wprint("$1\n");  next;}

# print a variable (no prepended '-'/'='/'+')
elsif($inline=~/^printvarb[ \t]+([^\n]+)/i){ wprint("$D{$1}\n");  next;}

# switch, save, and restore request methods
elsif($inline=~/^usehead/i){
	$D{'XXSaveMeth'}=$D{'XXMeth'}; $D{'XXMeth'}="HEAD"; next;}

elsif($inline=~/^useget/i){
	$D{'XXSaveMeth'}=$D{'XXMeth'}; $D{'XXMeth'}="GET"; next;}

elsif($inline=~/^usepost/i){
	$D{'XXSaveMeth'}=$D{'XXMeth'}; $D{'XXMeth'}="POST"; next;}

elsif($inline=~/^savemeth/i){$D{'XXSaveMeth'}=$D{'XXMeth'}; next;}

elsif($inline=~/^restoremeth/i){if($D{'XXSaveMeth'} ne ""){
		$D{'XXMeth'}=$D{'XXSaveMeth'};} next;}

# array handling
elsif($inline=~/^array[ \t]+/i){
	$inline=~/^array[ \t]+([\w]+)[ \t]*=[ \t]*([^\n]+)/i;
        my @parts2=split(/,/,$2);
        my $aname="D$1"; @$aname=();
        foreach $part (@parts2){
                if($part=~/\@([^ \t]+)/i){
                        $trans="D$1"; push @$aname, @$trans;}
                else { push @$aname, $part;}}
        $D{$aname}="--array--"; next;}

# server string regex
elsif($inline=~/^server[ \t]*\(([^\)]+)\)/i){
        if(!(($D{'XXForce'} && $D{'XXForceS'}) || $D{'XXSStr'}=~m/$1/i)){
        	while($inp[$inp_p]!~/^endserver/){
			$inp_p++; } } next;}

# check to see if last page existed
elsif($inline=~/^ifexist/i){
	if($D{'XXRet'} ne "200"){
        	while($inp[$inp_p]!~/^endexist/){
				$inp_p++; } } next; }

# conditional parsing - exact compare if numbers, regex otherwise
# this is redundant, but I've had lots of issues getting this to work. :/
if($inline=~/^if[ \t]+([^ \t]+)[ \t]*(\=\=|\!\=)[ \t]*([^\@]+)/i){
   my $skip=0, $b1=$1; $b2=$2; $b3=$3;
   if($b2 eq "!="){ if($b3=~/^[0-9]+$/){
        $skip=1 if ($D{$b1} eq $b3);
        } else { $skip=1 if ($D{$b1}=~/$b3/i); }}
   if($b2 eq "=="){ if($b3=~/^[0-9]+$/){
        $skip=1 if ($D{$b1} ne $b3);
        } else { $skip=1 if ($D{$b1}!~/$b3/i); }}
   if($skip==1){
        while($inp[$inp_p]!~/^endif/){
                $inp_p++; }} next;}

# scanning...this is sloppy, unconverted code at the moment...needs cleaning
elsif($inline=~/^scan[ \t]*\(([^\)]*)\)[ \t]*([^>]*)>>[ \t]*([^ \t]+)/i){
	$Z1=$1; $Z2=$2; $Z3=$3;
	$D{'XXRet'}=0; # this is needed to keep funky things from trickling

	# ok, there can be more periods...this is a kludge
	@fileparts=split(/\./,$Z3);
	debugprint("$fileparts[1] : ".$D{"XXFP$fileparts[1]"});
	if($D{"XXFP$fileparts[1]"} eq "exit"){
	  $D{'XXServerInject'}="exit";
	  wprint("= Fingerprint triggered exit");}
	next if($D{"XXFP$fileparts[1]"} ne "");

  	if($D{'XXForce'} || $Z1 eq "" || $D{'XXSStr'}=~m/$Z1/i ){
	        @d1=split(/,/,$Z2);  	
		@tocheck=@ind=();	
	        foreach $dd (@d1){
		        @t1=@t2=(); 
			push(@t1,"/");
	         	@ind=split(/\//, $dd); 
			$indc=@ind;
	        	for($xc=0;$xc<$indc;$xc++){
	        		foreach $tt (@t1){
					$tt=~s/[ \t]//g;
                			if($ind[$xc]=~/\@([\w_]+)/){ 
						$arrayname="D$1";
            					$ind[$xc]=~s/[ \t]//g;
		     				foreach $tz (@$arrayname){ 
							$tz=~s/[ \t]//g;
							$D{'XXDirQuite'}=1;
							&checkpage("$tt$tz/");
							$dirs{"$tt$tz/"}=$D{'XXRet'} if($dirs{"$tt$tz/"} eq "");
							push(@t2, "$tt$tz/") if($dirs{"$tt$tz/"} eq "200" || $dirs{"$tt$tz/"} eq "403");
						}
			                } else {  
						$ind[$xc]=~s/[ \t]//g; $whatpage="$tt$ind[$xc]/";
						$D{'XXDirQuite'}=1;
						&checkpage($whatpage);
						$dirs{$whatpage}=$D{'XXRet'} if($dirs{$whatpage} eq "");
						push(@t2, "$tt$ind[$xc]/") if ($dirs{$whatpage} eq "200" || $dirs{$whatpage} eq "403");
					}
        	  		} 
				@t1=(@t2); 
				@t2=();
	         	} 
			push(@tocheck,@t1);
		}
		foreach $out (@tocheck){
			$whatpage="$out$Z3";
			$D{'XXDirQuite'}=0;
			$D{'XXTrackGroup'}=1;
			&checkpage($whatpage);
			$D{'XXTrackGroup'}=0;	

			# bad method compensation
			if($D{'XXRet'} eq "400" || $D{'XXRet'} eq "500"){
				if($D{'XXBadMeth'} > 0){	
					my $oldmethod=$D{'XXMeth'};
					if($oldmethod eq "HEAD"){
						$D{'XXMeth'}="GET";
					}else{
						$D{'XXMeth'}="HEAD";
					}
			 		undef $checked{$whatpage};
					&checkpage($whatpage); 
					$D{'XXMeth'}=$oldmethod;
				}
			} # end bmc
	
		} #still part of scan
	}} #still part of scan

############
# Best to add your commands here
# use a elsif{}, and including a next; would be more efficient


else { #unknown line
	wprint("- Warning: Syntax Error: $inline\n");

} # end the if/elsif/else which command loop

# end whisker command section
############################################################################

} # end the for loop

# 'moved' handling....still minimal
#foreach $key (keys %redirects){
#	next if ($key eq "");
#	verbose("- MOVED: $key <- $redirects{$key}\n");}

} # end the foreach $IP loop

wprint("\n");
close(LOG);
exit;  # we're all done!

sub checkpage {  # this is the logic to actually get and parse the page info
	my ($whatpage)=@_; $whatpage=~s/[\/]{2,3}/\//g;
	$D{'XXPageSrc'}=$D{'XXHeaders'}=""; # reset these for later
	if($checked{$whatpage} ne ""){  # if we've already scanned that page
		$D{'XXRet'}=$checked{$whatpage}; 
		if($D{'XXRet'} ne "200"){$D{'XXGroup'}=0 if($D{'XXTrackGroup'}==1);} # cached pages in group
		$D{'XXCache'}=1;  # in case we want to know this page was already scanned
		return;}

	$D{'XXCache'}=0;  # nope, not already scanned
	my $pagew="$D{'XXRoot'}$whatpage";
	$pagew=~s/[\/]{2,3}/\//g;
	$D{'XXPageW'}=$pagew;

	$sendpagew=$pagew;
	if($D{'XXIDS'} eq "1"){
		$sendpagew=~s/([-a-zA-Z0-9.])/sprintf("%%%x",ord($1))/ge;}

        if(defined($args{E})){
                $sendpagew=~s/\//\/.\//g;}

	# setup proxy
	if($D{'XXProxy'} eq "1"){
		$pagew="http://".$D{'XXP_target'}.":$D{'XXProxy2port'}$pagew";}

	sendhttp($sendpagew, $D{'XXProxy'} ? $D{'XXP_target'} : $D{'XXTarget'});

	my @results=@DXX;
	$D{'XXTarget'}=$D{'XXP_target'} if($D{'XXProxy'} eq "1");
	if($D{'XXDead'}==1){ $D{'XXServerInject'}="exit"; return;}

	@XXXres=grep {/^Server\:/} @results;
	if($XXXres[0] eq "" && $D{'XXForce'}==0 && $D{'XXInitial'}==1){
		wprint("- ERROR: We have issues--server didn't return\n");
		wprint("-        a Server: string...this will break logic!\n");
		wprint("-        You need to use 'dumb.db' or similar, or\n");
		wprint("-        override with XXForce=1 in your script\n\n");
		$D{'XXServerInject'}="exit"; return;} # force to next host
	if($D{'XXSStr'} ne ""){  #detect a change
		if($D{'XXSStr'} ne $XXXres[0]){
			# unfortunately, IIS does not send Server: on errors
			# debugprint("Warning: Server software changed to: $XXXres[0]\n");
		}} else { $D{'XXSStr'}=$XXXres[0] if($XXXres[0] ne "");}

	$results[0]=~s/[\r\n]//g;
	$results[0]=~m#HTTP\/([0-9\.]+) ([0-9]+) ([^\n]*)#;	
	$D{'XXRet'}=$2; 	# return code
	$D{'XXSVer'}=$1;	# server HTTP version
	$D{'XXRetStr'}=$3;	# return code string
	return if ($D{'XXQuickFallOut'}==1);
	debugprint("Page returned HTTP code: $D{'XXRet'}");

	&sortresults(@results);

	$checked{$whatpage}=$D{'XXRet'}; # keep track that we got
	$rcode="$D{'XXRet'} $D{'XXRetStr'}";

	# moved page handling
	if($D{'XXRet'} eq "302"){
		@locs=grep {/^Location\:/} @results;
		$locs[0]=~s/^Location: //;
		$redirects{$locs[0]}.="$pagew ";}		

	if($D{'XXRet'} eq "200"){
		wprint("+ $rcode: $D{'XXMeth'} $pagew\n") unless($D{'XXDirQuite'} >0);
	} else {$D{'XXGroup'}=0 if ($D{'XXTrackGroup'}==1); # group collection failed 
		verbose("+ $rcode: $D{'XXMeth'} $pagew");}
	return; }# kinda assumed, but oh well


sub sendhttp { # this also handles the vhost send
	my ($pstr, $tstr)=@_; my $hoststr; # hoststr must be outside scope
	if ($vhosts eq 1){ # if it's not an IP, send it as a vhost
		if($tstr !~ /[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+/){
       	        $hoststr="Host: $tstr\n"}}
	$hoststr.="Connection: close\n";
	if ($D{'XXMeth'} eq "POST"){
	   $hoststr.="Content-Length: ".length($D{'XXPostData'})."\n\n";
	   $hoststr.=$D{'XXPostData'}."\n" if ($D{'XXPostData'} ne "");}

	sendraw("$D{'XXMeth'} $pstr $D{'XXVer'}\n$hoststr\n");
	return;}

sub debugprint {
	my ($line)=@_;
	return if($D{"XXDebug"}<1);
	$line=~s/\n/\[\\n\]/g; # kill newlines
	$line=~s/\t/\[\\t\]/g; # kill tabs
	print STDERR  "[debug $$] $line\n";}

sub verbose { 
	my ($line)=@_;
	return if($D{'XXVerbose'}<1);
	$line=~s/[\n\r]//g; # kill dumb stuff
	$line=~s/\t/\ /g; # kill tabs
	wprint("$line\n");}

sub wprint { # notice no auto \n like verbose() and debugprint()
	my ($line)=@_;
	if($LOGGING){ print LOG $line;
	} else { print STDOUT $line;}}	

sub sortresults {  # do various header processing here....
	my (@in)=@_;
	my @rfp, $tl;

	$zzsrc=0; # suck up resulting headers and page return
	foreach $result (@in){
		 if($zzsrc eq 0){ $D{'XXHeaders'}.=$result;
		 } else { $D{'XXPageSrc'}.=$result; }
		 $zzsrc=1 if ($result=~/^[\r]*\n$/);}

	# Some servers (IIS) leak internal IP info with Content-Location
	@rfp=grep(/Content-Location/,@in);
	$tl=$rfp[0];
	if($tl!~/$D{'XXTarget'}/){
	if ($D{'XXCLLeak'} eq "" && $tl ne ""){
		$D{'XXCLLeak'}="$tl";
		wprint("- $tl\n") if $D{'XXInfo'}==1;}}

	# get the content-length
	@rfp=grep(/^Content-[lL]ength/,@in);
	if($rfp[0]=~/^[\r\n]*$/){ $D{'XXCLen'}="";} else {
	 $rfp[0]=~/([0-9]+)/;
	 $D{'XXCLen'}=$1;}

	# get the authentication header, if there
	@rfp=grep(/^WWW-Authenticate/,@in);
	 $rfp[0]=s/[\r\n]//g;
	 $D{'XXAuth'}=$rfp[0]; # could be "", which is fine
	 $D{'XXGAuth'}=$rfp[0] if ($rfp[0] ne "");
	wprint("- Authenticate: $D{'XXAuth'}\n") 
		if ($rfp[0] ne "" && $D{'XXInfo'}==1);

	# figure out if it's a directory index...
	# this is based on an observed anomaly
	if($D{'XXRet'}==200 && $D{'XXCLen'}=="" && $D{'XXDirQuite'}){
		$D{'XXIsIndex'}=1;
	wprint("- Directory index: $D{'XXPageW'}\n") if $D{'XXInfo'}==1;}
}

sub netcraft {
	my $osresult, $line, $save, $save2, $save3, $page2;

	# save the original stuff
	$save=$D{'XXTarget'};
	$save2=$D{'XXMeth'};
	$save3=$D{'XXinet_aton'};

	# change it to suit us
	$D{'XXTarget'}="www.netcraft.com";
	$D{'XXMeth'}="GET";
	$D{'XXinet_aton'}="";

	$page2="/whats/\?host=$save\n";

	# setup proxy
	if($D{'XXProxy'} eq "1"){ 
	$D{'XXP_target'}=$D{'XXTarget'};
	$D{'XXTarget'}=$D{'XXProxy_addy'};
	$page2="http://".$D{'XXP_target'}.":$D{'XXProxy2port'}$page2";}

	sendhttp($page2, $D{'XXProxy'} ? $D{'XXP_target'} : $D{'XXTarget'});

	# restore everything
	$D{'XXTarget'}=$save;
	$D{'XXMeth'}=$save2;
	$D{'XXinet_aton'}=$save3;

	foreach $line (@DXX){
if($line=~/\<A HREF="\/os\/accuracy.html"\>\<B\>(.*)\<\/B\>\<\/A\>/){
	$D{'XXNetcraft'}=$1;
	$D{'XXNetcraft'}=~s/<[^>]+>//g;
	print "= Netcraft OS: $D{'XXNetcraft'}\n\n";}
	}}


sub rstr { # no, this is not a cryptographically-robust number generator
	my $str,$c;
	for($c=0;$c<20;$c++){ 
	$str .= chr(((rand() * 26) % 26) + 97);} # yes, we only use a-z
	return $str;}

sub fingerprint { # this name is actually not descriptive--it should
	my ($ext)=@_;     # be something like '404extcheck'
	$D{'XXQuickFallOut'}=1;
	checkpage("/".&rstr.".$ext");
	$D{'XXQuickFallOut'}=0;
	debugprint("Fingerprint response is $D{'XXRet'}");
	if($D{'XXRet'}==200){ return 1; }
	$D{"XXFP$ext"}="";
	return 0;}

sub sendraw {
        my ($pstr)=@_;
        $PROTO=getprotobyname('tcp')||0;
        debugprint("Sending raw: $pstr");

        # setup proxy
        if($D{'XXProxy'} eq "1"){
                $D{'XXP_target'}=$D{'XXTarget'};
                $D{'XXTarget'}=$D{'XXProxy_addy'};}

        # find and cache the inet_aton result
        if($D{'XXinet_aton'} eq ""){
        if(!($D{'XXinet_aton'}=inet_aton($D{'XXTarget'}))){
                wprint("= DNS lookup failure.\n");
                $D{'XXDead'}=1; return;}}

	# quick kludge to get this workable for windows people :)
	if($ENV{'OS'}=~/Win/i){ sendraw_win($pstr);} 
		else { sendraw_unix($pstr);}}

sub sendraw_unix {
	my ($pstr)=@_;
	eval {  alarm(30); $D{'XXDead'}=1;
	if(!(socket(S,PF_INET,SOCK_STREAM,$PROTO))){ 
		wprint("= Socket problems\n"); return;}
        if(connect(S,sockaddr_in($D{'XXPort'},$D{'XXinet_aton'}))){
		select(S); 	$|=1;
		print $pstr; 	@DXX=<S>; 
		select(STDOUT); close(S); 
		alarm(0); 	$D{'XXDead'}=0; return;
	} else { wprint("= Not responding...\n");} alarm(0);};
	if ($@) { if ($@ =~ /timeout/){wprint("= Timed out!\n");}}}

sub sendraw_win {
       my ($pstr)=@_;
       $D{'XXDead'}=1;
       if(!(socket(S,PF_INET,SOCK_STREAM,$PROTO))){
               wprint("= Socket problems\n"); return;}
       if(connect(S,sockaddr_in($D{'XXPort'},$D{'XXinet_aton'}))){
               select(S);      $|=1;
               print $pstr;    @DXX=<S>;
               select(STDOUT); close(S);
               $D{'XXDead'}=0; return;
       } else { wprint("= Not responding...\n");}}


