#!/usr/bin/perl -w


#####################################################################################
# All information, data, source code, compiled binaries, information, documentation #
# contained within this document is the sole property of "WhiteHat Security, Inc"   #     
# and may not be sold, reused or distributed.                                       #
# Copyright 2002 WhiteHat Security, Inc.  ALL RIGHTS RESERVED                       #
#####################################################################################

use strict;
use LW;
require "./Subs.pm";



### Global Variables #################################################################
$| = 1;
my $Debug = 0;

my $useragent = "WhiteHat Arsenal 1.07 Beta"; # Default User-Agent
my %FORM;	# FORM Input Array


my %mData = ("SESSION_PATH" => "",	# Current Session. What session to log request in.
		"SESSION" => "",	# 
		"MODE" => "",		# 
		"SEARCH_STRING" => "",	# 
		"PATH" => "",		# 
		"MIMICK" => "",		# Browser Mimic. Mimic HTTP Request Headers of a common web browser
		"HTTP_FIX" => "",	# HTTP Fixup
		"HOST_FIX" => "",	# HTTP Fixup
	);


my %rData = ("HOST" => "",		# Host
		"PATH" => "",		# URI Path
		"PROTOCOL" => "",	# Protocol (HTTP|HTTPS)
		"PORT" => "",		# Port
		"METHOD" => "GET",	# HTTP Request Method
		"VERSION" => "1.1",	# HTTP Version
		"USERNAME" => "",	# WebAuth Username
		"PASSWORD" => "",	# WebAuth Password
		"HEADERS" => "",	# HTTP Request Headers
	);


# Browser Mimic HTTP Request Headers
my %mimickhdrs = ("Accept" => "text/xml, application/xml, application/xhtml+xml, text/html;q=0.9, image/png, image/jpeg, image/gif;q=0.2, text/plain;q=0.8, text/css, */*;q=0.1",
		"Accept-Language" => "en-us",
		"Accept-Charset" => "ISO-8859-1, utf-8;q=0.66, *;q=0.66",
		"Keep-Alive" => "300",
		"Connection" => "keep-alive",
);

	
my @req_headers = ();	# HTTP Request Headers


my $doc_root = $ENV{'DOCUMENT_ROOT'} || "/home/apache/htdocs";
my $session_dir = $doc_root . "/" . "wharsenal/sessions/";  #
my $conf_dir = $doc_root . "/" . "wharsenal/conf/";  #
my $results_file = "forcedbrowsing.html";
my $session_path = "";
my $dir_file = $conf_dir . "dirs.txt";
my $log_file = $conf_dir . "logs.txt";
my $backup_file = $conf_dir . "suffixes.txt";


### Page Properties ###
my $bgcolor = "#FFFFFF";			# Page BGCOLOR
my $link = "#0099FF";			# Page LINK COLOR
my $vlink = "#FF9933";			# Page VLINK COLOR

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

### MAIN ####################################################################
print "Content-Type: text/html\n\n";

RequestMethod();
sanityCheck();		# Sanity Check and Secure all input data



print "DOC ROOT: $doc_root<BR>\n" if ($Debug == 1);
print "SESSION DIR: $session_dir<BR>\n" if ($Debug == 1);
print "CONF DIR: $conf_dir<BR>\n" if ($Debug == 1);
print "RESULTS FILE: $results_file<BR>\n" if ($Debug == 1);
print "DIR FILE: $dir_file<BR>\n" if ($Debug == 1);
print "LOG FILE: $log_file<BR>\n" if ($Debug == 1);
print "BACKUP FILE: $backup_file<BR>\n" if ($Debug == 1);

# Set Results Path
my $results_path = $mData{'SESSION_PATH'} . "/" . $results_file;

print "RESULTS PATH: $results_path<BR>\n" if ($Debug == 1);

# Check if Results File Existe
if(!-e $results_path) { # If Results does not exists, print header HTML
	open(RES, ">$results_path") or die "Q: Cant open $results_path $!\n";
	print RES "<HTML><HEAD><TITLE>WhiteHat Arsenal 1.07 Beta Forced Browsing</TITLE></HEAD>\n\n";
	print RES "<BODY BGCOLOR=\"$bgcolor\" LINK=\"$link\" VLINK=\"$vlink\">\n";
	close(RES);
} # End Results File If

print "<HTML><HEAD><TITLE>WhiteHat Arsenal 1.07 Beta Forced Browsing</TITLE></HEAD>\n\n";
print "<BODY BGCOLOR=\"$bgcolor\" LINK=\"$link\" VLINK=\"$vlink\">\n";


scan();


close(RES);



	if ($Debug == 1) {
	print "<HR>\n";
		foreach my $i (keys %mData) {
			print "M: $i VALUE: $mData{$i}<BR>\n";
		}
	}
	
	
	if ($Debug == 1) {
	print "<HR>\n";
		foreach my $i (keys %rData) {
			print "R: $i VALUE: $rData{$i}<BR>\n";
		}
	}
	
	
############################################################################



sub scan { # Scan Target SubRoutine
	
	my @scans = ();
	open(RES, ">>$results_path") or die "S: Cant Open $results_path. $!<BR>\n";
	# Perform Mode Checks



	print "<TABLE BGCOLOR=\"#fdbe50\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\">\n";
	print "<TR><TD WIDTH=\"524\" ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";
	
	print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"1\">\n";
	print "<TR><TD BGCOLOR=\"#FFFFFF\" ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";

	print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
	print "<TR WIDTH=\"524\" BGCOLOR=\"#fdbe50\"><TD ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";

	if ($mData{'MODE'} eq "DIR") {
		print "<FONT FACE=\"Arial\"><B>Directory Force Browse</B></FONT>\n";
	} elsif ($mData{'MODE'} eq "LOG") {
		print "<FONT FACE=\"Arial\"><B>Log File Force Browse</B></FONT>\n";
	} elsif ($mData{'MODE'} eq "BACKUP") {
		print "<FONT FACE=\"Arial\"><B>Backup File Suffix Force Browse</B></FONT>\n";
	}
		
	print "</TD></TR>\n";




	print RES "<TABLE BGCOLOR=\"#fdbe50\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\">\n";
	print "<TR><TD WIDTH=\"524\" ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";
	
	print RES "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"1\">\n";
	print RES "<TR><TD BGCOLOR=\"#FFFFFF\" ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";

	print RES "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
	print RES "<TR WIDTH=\"524\" BGCOLOR=\"#fdbe50\"><TD ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";

	if ($mData{'MODE'} eq "DIR") {
		print RES "<FONT FACE=\"Arial\"><B>Directory Force Browse</B></FONT>\n";
	} elsif ($mData{'MODE'} eq "LOG") {
		print RES "<FONT FACE=\"Arial\"><B>Log File Force Browse</B></FONT>\n";
	} elsif ($mData{'MODE'} eq "BACKUP") {
		print RES "<FONT FACE=\"Arial\"><B>Backup File Suffix Force Browse</B></FONT>\n";
	}
		
	print RES "</TD></TR>\n";
	
	
	
	

  
	print "<TR BGCOLOR=\"#fef5c7\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
	
		
	print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\"><TR>\n";
	
			
	print "<TD WIDTH=\"250\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Host</B>: $rData{'HOST'}</font>\n";
	print "</TD>\n";
			
	print "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Port</B>: $rData{'PORT'}</font>\n";
	print "</TD>\n";
			
	print "<TD WIDTH=\"100\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Method</B>: $rData{'METHOD'}</font>\n";
	print "</TD>\n";
			
	print "<TD WIDTH=\"100\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Protocol</B>: $rData{'PROTOCOL'}</font>\n";
	print "</TD>\n";
	
			
	print "</TR></TABLE>\n";
	
			
	print "</TD></TR>\n";
	
		
		
	print RES "<TR BGCOLOR=\"#fef5c7\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
	
		
	print RES "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\"><TR>\n";
	
			
	print RES "<TD WIDTH=\"250\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Host</B>: $rData{'HOST'}</font>\n";
	print RES "</TD>\n";
			
	print RES "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Port</B>: $rData{'PORT'}</font>\n";
	print RES "</TD>\n";
			
	print RES "<TD WIDTH=\"100\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Method</B>: $rData{'METHOD'}</font>\n";
	print RES "</TD>\n";
			
	print RES "<TD WIDTH=\"100\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Protocol</B>: $rData{'PROTOCOL'}</font>\n";
	print RES "</TD>\n";
	
			
	print RES "</TR></TABLE>\n";
			
	print RES "</TD></TR>\n";
	
		
		
		
	print "<TR BGCOLOR=\"#fef5c7\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
	
	print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\"><TR>\n";
	
	print "<TD WIDTH=\"250\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Path</B></font>\n";
	print "</TD>\n";
			
	print "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Code</B></font>\n";
	print "</TD>\n";
			
	print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Search String:</B> $mData{'SEARCH_STRING'}</font>\n";
	print "</TD>\n";
		
			
	print "</TR></TABLE>\n";
	
	print "</TD></TR>\n";
	
	print "</TABLE>\n";
	
	print "</TD></TR></TABLE>\n";
	
	print "</TD></TR></TABLE>\n";
	
	
		
	print RES "<TR BGCOLOR=\"#fef5c7\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
	
	print RES "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\"><TR>\n";
	
	print RES "<TD WIDTH=\"250\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Path</B></font>\n";
	print RES "</TD>\n";
			
	print RES "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Code</B></font>\n";
	print RES "</TD>\n";
			
	print RES "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
	print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>Search String:</B> $mData{'SEARCH_STRING'}</font>\n";
	print RES "</TD>\n";
		
			
	print RES "</TR></TABLE>\n";
	
	print RES "</TD></TR>\n";
	
	print RES "</TABLE>\n";
	
	print RES "</TD></TR></TABLE>\n";
	
	print RES "</TD></TR></TABLE>\n";
	
	
	
	if($mData{'MODE'} eq "DIR") { # Directory Force
		open(DIRS, "$dir_file") or die "F: Cant open $dir_file. $!<BR>\n";
		@scans = <DIRS>;
		close(DIRS);

		foreach my $path (@scans) { # Scan Directories Loop	
		
			$path =~ s/\n//g;
			my $code = "";
			my $data = "";
			
			$path = "/" . $path unless ($path =~ /^(\/)/);
			
			print "PATH: $path<BR>\n" if ($Debug == 1);
			
			($code, $data) = httpRequest($path);
			
			
			
			print "<TABLE BGCOLOR=\"#FFFFFF\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\"><TR>\n";

			print "<TD WIDTH=\"260\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
			print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><A HREF=\"$rData{'PROTOCOL'}://$rData{'HOST'}:$rData{'PORT'}$path\">$path</A></font>\n";
			print "</TD>\n";
			
			print "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
		
			if ($code ne "404") {
				print "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"FF0000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>$code</B></font></A>\n";
			} else {
				print "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">$code</font></A>\n";
			}
			print "</TD>\n";
		
			if(($mData{'SEARCH_STRING'} ne "") && (defined $data)) {
				if($data =~ /$mData{'SEARCH_STRING'}/i) {
					print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Matched</font>\n";
					print "</TD>\n";
			
				} else {
					print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Not Matched</font>\n";
					print "</TD>\n";
			
				}
			} else {
				print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">No String</font>\n";
				print "</TD>\n";
			}	
			
			
			print "</TR></TABLE>\n";
			
			
			
			
			print RES "<TABLE BGCOLOR=\"#FFFFFF\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\"><TR>\n";

			print RES "<TD WIDTH=\"260\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
			print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><A HREF=\"$rData{'PROTOCOL'}://$rData{'HOST'}:$rData{'PORT'}$path\">$path</A></font>\n";
			print RES "</TD>\n";
			
			print RES "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
		
			if ($code ne "404") {
				print RES "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"FF0000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>$code</B></font></A>\n";
			} else {
				print RES "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">$code</font></A>\n";
			}
			print RES "</TD>\n";
		
			if(($mData{'SEARCH_STRING'} ne "") && (defined $data)) {
				if($data =~ /$mData{'SEARCH_STRING'}/i) {
					print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Matched</font>\n";
					print RES "</TD>\n";
			
				} else {
					print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Not Matched</font>\n";
					print RES "</TD>\n";
			
				}
			} else {
				print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">No String</font>\n";
				print RES "</TD>\n";
			}	
			
			
			print RES "</TR></TABLE>\n";
			
			
			
			
			
		} # End Foreach Scan Loop

	} # End Directory If



	if($mData{'MODE'} eq "LOG") { # 
		open(LOGS, "$log_file") or die "F: Cant open $log_file. $!<BR>\n";
		@scans = <LOGS>;
		close(LOGS);

		foreach my $path (@scans) { # 
		
			$path =~ s/\n//g;
			my $code = "";
			my $data = "";
			
			$path = "/" . $path unless ($path =~ /^(\/)/);
			
			print "PATH: $path<BR>\n" if ($Debug == 1);
			
			($code, $data) = httpRequest($path);
			
			
			
			print "<TABLE BGCOLOR=\"#FFFFFF\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\"><TR>\n";

			print "<TD WIDTH=\"260\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
			print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><A HREF=\"$rData{'PROTOCOL'}://$rData{'HOST'}:$rData{'PORT'}$path\">$path</A></font>\n";
			print "</TD>\n";
			
			print "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
		
			if ($code ne "404") {
				print "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"FF0000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>$code</B></font></A>\n";
			} else {
				print "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">$code</font></A>\n";
			}
			print "</TD>\n";
		
			if(($mData{'SEARCH_STRING'} ne "") && (defined $data)) {
				if($data =~ /$mData{'SEARCH_STRING'}/i) {
					print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Matched</font>\n";
					print "</TD>\n";
			
				} else {
					print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Not Matched</font>\n";
					print "</TD>\n";
			
				}
			} else {
				print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">No String</font>\n";
				print "</TD>\n";
			}	
			
			
			print "</TR></TABLE>\n";
			
			
			
			
			print RES "<TABLE BGCOLOR=\"#FFFFFF\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\"><TR>\n";

			print RES "<TD WIDTH=\"260\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
			print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><A HREF=\"$rData{'PROTOCOL'}://$rData{'HOST'}:$rData{'PORT'}$path\">$path</A></font>\n";
			print RES "</TD>\n";
			
			print RES "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
		
			if ($code ne "404") {
				print RES "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"FF0000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>$code</B></font></A>\n";
			} else {
				print RES "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">$code</font></A>\n";
			}
			print RES "</TD>\n";
		
			if(($mData{'SEARCH_STRING'} ne "") && (defined $data)) {
				if($data =~ /$mData{'SEARCH_STRING'}/i) {
					print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Matched</font>\n";
					print RES "</TD>\n";
			
				} else {
					print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Not Matched</font>\n";
					print RES "</TD>\n";
			
				}
			} else {
				print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">No String</font>\n";
				print RES "</TD>\n";
			}	
			
			
			print RES "</TR></TABLE>\n";
			
		} # End Foreach Scan Loop

	} # End Directory If





	if($mData{'MODE'} eq "BACKUP") { # 
		open(BACKUPS, "$backup_file") or die "F: Cant open $backup_file. $!<BR>\n";
		@scans = <BACKUPS>;
		close(BACKUPS);

		foreach my $apnd (@scans) { # 
		
			$apnd =~ s/\n//g;
			my $code = "";
			my $data = "";
			
			my $path = $mData{'PATH'} . $apnd;
			
			$path =~ s/\n//g;
			
			$path = "/" . $path unless ($path =~ /^(\/)/);
			
			print "BACKUP: $path<BR>\n" if ($Debug == 1);
			
			($code, $data) = httpRequest($path);
			
			
			
			print "<TABLE BGCOLOR=\"#FFFFFF\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\"><TR>\n";

			print "<TD WIDTH=\"260\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
			print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><A HREF=\"$rData{'PROTOCOL'}://$rData{'HOST'}:$rData{'PORT'}$path\">$path</A></font>\n";
			print "</TD>\n";
			
			print "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
		
			if ($code ne "404") {
				print "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"FF0000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>$code</B></font></A>\n";
			} else {
				print "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">$code</font></A>\n";
			}
			print "</TD>\n";
		
			if(($mData{'SEARCH_STRING'} ne "") && (defined $data)) {
				if($data =~ /$mData{'SEARCH_STRING'}/i) {
					print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Matched</font>\n";
					print "</TD>\n";
			
				} else {
					print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Not Matched</font>\n";
					print "</TD>\n";
			
				}
			} else {
				print "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				print "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">No String</font>\n";
				print "</TD>\n";
			}	
			
			
			print "</TR></TABLE>\n";
			
			
			print RES "<TABLE BGCOLOR=\"#FFFFFF\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\"><TR>\n";

			print RES "<TD WIDTH=\"260\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
			print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><A HREF=\"$rData{'PROTOCOL'}://$rData{'HOST'}:$rData{'PORT'}$path\">$path</A></font>\n";
			print RES "</TD>\n";
			
			print RES "<TD WIDTH=\"70\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
		
			if ($code ne "404") {
				print RES "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"FF0000\" style=\"font-size: 12px; font-family:arial,sans-serif\"><B>$code</B></font></A>\n";
			} else {
				print RES "<A HREF=\"/cgi-bin/wharsenalcgi/http_rc.pl?rc=$code\"><font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">$code</font></A>\n";
			}
			print RES "</TD>\n";
		
			if(($mData{'SEARCH_STRING'} ne "") && (defined $data)) {
				if($data =~ /$mData{'SEARCH_STRING'}/i) {
					print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Matched</font>\n";
					print RES "</TD>\n";
			
				} else {
					print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
					print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">Not Matched</font>\n";
					print RES "</TD>\n";
			
				}
			} else {
				print RES "<TD WIDTH=\"190\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				print RES "<font COLOR=\"000000\" style=\"font-size: 12px; font-family:arial,sans-serif\">No String</font>\n";
				print RES "</TD>\n";
			}	
			
			
			print RES "</TR></TABLE>\n";
		} # End Foreach Scan Loop

	} # End Directory If



	close(RES);
} # End SubRoutine




sub httpRequest { # HTTP Reqest
	my $uri = shift || "/";
	$uri =~ s/([\s])//g;			# Remove WhiteSpace from the path
	
	my (%hin, %hout, %jar);
	LW::http_init_request(\%hin);
	
	
	# Load in Connection Properties and Attributes
	$hin{'whisker'}->{'host'} = $rData{'HOST'};
	$hin{'whisker'}->{'uri'} = $uri;	
	$hin{'whisker'}->{'port'} = $rData{'PORT'};
	$hin{'whisker'}->{'method'} = $rData{'METHOD'};
	$hin{'whisker'}->{'http_ver'} = $rData{'VERSION'};
	$hin{'User-Agent'} = $useragent;
	$hin{'whisker'}->{'timeout'} = 15;
	

	if ($rData{'PROTOCOL'} eq "https") {
		$hin{'whisker'}->{'ssl'} = 1;
		$hin{'whisker'}->{'save_ssl_info'} = 1;
	}

	if (($rData{'USERNAME'} ne "") || ($rData{'PASSWORD'} ne "")) {
		LW::auth_set_header('basic', \%hin, $rData{'USERNAME'}, $rData{'PASSWORD'});
	}
	
	# If HTTP Request Headers Exist
	if (length @req_headers > 0) {
		
		foreach my $hdr (@req_headers) { # Loop thru HTTP Request Headers
			if ($hdr =~ /([^:]+)(:)([\s]+)(.+)/i) {
				my $hname = $1;
				my $hvalue = $4;
				$hname =~ s/(\r|\n)//g;
				$hvalue =~ s/(\r|\n)//g;
				
				print "H NAME: $hname<BR>\n" if ($Debug == 1);
				print "H VALUE: $hvalue<BR>\n" if ($Debug == 1);
				
				$hin{$hname} = $hvalue; # Set HTTP Request Header
				
			} # End Header Format if
		} # End Foreach
		
	} # End Load HTTP Request Headers If
	
	
	
	print "HOST: $hin{'whisker'}->{'host'}<BR>\n" if ($Debug == 1);
	print "URI: $hin{'whisker'}->{'uri'}<BR>\n" if ($Debug == 1);
	print "PORT: $hin{'whisker'}->{'port'}<BR>\n" if ($Debug == 1);
	print "METHOD: $hin{'whisker'}->{'method'}<BR>\n" if ($Debug == 1);
	print "VERSION: $hin{'whisker'}->{'http_ver'}<BR>\n" if ($Debug == 1);
	print "User Agent: $hin{'User-Agent'}<BR>\n" if ($Debug == 1);
	print "Username: $rData{'USERNAME'}<BR>\n" if ($Debug == 1);
	print "Password: $rData{'PASSWORD'}<BR>\n" if ($Debug == 1);
	
	
	# Check for HTTP Fixup Flag
	if ($mData{'HTTP_FIX'} eq "ON") { # Fix HTTP Request
		print "FIXING<BR>\n" if ($Debug == 1);
		LW::http_fixup_request(\%hin); # Fix HTTP Request
	} # End Fix HTTP Request
	
	
	# Check for Host Fixup Flag
	if ($mData{'HOST_FIX'} eq "ON") { # Fix Host Request
		print "FIXING Host<BR>\n" if ($Debug == 1);
		$hin{'Host'} = $rData{'HOST'}; # Set HTTP Request Header
	} # End Fix Host
	
	
	
	# Show Request Information. Debug Only
	if ($Debug == 1) {
		foreach my $key (keys %hin) {
			print "HIN: $key $hin{$key}<BR>\n";
		}
	}
	
	
	
	if(LW::http_do_request(\%hin,\%hout)){

        	print "ERROR: " . $hout{'whisker'}->{'error'} . "\n";
        	return $hout{'whisker'}->{'error'};

	} else {
		#print "CODE: " . $hout{'whisker'}->{'code'} . "<BR>\n";
        	return ($hout{'whisker'}->{'code'}, $hout{'whisker'}->{'data'});
	
	}

	&LW::http_reset;

} # End SubRoutine

####################
### Sanity Check ###
####################
# Sanity Check All input parameters
sub sanityCheck { # Process HTTP Request
	
	# Session Name Sanity Checks
	if (defined $FORM{'SESSION'}) { # Session Name Exists
	
		if (($FORM{'SESSION'} ne "NO SESSION") && ($FORM{'SESSION'} =~ /^([\w\d\s]{1,32})$/i)) { # Session Name Exists, but Valid?
	
			# Path to Current Session Directory
			$mData{'SESSION_PATH'} = $session_dir . $FORM{'SESSION'};
			
			# Session path test if Exists
			if (-e $mData{'SESSION_PATH'}) { # Session Dir Exists
				
				# check if session path is a directory
				if (-d $mData{'SESSION_PATH'}) { # Session path is a directory
					
					# check if session path is writable
					if (-w $mData{'SESSION_PATH'}) { # Session path is writable
						$mData{'SESSION'} = $FORM{'SESSION'};
					} else { # Session path not writable
						print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"30; URL=/cgi-bin/wharsenalcgi/session.pl\">\n";
						my $error_string = HTMLEsc("Session \"$FORM{'SESSION'}\" is not a writable by the web server. Please change the \"sessions\" directory permissions and all the the files within to the process owner and group of the web server. You may also choose or create another session. ");
						errorOut("$error_string <A HREF=\"/cgi-bin/wharsenalcgi/session.pl\">session</A>. <BR><I>Re-direct in 30 seconds.</I>");
	
					} # End Session Path is writable if
	

				} else { # Session path not a directory
					print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"4; URL=/cgi-bin/wharsenalcgi/session.pl\">\n";
					my $error_string = HTMLEsc("Session \"$FORM{'SESSION'}\" is not a directory. Please choose a another session. ");
					errorOut("$error_string <A HREF=\"/cgi-bin/wharsenalcgi/session.pl\">session</A>. <BR><I>Re-direct in 4 seconds.</I>");
	
				} # End Session Path Directory if
	

			} else { # Session path not exist
				print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"4; URL=/cgi-bin/wharsenalcgi/session.pl\">\n";
				my $error_string = HTMLEsc("Session \"$FORM{'SESSION'}\" doesnt not exist. Please choose a new session. ");
				errorOut("$error_string <A HREF=\"/cgi-bin/wharsenalcgi/session.pl\">session</A>. <BR><I>Re-direct in 4 seconds.</I>");
	
			} # End Session Path Exists if
	
		} else { # Session Name not valid
		
			my $error_string = HTMLEsc("Session Name \"$FORM{'SESSION'}\" is not valid. Please choose a valid session. ");
			
			print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"4; URL=/cgi-bin/wharsenalcgi/session.pl\">\n";
			errorOut("$error_string <A HREF=\"/cgi-bin/wharsenalcgi/session.pl\">session</A>. <BR><I>Re-direct in 4 seconds.</I>");
	
		} # End Session Name Sanity Check If
	
	} else { # No Session name given
		print "<META HTTP-EQUIV=\"refresh\" CONTENT=\"4; URL=/cgi-bin/wharsenalcgi/session.pl\">\n";
		errorOut("No session name given. Please set a new <A HREF=\"/cgi-bin/wharsenalcgi/session.pl\">session</A>. <BR><I>Re-direct in 4 seconds.</I>");
	}# End Session Name Sanity Checks
	
	
	
	# Check if URL is absoulute
	if ($FORM{'URL'} =~ /^(http)([s]?)(:\/\/)(.*)/) {
		print "URL " . $FORM{'URL'} . "<BR>\n" if ($Debug == 1);
		
		
		my @uri_parts = LW::utils_split_uri($FORM{'URL'});
		
		if ($Debug == 1) {
			foreach my $x (@uri_parts) {
				print "$x <BR>\n";
			}
		}
		
		
		
		$rData{'PATH'} =  substr($uri_parts[0], 0, 1024) || "/";
		$rData{'PROTOCOL'} = $uri_parts[1];
		
		# Sanity Check Hostname
		if(defined $uri_parts[2]) {
		
			# Sanity Check Hostname
			if($uri_parts[2] =~ /^([a-zA-Z0-9\.\-]{1,256})$/i) { # Hostname OK.
				$rData{'HOST'} = $uri_parts[2];	# Set Host
				print "R: REQUEST HOST: $rData{'HOST'}<BR>\n" if ($Debug == 1);
			} else { # Hostname Invalid
				my $error_string = HTMLEsc("Hostname \"$uri_parts[2]\" is not valid. Valid hostname or IP Address only.");
				errorOut($error_string);
			} # End Hostname Sanity Check if

		} else { # Hostname Invalid
			my $error_string = HTMLEsc("No hostname given. Please enter a valid hostname");
			errorOut($error_string);
		} # End Hostname Sanity Check if
		
		
		# Sanity Check Port
		if(defined $uri_parts[3]) { # Port
		
			# Sanity Check Port
			if ($uri_parts[3] =~ /^([\d]{1,5})$/) { # Port
				$rData{'PORT'} = $uri_parts[3];	# Set Port
				print "R: PORT: $rData{'PORT'}<BR>\n" if ($Debug == 1);
			} else { # No Valid Port Given. Default
			
				if ($rData{'PROTOCOL'} =~ /^http$/i) {
					$rData{'PORT'} = "80";	# Set Port
				} elsif ($rData{'PROTOCOL'} =~ /^https$/i) {
					$rData{'PORT'} = "443";	# Set Port
				} else {
					$rData{'PORT'} = "80";	# Set Port
				} # End Port Sanity Check if
			}
				
		} else { # No Valid Port Given. Default
			if ($rData{'PROTOCOL'} =~ /^http$/i) {
				$rData{'PORT'} = "80";	# Set Port
			} elsif ($rData{'PROTOCOL'} =~ /^https$/i) {
				$rData{'PORT'} = "443";	# Set Port
			} else {
				$rData{'PORT'} = "80";	# Set Port
			} # End Port Sanity Check
			
		} # End Port Sanity Check if
		
		
		my $params = "";
		if (defined $uri_parts[4]) {
			$params = substr($uri_parts[4], 0, 1024);
		}
		
		if ($params ne "") {
			if ($rData{'METHOD'} eq "POST") {
				$rData{'CONTENT'} = $params;
			} else {
				$rData{'PATH'} = $rData{'PATH'} . "?" . $params if ($params ne "");
			}
		}
		
	
		# username from URL
		if (defined $uri_parts[6]) {
			$rData{'USERNAME'} = substr($uri_parts[6], 0, 256) || "";
		}
		
		# password from URL
		if (defined $uri_parts[7]) {
			$rData{'PASSWORD'} = substr($uri_parts[7], 0, 256) || "";
		}
		
	
	
	$rData{'USERNAME'} = substr($FORM{'USERNAME'}, 0, 256) unless ($rData{'USERNAME'} ne "");
	$rData{'PASSWORD'} = substr($FORM{'PASSWORD'}, 0, 256) unless ($rData{'PASSWORD'} ne "");
	
	
	
	} else { # URL is Not absolute
	
		print "URL BAD\n";
		exit;
		
	} # End Check if URL is absolute
	
			
	# Sanity Mimic
	if (defined $FORM{'MIMICK'}) { # If Mimic Given
	
		# Browser Mimic Sanity Check
		if($FORM{'MIMICK'} =~ /^(ON|OFF)$/i) {
			$mData{'MIMICK'} = $FORM{'MIMICK'};
			print "M: MIMICK: $mData{'MIMICK'}<BR>\n" if ($Debug == 1);
		} else {
			$mData{'MIMICK'} = "ON"; # Browser Mimic Default On.
		} # End Mimic Sanity Check
	
	} else { # No Mimic Given
		$mData{'MIMICK'} = "ON"; # Default Mimic
	} # End Mimic If
	
	
	
	if(defined $FORM{'HTTP_FIX'}) {
		if ($FORM{'HTTP_FIX'} =~ /^(ON|OFF)$/i) {
			$mData{'HTTP_FIX'} = $FORM{'HTTP_FIX'};
			print "M: HTTP FIX: $mData{'HTTP_FIX'}<BR>\n" if ($Debug == 1);
		} else {
			$mData{'HTTP_FIX'} = "ON"; 
		} 
	
	} else {
		$mData{'HTTP_FIX'} = "ON";  
	} 
	
	
	
	
	if(defined $FORM{'HOST_FIX'}) {
		if ($FORM{'HOST_FIX'} =~ /^(ON|OFF)$/i) {
			$mData{'HOST_FIX'} = $FORM{'HOST_FIX'};
			print "M: HOST FIX: $mData{'HOST_FIX'}<BR>\n" if ($Debug == 1);
		} else {
			$mData{'HOST_FIX'} = "ON"; 
		} 
	
	} else {
		$mData{'HOST_FIX'} = "ON";  
	} 
	



	# Sanity Check Output Mode
	if (defined $FORM{'MODE'}) { # If Output Mode Given
		# Output Mode Sanity Check
		if($FORM{'MODE'} =~ /^(DIR|LOG|BACKUP)$/) {
			$mData{'MODE'} = $FORM{'MODE'};	# Set Output Mode
			print "M: REQUEST MODE: $mData{'MODE'}<BR>\n" if ($Debug == 1);
		} else { # Output Mode invalid
			$mData{'MODE'} = "DIR"; # Default Output Mode
		} # End Output Mode Sanity If
	} else { # No Output Mode Given
		$mData{'MODE'} = "DIR"; # Default Output Mode
	} # End Output Mode If
	
	
	
	
	# Set HTTP Request Headers
	$rData{'HEADERS'} = $FORM{'HEADERS'} || "";
	@req_headers = split(/\n/, $rData{'HEADERS'}); # Parse Request Headers
	
	
	
	# Mimic Flag
	my $mimick_flag = "NONE";
	# Check if Mimick Headers are already going in to stop duplication
	foreach my $hdr (@req_headers) {
		if ($hdr =~ /Accept/) {
			$mimick_flag = "ON";
		}
	}
	
	# Browser Header Mimick
	if (($mData{'MIMICK'} eq "ON") && ($mimick_flag eq "NONE")) { # Mimick is On
		print "MIMICKING <BR>\n" if ($Debug == 1);
		foreach my $name (keys %mimickhdrs) { # Loop thru mimick headers
			my $hline = $name . ": " . $mimickhdrs{$name};
			push(@req_headers, $hline);
		} # End Header Loop
	} # End Mimic Header If
	
	

	if ($Debug == 1) { # Print Out Request Headers
		foreach my $hdr (@req_headers) { # Loop Thru Request Headers
			print "REQ HEADER: $hdr<BR>\n";	# Print Header
		} # End Request Header Loop
	} # End Request header if
	
	
	
	
	# Check the Length of Search String
	if(length $FORM{'SEARCH_STRING'} > 64) { # Great that 64 is no joy
		errorOut("Search string is too long. Please restrict to 64 characters."); # Error Out
	} else { # Length is OK, Decode and Clean up string
		$mData{'SEARCH_STRING'} = $FORM{'SEARCH_STRING'} if (defined $FORM{'SEARCH_STRING'}); # Set Search String
	} # End Search String If
	
	
	if(($FORM{'PATH'}) && ($FORM{'PATH'} ne "")) { # 
		$mData{'PATH'} = substr($FORM{'PATH'}, 0, 1024);
	}
	
	
	
} # End Subroutine



#####################
### RequestMethod ###
#####################
# This will populate the %FORM hash with paramaters and values.
sub RequestMethod {
	# Determine the request method and then get the input
	
	my $buffer = "";
	
	if (!defined $ENV{'REQUEST_METHOD'}) {
		$ENV{'REQUEST_METHOD'} = "GET";
	}
	
	if ($ENV{'REQUEST_METHOD'} eq 'POST') {
        	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # For POST methods
	} else {        
        	$buffer = $ENV{'QUERY_STRING'} || ""; # for GET methods
	} # end if
	
	# Data Clean-up
	if ($buffer ne "") {
		$buffer =~ s/(\0|%00)//g;	# Remove Hidden Nulls
        	$buffer =~ s/[\n]/%0A/g;	# URL Encode Newline
        	$buffer =~ s/[\r]/%0D/g; 	# URL Encode Carriage Returns
	}
	
	# Split the name-value pairs
	my @pairs = split(/&/, $buffer);
 
	foreach my $pair (@pairs) {
        	my ($name, $value) = split(/=/, $pair);
 
		# What happens to Lack of name or value after/before the equals?
		
       		# Un-Webify plus signs and %-encoding
        	$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # URL Decode Name

        	$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # URL Decode Name
		$name =~ s/[\n\r]//g;	# Don't allow newlines
		
		print "NAME: $name VALUE: $value<BR>\n" if ($Debug == 1);
		
                $FORM{$name} = $value; # Build a hash the input parameters
		
	} # end foreach


} # End sub RequestMethod
