#!/usr/bin/perl
require 5.004; # sorry, just 5.003 has issues...

$whisker_version="1.4.0";
$WHEREIS_WHISKER=$0;
$WHEREIS_WHISKER=~s|\w+/[^\/\\]+$|share/whisker/|;
$GLOBAL_HTMLOUTPUT=0;

use Socket; use Getopt::Std;

if(defined $ENV{'GATEWAY_INTERFACE'}&&defined $ENV{'REQUEST_METHOD'}){
 $GLOBAL_CGIALLOWED='hVpSivM'; # for security
 $GLOBAL_HTMLOUTPUT=1; # force HTML output
 if($ENV{'REQUEST_METHOD'} eq "POST"){
 read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 } else { $buffer=$ENV{'QUERY_STRING'};}
 @pairs = split(/&/, $buffer);
 foreach $pair (@pairs) {
   ($name, $value) = split(/=/, $pair);
   $value =~ tr/+/ /;
   $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
   $name =~ tr/+/ /;
   $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
   $args{$name} = $value if($GLOBAL_CGIALLOWED=~/$name/);}
   print "Content-type: text/html\n\n";
   if($args{h} eq ''){print <DATA>; exit;} # display HTML form
} else {
 getopts("fs:n:vdh:l:H:Vu:iI:A:S:EF:p:M:UL:a:W", \%args);}

# 31336++ way of getting around non-standard modules
eval "require MIME::Base64"; # MIME::Base64 is faster
if($@){ *b64enc = \&perl_encode_base64; } else 
 { *b64enc = \&MIME::Base64::encode_base64;}

eval "require LWP::Parallel; require HTTP::Request;"; # Parallel stuff
if($@){ $GLOBAL_PARALLEL=0; *http_brute_auth=\&http_brute_auth_def;} else 
 { $GLOBAL_PARALLEL=1; *http_brute_auth=\&http_brute_auth_pua;}

$GLOBAL_WHISKER_LOOP_CONTROL=1;
$GLOBAL_WHISKER_NOMORE_DUMB=0;
if(defined $args{W}){$GLOBAL_HTMLOUTPUT++;}

$LOGGING=0;  $vhosts=0;
$vhosts = defined $args{V}||0;

# proxy support has been REMOVED until v2.0

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

if($GLOBAL_HTMLOUTPUT>0){ print <<EOT
<html><title>whisker v$whisker_version scan output</title>
<body bgcolor="#ffffff" text="#000000" link="#000000" vlink="#000000">
<center><table cellpadding=2 cellspacing=0>
EOT
;}


if (!defined $args{F}){
wprint("-- whisker / v$whisker_version / rain forest puppy / www.wiretrip.net --");}

wprint("-( Bonus: Parallel support )") if $GLOBAL_PARALLEL;

if((!defined $args{n} && !defined $args{h}) && !defined $args{H}){
if($GLOBAL_HTMLOUTPUT>0){print <<EOT
	<tr><td><font face=arial><h2>= Error in submitted form
	parameters; usage:</h2></font></td></tr>
	<tr><td><font face=arial><pre>
EOT
;}

print qq~
	-n+ *nmap output (machine format, v2.06+)
	-h+ *scan single host (IP or domain)
	-H+ *host list to scan (file)
	-F+ *(for unix multi-threaded front end use only)
	-s+  specifies the script database file (defaults to scan.db)
	-V   use virtual hosts when possible
	-p+  specify a different default port to use
	-S+  force server version (e.g. -S "Apache/1.3.6")
	-u+  user input; pass XXUser to script
	-i   more info (exploit information and such)
	-v   verbose.  Print more information
	-d   debug. Print extra crud++ (to STDERR)
	-W   HTML/web output
	-l+  log to file instead of stdout
	-a+  authorization username[:password]
	-P+  password file for -L and -U

	-I 1 IDS-evasive mode 1 (URL encoding)
	-I 2 IDS-evasive mode 2 (/./ directory insertion)
	-I 3 IDS-evasive mode 3 (premature URL ending)
	-I 4 IDS-evasive mode 4 (long URL)
	-I 5 IDS-evasive mode 5 (fake parameter)
	-I 6 IDS-evasive mode 6 (TAB separation) (not NT/IIS)
	-I 7 IDS-evasive mode 7 (case sensitivity)
	-I 8 IDS-evasive mode 8 (Windows \ delimiter)
	-I 9 IDS-evasive mode 9 (session splicing) (slow)
	-I 0 IDS-evasive mode 0 (NULL method)

	-M 1 use HEAD method (default)
	-M 2 use GET method
	-M 3 use GET method w/ byte-range
	-M 4 use GET method w/ socket close
	
	-A 1 alternate db format: Voideye exp.dat
	-A 2 alternate db format: cgichk*.r (in rebol)
	-A 3 alternate db format: cgichk.c/messala.c (not cgiexp.c)

-- Utility options (changes whisker behavior):

	-U   brute force user names via directories
	-L+  brute force login name/password
	     (parameter is URL; use with -a for username)

 	+ requires parameter;  * one must exist;

	(Note: proxy/bounce support has been removed until v2.0)

~; 
if($GLOBAL_HTMLOUTPUT>0){print '</pre></td></tr></table></body></html>';}
exit;}

$dbfile=$args{s}||"scan.db";

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

# better than goto's. ;)
while($GLOBAL_WHISKER_LOOP_CONTROL > 0){
$GLOBAL_WHISKER_LOOP_CONTROL=0;

if(!(-e $dbfile)){
 if (-e $WHEREIS_WHISKER.$dbfile){
	$dbfile=$WHEREIS_WHISKER.$dbfile;} else { 
 wprint("! Scan database not found."); exit;}}

if(defined $args{A}){ # alternate database format
	&load_alternate($dbfile,$args{A}); $dbfile="temp$$.db";}

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

if(defined $args{L}){
	if(!defined $args{a}){ wprint("! You need to specify a user with -a!"); exit;}
	if($args{a}=~/^(.*):/){$args{a}=$1;}
	wprint("- Brute forcing authentication for user '$args{a}' on url:\n- $args{L}\n");
	$D{'XXAuthPasswordFile'}=$args{P}||'lists/pass.txt';}

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

if(defined($args{a}) && $args{a}=~/^[^:]+:.+$/){
	$D{'XXAuth'}=$args{a};}

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

if ($singlehost ne "" && $Fsinglehost eq ""){ 
	push @hosts_to_scan, $singlehost;}

if ($Fsinglehost ne ""){ push @hosts_to_scan, $args{F};}

#control datas...so we can change these in the script, if needed
$D{'XXPort'}	=$args{p}||80;  #port to scan...80 for normal webservers
$D{'XXRoot'}	="";         	#default prefix for URLs...
$D{'XXMeth'}	="HEAD";     	#this is now smashed by the -M option
$D{'XXVer'}	="HTTP/1.0";  	#http version for us to use
$D{'XXHTTPDelim'}=" ";		#delimiter for HTTP request
$D{'XXDebug'}	=defined $args{d}||0;	#do we want debug output
$D{'XXVerbose'}	=defined $args{v}||0;	#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{'XXIDSModes'}="";		#what IDS options we want
$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
$D{'XXInited'}  =0;             #has runinitial been called?
$D{'XXReferer'}	=1;		#send referer with each request
$D{'XXGiveCookie'}=1;		#give back any cookies
$D{'XXRescanDumb'}=0;		#do we need to rescan using dumb.db?
$D{'XXNoContent'}=0;		#stop after the headers, even on GET
$D{'XXTimeoutVal'}=20;		#timeout value per check, in seconds
$D{'XXIDSMode4Limit'}=100;	#approx. limit * 15 = IDS mode 5 length
$D{'XXSessSplice'}=0;		#whether to perform session splicing
$D{'XXIDSMode9Wait'}=".10";	#timing for session slicing
$D{'XXIntHeaders'}="";		#internal headers; don't mess with :)
$D{'XXMethExtra'}="";		#extra method stuff
$D{'XXC200'}	=200;		#custom HTTP 200 (ok) code
$D{'XXC302'}	=302;		#custom HTTP 302 (moved) code
$D{'XXC403'}	=403;		#custom HTTP 403 (forbidden) code
$D{'XXC404'}	=404;		#custom HTTP 404 (not found) code

$D{'XXBruteUserDir'}=defined $args{U}||0; #do we want to brute user dirs

$D{'XXWhiskerVersionMajor'}=1; #these will be more important in v2.0
$D{'XXWhiskerVersionMinor'}=4;
$D{'XXRescanUCtoLC'}=1;

$D{'XXUserAgent'} = "Mozilla/5.0 [en] (Win95; U)";
$D{'XXForce'}=1 if defined($args{f});

if(defined($args{M})){ # eventually will have POST and some others
	$D{'XXMOption'}=$args{M};
	if($args{M} eq 1){$D{'XXMeth'}="HEAD";} # normal head
	elsif($args{M} eq 2){$D{'XXMeth'}="GET";} # normal get
	elsif($args{M} eq 3){$D{'XXMeth'}="GET";  # get w/ range limits
		$D{'XXIntHeaders'}="Range: bytes=0-1\n";}
	elsif($args{M} eq 4){$D{'XXMeth'}="GET";  # get that closes socket
		$D{'XXNoContent'}=1;}	
	else{wprint("! Unknown -M method"); exit;}}
$D{'XXDMeth'}=$D{'XXMeth'}; # in case method gets clobbered

if(defined($args{I})){
	wprint("- Using IDS spoofing mode(s) $args{I}");
	$D{'XXIDS'}=1; $D{'XXIDSModes'}=$args{I};
	if($D{'XXIDSModes'}=~/0/){$D{'XXMethExtra'}.='%00';}
	if($D{'XXIDSModes'}=~/6/){$D{'XXHTTPDelim'}="\t";}
	if($D{'XXIDSModes'}=~/9/){$D{'XXSessSplice'}=1;}
	}

$D{'XXUser'}=$args{u};
$D{'XXInfo'}=defined $args{i}||0;
select(STDERR); $| = 1; select(STDOUT); $| = 1;
$SIG{ALRM} = sub {die "timeout"};

if (defined($args{n}) && !defined($args{F})){
open(NMAP, "<$nmapfile"); #yes, this is scary.  Don't worry about it.
while(<NMAP>){ %udp=%tcp=(), $udp=$tcp=0, $Index=$OS=$IP=$Name=$Host="";
next if(m/^#/); # <-- this is new, and required of newer nmaps
(($$3{$1}=$2) && $$3++) while(m#([0-9]+)/([a-z]+)/(udp|tcp)/.*/.*/.*/.*/[,]*#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{$D{'XXPort'}} eq 'open'){ push @hosts_to_scan, $IP;
	$hosts_info{$IP}=$_;} # save the nmap info for later use
} # 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"); exit;}
debugprint("Checking $hostcount hosts");
undef $hostcount;

# prep for loading database
@inp=(); $inp_p=$inp_r=$inp_c="";
&load_database($dbfile);

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

foreach $host_to_check (@hosts_to_scan){
next if $host_to_check=~/^[\r\n \t]*$/;
%D=%Dbackup;	# reset 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;
&load_nmap_varbs; # load nmap info, if available (v1.3)

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

%checked=(); %dirs=(); %redirects=();

if(defined $args{U}){ $D{'XXAuthPasswordFile'}=$args{P}||'lists/userlist.txt';
	wprint(''); &http_brute_user_dir; wprint(''); exit; }

if(defined $args{L}){ wprint(''); &http_brute_auth($args{L},$args{a},
	$D{'XXAuthPasswordFile'}); wprint(''); exit;}

#code to parse the DB
for($inp_p=0;$inp_p<=$inp_c;$inp_p++){
 $l=$inp[$inp_p];
 $l=~tr/\r\n//d;          # no newline stuff
 $l=~s/^[ \t]*//;         # eat leading whitespace
 $l=~s/[ \t]*$//;         # eat trailing 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;

 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; added .= in v1.3
if($inline=~/^set\s+/i){ $inline=~/^set\s+\${0,1}(\S+)\s*([.]{0,1})=\s*(.+)/;
	@b=($1,$2,$3,'');
	if($b[1]=~/^\$([^ \t]+)/){ $b[3]=$D{$b[0]};
	} else { $b[3]=decstr($b[2]);}
	if($b[1] eq '.'){$D{$b[0]}.=$b[3];}
	else { $D{$b[0]}=$b[3];}
	undef @b; 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\s+(.+)/i){
	wprint ("- ".decstr($1)) if ($D{'XXInfo'}>0 && $D{'XXRet'}==$D{'XXC200'}); 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\s+(.+)/i){wprint(decstr($1));  next;}

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

# brute force user dir (v1.4)
elsif($inline=~/^bruteuserdir/){&http_brute_user_dir; 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;}


# v1.4; preferred way to set methods (allows mixed-case methods)
elsif($inline=~/^usemeth\s+(.+)/i){
	$D{'XXSaveMeth'}=$D{'XXMeth'}; $D{'XXMeth'}=$1; next;}

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

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

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

# array handling
elsif($inline=~/^array\s+/i){
	$inline=~/^array\s+([\w]+)\s*=\s*(.+)/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, decstr($part);}}
        $D{$aname}='--array--'; undef @parts2; next;}

# server string regex
elsif($inline=~/^server\s*\(([^\)]+)\)/i){
        if($D{'XXInited'}==0){wprint("= Not initialized yet!"); next;}
	$chk=$1; $chk=$D{$1} if ($chk=~/^\$([a-zA-Z0-9]+)/);
        if(!(($D{'XXForce'} && $D{'XXForceS'}) || $D{'XXSStr'}=~m/$chk/i)){
        	while($inp[$inp_p]!~/^endserver/){
			$inp_p++; } } next;}

# check to see if last page existed
elsif($inline=~/^ifexist/i){
	if($D{'XXRet'} ne $D{'XXC200'}){
        	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\s+\${0,1}(\S+)\s*(\=\=|\!\=)\s*(.+)/i){
   my @b=($1,$2,$3,0);
   if($b[1] eq "!="){ if($b[2]=~/^[0-9]+$/){
        $b[3]=1 if ($D{$b[0]} eq $b[2]);
        } else { $b[3]=1 if ($D{$b[0]}=~/$b[2]/i); }}
   if($b[1] eq "=="){ if($b[2]=~/^[0-9]+$/){
        $b[3]=1 if ($D{$b[0]} ne $b[2]);
        } else { $b[3]=1 if ($D{$b[0]}!~/$b[2]/i); }}
   if($b[3]==1){
        while($inp[$inp_p]!~/^endif/){
                $inp_p++; }} undef @b; next;}

# scanning...this is sloppy, unconverted code at the moment...needs cleaning
# Update: clean code exists in v2.0; however, will not port to v1.x
elsif($inline=~/^scan\s*\(([^\)]*)\)\s*([^>]*)>>\s*(.+)/i){
        if($D{'XXInited'}==0){wprint("= Not initialized yet!"); next;}
	$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 "");

	$chk=$Z1; $chk=$D{$1} if ($chk=~/^\$([a-zA-Z0-9]+)/);
  	if($D{'XXForce'} || $Z1 eq "" || $D{'XXSStr'}=~m/$chk/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=~tr/ \t//d;
                			if($ind[$xc]=~/\@([\w_]+)/){ 
						$arrayname="D$1";
            					$ind[$xc]=~tr/ \t//d;
		     				foreach $tz (@$arrayname){ 
							$tz=~tr/ \t//d;
							$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 $D{'XXC200'} 
								|| $dirs{"$tt$tz/"} eq $D{'XXC403'});
						}
			                } else {  
						$ind[$xc]=~tr/ \t//d; $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 $D{'XXC200'} 
							|| $dirs{$whatpage} eq $D{'XXC403'});
					}
        	  		} 
				@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=~/GET/){
						$D{'XXMeth'}="POST";}
					else {$D{'XXMeth'}="GET";}
			 		undef $checked{$whatpage};
					&checkpage($whatpage); 
					$D{'XXMeth'}=$oldmethod;
				}
			} # end bmc
	
		} #still part of scan
	}} #still part of scan

# checks for nmap information
elsif($inline=~/^ifnmapinfo/i){
	if($D{'XXHaveNmap'} ne 1){
           while($inp[$inp_p]!~/^endnmapinfo/i){
		$inp_p++;}
	} next; }

elsif($inline=~/^pingport\s+(\d+)/i){
	port_ping($1); next;}

# v1.4; clear an array or variable
elsif($inline=~/^clear\s+([\$\@])([a-z0-9_]+)/i){
	if($1 eq '$' && $2!~/^XX/){ delete $D{$2};} else {
		$T='D'.$2; undef @$T; delete $D{$T}; undef $T;}
	next;}

# v1.4; push value onto end of array
elsif($inline=~/^push\s+\@{0,1}(\S+)\s+(\S+)/i){
	$T='D'.$1; push @$T, $2; $D{$T}='--array--'; undef $T; next;}

elsif($inline=~/^clearpagecache/i){
	%checked=%dirs=%redirects=();}

elsif($inline=~/^runinitial/i){

	$D{'XXInitial'}=1;

        $D{'XXDirQuite'}=$D{'XXInited'}=1;
        &checkpage("/");
        $D{'XXInitial'}=0;
	
	if($D{'XXAuth'} ne ""){
		wprint("- Server demands authorization.");
		wprint("- We don't have a login, so skipping host...\n");
		$D{'XXServerInject'}="exit";}

        if($D{'XXServerInject'} ne "exit"){
                wprint("= $D{'XXSStr'}"); # print the server string
                @fpexts=split(/\t/, $D{'XXFPQueue'});
                foreach $fpext (@fpexts){ fingerprint($fpext);}}}

############
# 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");

} # 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("");


# this will cause whisker to rescan the 'dumb' servers

if($D{'XXRescanDumb'}>0 && $GLOBAL_WHISKER_NOMORE_DUMB < 1){
$GLOBAL_WHISKER_LOOP_CONTROL=1;
$nmapfile=$singlehost="";
$hostsfile="dumb$$.lst"; # we made a list of dumb servers
$dbfile="dumb.db";
$D{'XXRescanDumb'}=0; $GLOBAL_WHISKER_NOMORE_DUMB=1;}

} # this is the $GLOBAL_WHISKER_LOOP_CONTROL while() loop
close(LOG);

if (-e "dumb$$.lst"){ unlink("dumb$$.lst");}
if (-e "temp$$.db"){  unlink("temp$$.db") ;}
if (-e "prox$$.txt"){ unlink("prox$$.txt");}

if($D{'XXBruteUserDir'} >0){ &http_brute_user_dir; }

if($GLOBAL_HTMLOUTPUT>0){ print <<EOT
</table><p><font face=arial size=1>
whisker v$whisker_version by <a href="mailto:rfp\@wiretrip.net">rfp\@wiretrip.net</a><br>
<a href="http://www.wiretrip.net/rfp/">http://www.wiretrip.net/rfp/</a><p>
</body></html>
EOT
;}

exit;  # we're all done!



sub checkpage {  # this is the logic to actually get and parse the page info
	my ($whatpage)=@_; $whatpage=~s/[\/]{2,}/\//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 $D{'XXC200'}){$D{'XXGroup'}=0;} # 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;
	$pagew=~s/[\/]{2,3}/\//g;
	$pagew="$D{'XXRoot'}$whatpage";
	$D{'XXPageW'}=$pagew;

	$sendpagew=$pagew;

##############################################################
# anti-IDS handling

	# order *is* important, to allow for multiple selections
	if($D{'XXIDS'} > 0){ # IDS obfuscation
	 if($D{'XXIDSModes'}=~/7/){ # windows case sensitivity
	 	$sendpagew=uc($sendpagew);} # uppercase everything at the moment
	 if($D{'XXIDSModes'}=~/1/){ # encode the URI
		$sendpagew=~s/([-a-zA-Z0-9.])/sprintf("%%%x",ord($1))/ge;}
	 if($D{'XXIDSModes'}=~/2/){ # /./ insertion
                $sendpagew=~s/\//\/.\//g;} # replace / with /./
	 if($D{'XXIDSModes'}=~/4/){ # long random URL
		for(1..$D{'XXIDSMode4Limit'}){$build.=&rstr;}
		$sendpagew="/$build/..$sendpagew"; undef $build;}
	 if($D{'XXIDSModes'}=~/8/){ # Windows \ delimiter
	 	$sendpagew=~s/\//\\/g; # convert / to \
	 	$sendpagew=~s/^\\/\//; # first one needs to be /
	 	$sendpagew=~s/\\$/\//;} # last one needs to be /
	 if($D{'XXIDSModes'}=~/5/){ # fake parameter
	 	$sendpagew='/index.html%3f'.&rstr.'=/..'.$sendpagew;}
	 if($D{'XXIDSModes'}=~/3/){ # premature URL ending w/ randomness
		$sendpagew='/%20HTTP/1.0%0D%0A%0D%0AAccept%3A%20'.&rstr.
			'/../..'.$sendpagew;}
	 # this is so the script can change it/turn it on
	 if($D{'XXIDSModes'}=~/6/){$D{'XXHTTPDelim'}="\t";}
	}

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

	sendhttp($sendpagew, $D{'XXTarget'});
	my @results=@DXX;

	if($D{'XXDead'}==1){ $D{'XXServerInject'}="exit"; return;}

	$results[0]=~tr/\r\n//d;
	if($results[0]!~m#HTTP\/([0-9\.]+)\s+(\d+)\s*(.*)#){
		$D{'XXRet'}=$D{'XXC404'};
		$D{'XXRetStr'}='(Error: no server response)';} else {
	$D{'XXRet'}=$2; 	# return code
	$D{'XXSVer'}=$1;	# server HTTP version
	$D{'XXRetStr'}=$3;}	# return code string

	if ($D{'XXRet'} eq $D{'XXC200'} && $D{'XXSave200'} > 0){
		$D{'DSave200'}='--array--';
		push @DSave200, $whatpage;}

	if ($D{'XXRet'} eq $D{'XXC403'} && $D{'XXSave403'} > 0){
		$D{'DSave403'}='--array--';
		push @DSave403, $whatpage;}

	return if ($D{'XXQuickFallOut'}==1);
	debugprint("Page returned HTTP code: $D{'XXRet'}");

	&sortresults(@results);

	@XXXres=grep {/^Server\:/} @results;
	if(($XXXres[0] eq '' || $XXXres[0]=~/^Server:\s*[\r\n]+/) 
		&& $D{'XXForce'}==0 && $D{'XXInitial'}==1){

	if(!&guess_server){
	if($D{'XXProxyAgent'} eq ''){
		wprint("- Did not return a Server: string; going to automatically rescan");
		wprint("- with dumb.db\n");
		$D{'XXRescanDumb'}=1;
		open(OUT,">>dumb$$.lst"); # save this for rescanning
		print OUT "$D{'IP'}\n"; close(OUT);
	} else {
		wprint("- This is only a proxy, not a server.  Skipping...\n");}
		$D{'XXServerInject'}="exit"; return;}}

	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 '');}


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

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

	if($D{'XXRet'} eq $D{'XXC200'}){
		wprint('') if ($D{'XXInfo'} > 0); # make things look all 'perty'
		wprint("+ $rcode: $D{'XXMeth'} $pagew") unless($D{'XXDirQuite'} >0);
	} else {$D{'XXGroup'}=0; # 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 !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/){
       	        $hoststr="Host: $tstr\n"}}

        if ($D{'XXUserAgent'} ne ''){
           $hoststr.="User-Agent: $D{'XXUserAgent'}\n";}
	if ($D{'XXCookie'} ne '' && $D{'XXGiveCookie'} == 1){
	   $hoststr.="Cookie: $D{'XXCookie'}\n";}
        if($D{'XXReferer'} > 0){
           $hoststr.="Referer: http://"."$D{'XXTarget'}/\n";}

	# auth handling - v1.4
	if($D{'XXAuth'} ne '' && $D{'XXEncAuth'} eq ''){
	   $D{'XXEncAuth'}=b64enc($D{'XXAuth'});}
	if($D{'XXEncAuth'} ne ''){
	   $hoststr.='Authorization: Basic '.$D{'XXEncAuth'}."\n";}

	$hoststr.="Connection: close\n";
	$hoststr.=$D{'XXIntHeaders'};

	if ($D{'XXMeth'} eq "POST"){ # needs to be last
	   $hoststr.='Content-Length: '.length($D{'XXPostData'})."\n\n";
	   $hoststr.=$D{'XXPostData'}."\n" if ($D{'XXPostData'} ne '');}

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

sub debugprint {
	my ($line)=@_;
	return if($D{'XXDebug'}<1);
	$line=~s/\n/\[\\n\]/g; # kill newlines
	$line=~s/\r/\[\\r\]/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=~tr/\n\r//d; # kill dumb stuff
	$line=~tr/\t/ /; # kill tabs
	wprint("$line");}

{$BG='#cccccc';
sub wprint {
	my $line=shift;
	if($GLOBAL_HTMLOUTPUT>0){
		return if($line eq '');
		$line=~s/\\$//;
		$hline="<tr><td bgcolor=";

if($line=~/^-[^\-]/){
 $hline.="$BG><font face=arial size=2><i>$line</i>";}
elsif($line=~/^\n= - =/){
 $hline.='#000000><font size=1>&nbsp;';}
elsif($line=~/^=/){$hline.="$BG><font face=arial size=3><b>$line</b>";}
elsif($line=~/^--/){$hline.="#ffffff><font face=arial size=4><b>$line</b>";}
elsif($line=~/^\+ 200/){$line=~s# (/.+)$# <a href="http://$D{'XXTarget'}$1">$1</a>#;
 $hline.="$BG><font face=arial color=#009900 size=2>$line";}
elsif($line=~/^!/){$hline.="$BG><font face=arial color=#990000 size=3>$line";}
else{$hline.="$BG><font face=arial size=2>$line";}
		$hline.='</font></td></tr>';
		if($BG eq '#cccccc'){$BG='#ffffff';}
			else{$BG='#cccccc';}
		$line=$hline; undef $hline;}

	if(!($line=~s/\\$//)){$line.="\n";}
	if($LOGGING){ print LOG $line;
	} else { print STDOUT $line;}}}

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

	if($D{'XXMOption'}==3 && $D{'XXRet'}==206){
		$D{'XXRet'}=$D{'XXC200'}; # compensate for Range:
		$D{'XXRetStr'}="OK";} 

	$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$/);}

	# Compensate for Cold Fusion on IIS
	if($D{'XXPageW'}=~/\.cfm$/ && defined $D{'XXPageSrc'}){
	if($D{'XXPageSrc'}=~m#</TD></TD></TD></TH></TH></TH># &&
	$D{'XXPageSrc'}=~m#<B><H3>HTTP/1.0 404 Object Not Found</B></H3>#){
		$D{'XXRet'}=$D{'XXC404'}; $D{'XXRetStr'}='Not Found (CF)';}}


	# Tackle .idc on IIS - new in v1.4
	if($D{'XXPageW'}=~/\.idc$/ && defined $D{'XXPageSrc'}){
	if($D{'XXPageSrc'}=~m#<body><h1>Error Performing Query</h1>#){
	 if($D{'XXPageSrc'}=~m#</h1>The query file <b>(.+)</b> could not#){
		if(($f=$1)=~/^[a-z]:/i){ 
		 wprint("- Physical path: $f\n") if($D{'XXInfo'}>0);}
		$D{'XXRet'}=$D{'XXC404'};
		$D{'XXRetStr'}='Not found (IDC)';} # doesn't really exist
	 if($D{'XXPageSrc'}=~m#</h1><UL><LI>\[State=#){
		$D{'XXRet'}=$D{'XXC200'};
		$D{'XXRetStr'}='OK (IDC error)';}}}

	# Tackle .ida/.idq on IIS - new in v1.4
	if($D{'XXPageW'}=~/\.id[aq]$/ && defined $D{'XXPageSrc'}){
	 if($D{'XXPageSrc'}=~m#<TITLE><%CIRESTRICTION%> - error.</TITLE>#){
	  if($D{'XXPageSrc'}=~m#Error "The IDQ file (.+) could not be found.#){
		if(($f=$1)=~/^[a-z]:/i){ 
		 wprint("- Physical path: $f\n") if($D{'XXInfo'}>0);}
		$D{'XXRet'}=$D{'XXC404'};
		$D{'XXRetStr'}='Not found (IDA/IDQ)';}}}

	# Tackle .htw on IIS - new in v1.4
	if($D{'XXPageW'}=~/\.htw$/ && defined $D{'XXPageSrc'}){
	 if($D{'XXPageSrc'}=~m#<p><h3><center>The format of QUERY_STRING is invalid.<BR></center></h3>#){
		$D{'XXRet'}=$D{'XXC404'};
		$D{'XXRetStr'}='Not found (HTW)';}}

	# Tackle .dll on IIS - new in v1.4
	if($D{'XXPageW'}=~/\.dll$/ && defined $D{'XXPageSrc'}){
	 if($D{'XXPageSrc'}=~m#<title>Error</title></head><body>The specified module could not be found.#){
		$D{'XXRet'}=$D{'XXC404'};
		$D{'XXRetStr'}='Not found (DLL)';}}

	# 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") if $D{'XXInfo'}>0;}}

	# 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 proxy-agent
	@rfp=grep(/^Proxy-[aA]gent/,@in);
	if($rfp[0]!~/^[\r\n]*$/){ 
		wprint("= $rfp[0]");
		$D{'XXProxyAgent'}=$rfp[0];}

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

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

	# only support for the first cookie given right now
	@rfp=grep(/^Set-Cookie/,@in);
	if($rfp[0] ne ""){
	 $rfp[0]=~s/^Set-Cookie: //;
	 $rfp[0]=~tr/\r\n//d;
	 $D{'XXCookie'}="$rfp[0]";
	 verbose("- Cookie: $rfp[0]\n");}
}


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

sub fingerprint { # this is going to be phased out
	my ($ext)=@_; 
	$D{'XXQuickFallOut'}=1;
	checkpage("/".&rstr.".$ext");
	$D{'XXQuickFallOut'}=0;
	debugprint("Fingerprint response is $D{'XXRet'}");
	if($D{'XXRet'}==$D{'XXC200'}){ return 1; }
	$D{"XXFP$ext"}="";
	return 0;}

sub sendraw {
        my ($pstr)=@_;
        $PROTO=getprotobyname('tcp')||0; @DXX=();

	$pstr=~s/\n/\r\n/g; $pstr=~s/\r\r/\r/g;
        debugprint("Sending raw: $pstr");

        if($D{'XXinet_aton'} eq ''){
        if(!($D{'XXinet_aton'}=inet_aton($D{'XXTarget'}))){
                wprint("! DNS lookup failure.");
                $D{'XXDead'}=1; return;}}

	if($^O=~/win/i){ sendraw_win($pstr);} 
		else {  sendraw_unix($pstr);}
	}

sub sendraw_unix {
	my ($pstr)=@_;
	$D{'XXHaveHeaders'}=0;
	eval {  alarm($D{'XXTimeoutVal'}); $D{'XXDead'}=1;
	if(!(socket(S,PF_INET,SOCK_STREAM,$PROTO))){ 
		wprint("= Socket problems"); return;}
	if($D{'XXSessSplice'}>0){ # session splicing
	  setsockopt(S,SOL_SOCKET,SO_SNDLOWAT,1);
	  @chars=split(//,$pstr);}
        if(connect(S,sockaddr_in($D{'XXPort'},$D{'XXinet_aton'}))){
		select(S); 	$|=1;
	if($D{'XXSessSplice'}>0){foreach $char (@chars){print $char; 
	select(undef,undef,undef,$D{'XXIDSMode9Wait'});}
	}else{print $pstr;}
		while(<S>){ $line=$_; push(@DXX,$line);
			if ($line=~/^[\r\n]+$/){ # we can continue
				$D{'XXHaveHeaders'}=1; $D{'XXDead'}=0;}
			last if ($line=~/^[\r\n]+$/ && $D{'XXNoContent'} > 0);}
		select(STDOUT); close(S); 
		alarm(0); 	$D{'XXDead'}=0; return;
	} else { wprint("= Not responding...");} alarm(0);};
	if ($@) { if ($@ =~ /timeout/){wprint("= Timed out\\");
	$D{'XXDead'}==1?wprint(". Aborting."):wprint(", but continuing.");}}}

sub sendraw_win {
       	my ($pstr)=@_;
       	$D{'XXDead'}=1;
       	if(!(socket(S,PF_INET,SOCK_STREAM,$PROTO))){
               wprint("= Socket problems"); return;}
	if($D{'XXSessSplice'}>0){ # session splicing
	  setsockopt(S,SOL_SOCKET,SO_SNDLOWAT,1);
	  @chars=split(//,$pstr);}
       	if(connect(S,sockaddr_in($D{'XXPort'},$D{'XXinet_aton'}))){
               select(S);      $|=1;
	if($D{'XXSessSplice'}>0){foreach $char (@chars){print $char; 
	select(undef,undef,undef,$D{'XXIDSMode9Wait'});}
	}else{print $pstr;}
		while(<S>){ $line=$_; push(@DXX,$line);
			last if ($line=~/^[\r\n]+$/ && $D{'XXNoContent'} > 0);}
               select(STDOUT); close(S);
               $D{'XXDead'}=0; return;
       } else { wprint("! Not responding...");}}


sub port_ping {  # this should be platform-safe
	my ($port)=@_;

	if($D{'XXHaveNmap'}){ # use nmap to determine open ports
		if($D{'XXNmapTCP'}=~/ $port /){ $D{'XXRet'}=$D{'XXC200'};
		} else { $D{'XXRet'}=$D{'XXC404'};} return;}

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

	if(!(socket(S,PF_INET,SOCK_STREAM,$PROTO))){
		wprint("! Socket problems"); return;}
	if(connect(S,sockaddr_in($port,$D{'XXinet_aton'}))){
		close(S);
		$D{'XXRet'}=$D{'XXC200'};
	} else {
		$D{'XXRet'}=$D{'XXC404'};}}
 

sub array_shuffle { # fisher yates shuffle....w00p!
	my $array=shift; my $i;
	for ($i = @$array; --$i;){
		my $j = int rand ($i+1);
		next if $i==$j;
		@$array[$i,$j]=@$array[$j,$i];
}} # end array_shuffle, from Perl Cookbook (rock!)


sub load_database { # organize the code a little better
my $infile=shift;
open(INP,"<$infile") || die("Can't open scan database $infile\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

$has_runinitial=0; # for delaying scan to set script varbs

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 (\S+)/){
		if(-e $1){      open(IIN,"<$1");
		@in=<IIN>; 	close(IIN);}
		elsif (-e "$WHEREIS_WHISKER$1"){
		open(IIN,"<$WHEREIS_WHISKER$1");
		@in=<IIN>; 	close(IIN);}
		splice(@inp,$inp_p,1,@in);
		undef @in; $inp_c=@inp;} 

	# expand multi-file scans (v1.3)
	elsif($inp[$inp_p]=~/^scan\s*\(([^\)]*)\)\s*([^>]*)>>\s*(.+)/i){
		my @f=(0,$1,$2,$3);
		if($f[3]=~/,/){ # multiple files listed
		@files=split(/,/,$f[3]); my @temp=();
		foreach $file (@files){
			$file=~tr/ \t//d; $inp_c++;
			push @temp,"scan ($f[1]) $f[2] >> $file";}
		splice(@inp,$inp_p,1,@temp); undef @temp; undef @f;}}

	# 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";}}

        # check for runinitial
        elsif($inp[$inp_p]=~/^runinitial/i){
                $has_runinitial++;}
} 

if ($has_runinitial==0) { # for backwards compatibility
        $inp_c = unshift @inp, "runinitial";}
undef $has_runinitial;

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

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

sub load_nmap_varbs { # v1.3
$D{'XXNmapOS'}=$D{'XXNmapTCP'}=$D{'XXNmapUDP'}=$D{'XXHaveNmap'}='';
	if(defined $hosts_info{$D{'IP'}}){
	$D{'XXHaveNmap'}=1;
	$info=$hosts_info{$D{'IP'}};
	%udp=%tcp=(), $udp=$tcp=0, $Index=$OS=$IP="";
(($$3{$1}=$2) && $$3++) while($info=~m#([0-9]+)/([a-z]+)/(udp|tcp)/.*/.*/.*/.*/[,]*#g);
$$1=$2 while($info=~m#([^ \t\n:]+):\W*([^\t\n]+)#g);
	$D{'XXNmapOS'}=$OS;	
	foreach $port (keys %tcp){
		$D{'XXNmapTCP'}.=" $port " if ($tcp{$port} eq "open");}
	foreach $port (keys %udp){
		$D{'XXNmapUDP'}.=" $port " if ($udp{$port} eq "open");}}
} # end sub

sub decstr { # simple string variable/formatting v1.3
my $strin=shift;
$strin=~s/\\n/\n/g;
$strin=~s/\\r/\r/g;
$strin=~s/\\t/\t/g;
while($strin=~/\$([a-zA-Z0-9]+)/){
        $val=$D{$1};
        $strin=~s/\$$1/$val/e;}
return $strin;}

sub guess_server { # hardcoded logic to guess the server v1.3
# roxen gives out RoxenUserID cookies
if($D{'XXCookie'}=~/^roxen/i){
	$D{'XXSStr'}="GUESS: Roxen"; return 1;}
# what does nmap have to say? These are common, and annoying
if($D{'XXNmapOS'}=~/cisco/i){
	$D{'XXSStr'}="GUESS: Cisco appliance"; return 1;}
if($D{'XXNmapOS'}=~/printer/i){
	$D{'XXSStr'}="GUESS: Printer appliance"; return 1;}
# oh well, switch to dumb.db
return 0;}


sub load_alternate { # load alternate databases
my ($file,$type)=@_;
my @temp, @temp2, @out, $a1, $a2, $a3;
open(IN,"<$file");

if($type==1){ # voideye exp.dat files
 while(<IN>){ $line=$_;
   @temp2=split(/;/, $line);
   push @temp, $temp2[0];}}

elsif($type==2){ # cgichk.r rebol script
 while(<IN>){ $line=$_;
   if($line=~/\[\s*site\s*"([^ "]+)\s*"\s*]/){
        push @temp, $1;}}}

elsif($type==3){ # common .c format (cgichk.c, messala.c, etc)
 while(<IN>){ $line=$_;
  if($line=~/"GET ([^ ]+) HTTP\/1.[01][\\rn]+"/){
                        push @temp, $1;}}}
close(IN);
foreach $a1 (@temp){
   $a1=~/([^\/]+)$/; $a2=$1;
   $a1=~s/[^\/]+$//; $a1=~s/cgi-bin/\@roots/;
   $a1=~s/^\///; $a1=~s/\/$//;
   $a1="/" if ($a1=~/^[ ]*$/);
   $a1=~s/expelval/expeval/; # fix everyone's mistake
   push @out, "scan () $a1 >> $a2\n";}

my $count = @out;
if ($count < 1){
wprint("! Alternate database converted to 0 scan lines."); exit;}
open(OUT,">temp$$.db");
print OUT "array roots = cgi-bin,cgis,cgi-local,htbins,scripts\n";
foreach $a1 (@out){ print OUT $a1;}
close(OUT);} # end sub


sub http_brute_user_dir { # new to v1.4
	open(IN,"<$D{'XXAuthPasswordFile'}")||
	 wprint("! Can't open $D{'XXAuthPasswordFile'}! (run listgen.pl)")
		&& return;
	$D{'DUsers'}='--array--';
	while(<IN>){
		$UD=$_;
		$UD=~tr/\r\n //d;
		next if ($UD eq '');
		checkpage("/~$UD/",$D{'XXTarget'});

		# construct 'Users' array
		if($D{'XXRet'}==$D{'XXC200'} || $D{'XXRet'}==$D{'XXC403'}){
			push(@DUsers,"/~$UD/");}
		# compensate for non-verbose printing of 403's
		if($D{'XXRet'}==$D{'XXC403'} && $D{'XXVerbose'}==0){
			wprint("+ $D{'XXC403'} Forbidden: $D{'XXMeth'} /~$UD/");}
	}
	close(IN);
	$D{'XXBruteUserDir'}=0; # keep from running multiple times
}

sub perl_encode_base64 ($:$) { # ripped from MIME::Base64
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;
    while ($_[0] =~ /(.{1,45})/gs) {
        $res .= substr(pack('u', $1), 1);
        chop($res);}
    $res =~ tr|` -_|AA-Za-z0-9+/|;
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    if (length $eol) {
        $res =~ s/(.{1,76})/$1$eol/g;
    } $res; }


sub perl_decode_base64 ($) { # ripped from MIME::Base64
    my $str = shift;
    my $res = "";
    $str =~ tr|A-Za-z0-9+=/||cd;
    $str =~ s/=+$//;                        # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
    while ($str =~ /(.{1,60})/gs) {
        my $len = chr(32 + length($1)*3/4); # compute length byte
        $res .= unpack("u", $len . $1 );    # uudecode
    }$res;}


sub http_brute_auth_def { # slow, synchronous
 my ($url, $user, $pfile, @R)=@_;
 if(!open(IN,"<$pfile")){die("$pfile password file was not found!");}
 ($url="http://$D{'XXTarget'}/$url")=~s#([^:])/{2,}#$1/#g;
 while(<IN>){
        ($t=$_)=~tr/\r\n//d; next if($t eq '');
        $t=$user.':'.$t; $x++;
        $t=b64enc($t,'');
	$D{'XXEncAuth'}=$t;
	sendhttp($url,$D{'XXTarget'});
	$R=$DXX[0];
	if($R!~m#^HTTP/[0-9.]{3} 401#){
		wprint('= Valid auth combo \''.perl_decode_base64($t).'\' on following URL:');
		wprint("= $url");
		close(IN); return;}
 }close(IN);}


sub http_brute_auth_pua { # fast, asynchronous
 my ($t, $x, $y, $url, $user, $pfile, @R)=('',0,0, @_);
 my $pua=LWP::Parallel::UserAgent->new();

 ($url="http://$D{'XXTarget'}/$url")=~s#([^:])/{2,}#$1/#g;
 if(!open(IN,"<$pfile")){die("$pfile password file was not found!");}
 for($y=0;$y<40;$y++){$R[$y]=HTTP::Request->new('GET',$url);}

 while(<IN>){
	($t=$_)=~tr/\r\n//d; next if($t eq '');
	$t=$user.':'.$t; $x++;
	$t=b64enc($t);

	if($x==0){
	 $pua->initialize();	$pua->in_order(0);
	 $pua->duplicates(0);	$pua->timeout(5);
	 $pua->redirect(0);	$pua->max_req(10);
	 $pua->agent("Whisker/1.4.0");}

	$R[$x]->header(Authorization => 'Basic '.$t);
	$pua->register($R[$x]);

	if($x==39){
	 my $entries = $pua->wait();
	 foreach (keys %$entries){
		my $res=$entries->{$_}->response;
		if($res->code != 401){
		 ($t=$res->request->header(Authorization))=~s/^Basic //;
		 wprint('= Valid auth combo \''.perl_decode_base64($t).'\' on following URL:');
		 wprint("= $url");
		 close(IN); return;}} $x=0;}}
 my $entries = $pua->wait();
 foreach (keys %$entries){
	my $res=$entries->{$_}->response;
	if($res->code != 401){
		($t=$res->request->header(Authorization))=~s/^Basic //;
		wprint('= Valid auth combo \''.perl_decode_base64($t).'\' on following URL:');
		wprint("= $url");}
} close(IN);}

__DATA__

<!-- this is the HTML form displayed when whisker is called -->

<html><title>whisker CGI scan form</title>
<body bgcolor="#ffffff" text="#000000" link="#000000" vlink="#000000">
<font face='arial' size=2><center>

<!-- you can use GET or POST as the method          -->
<form method="GET" action="whisker.cgi">

<!-- notice everything is named the same as the     -->
<!-- associated commandline option                  -->

<table border=0 cellspacing=0 cellpadding=2><tr><td align=right
colspan=2 bgcolor="#000000"><font face=arial size=4 color="#cccccc"><b>whisker CGI scan form</b>
</font></td></tr><tr><td><font face=arial size=2>
Target host to scan: </td><td><font size=2><input type=text name="h" size=40>
</td></tr><tr><td bgcolor="#cccccc"><font face=arial size=2>
Port to scan: </td><td bgcolor="#cccccc">
<font size=2><input type=text name="p" value="80" size=6>
</td></tr><tr><td colspan=2><font face=arial size=2>
<input type=checkbox name="V"> Use virtual hosts
</td></tr><tr><td colspan=2 bgcolor="#cccccc"><font face=arial size=2>
<input type=checkbox name="i"> Display supporting information
</td></tr><tr><td colspan=2><font face=arial size=2>
<input type=checkbox name="v"> Verbose results
</td></tr><tr><td colspan=2 bgcolor="#cccccc"><font face=arial size=2>
Request method: 
<input type=radio name="M" value="1" checked> Head
<input type=radio name="M" value="2"> Get
<input type=radio name="M" value="3"> Get w/ byte-range
<input type=radio name="M" value="4"> Get w/ socket close
</td></tr><tr><td colspan=2 align=center bgcolor="#000000"><font
face=arial size=2><input type=submit value="..run whisker..">
</td></tr></table><p><font face=arial size=1>
whisker by <a href="mailto:rfp@wiretrip.net">rfp@wiretrip.net</a><br>
<a href="http://www.wiretrip.net/rfp/">http://www.wiretrip.net/rfp/</a><p>
</form></body></html>

