#!/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 URI;
use LW;
require "./Subs.pm";
use XML::Simple;




### Global Variable #############################################################
my $Debug = 0;	# Debug Option. 0 = Off 1 = On
$| = 1;		# Flush On;


my $useragent = "WhiteHat Arsenal 1.07 Beta"; # Default User-Agent

my %FORM = (); # Input Array
my %jar;


# Ripper Control Variables and Options
my %mData = ("SESSION" => "",		# Current Session. What session to log request in.
		"MIMICK" => "",		# Browser Mimic. Mimic HTTP Request Headers of a common web browser
		"HTTP_FIX" => "",	# HTTP Fixup
		"HOST_FIX" => "",	# Host Fixup
		"MAX" => "",		# Max
	);


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

# Browser Mimic 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 @res_headers = ();	# HTTP Response Headers
my @req_headers = ();	# HTTP Request Headers


### Link HTML Parsing ###
my %track = ();		# Completed URL
my %links_in = ();	# URL In Buffer
my %links_out = ();	# URL Out
my $base_url = "";	# Current Base URL

my @Tags = ("A",
		"AREA", 
		"BASE", 
		"FRAME", 
		"IFRAME", 
		"LAYER", 
		"ILAYER",
		"IMG",
		"FORM",
		"INPUT",
		"LINK",
		"OBJECT",
		"BODY",
		"TABLE"); # Tags that have HTML Links

my $TagsPipe = join '|', @Tags;


# Session Information
my $doc_root = $ENV{'DOCUMENT_ROOT'} || "/home/apache/htdocs";	# Document Root Directory
my $session_dir = $doc_root . "/" . "wharsenal/sessions/";	# Session Directory
my $session_path = "";						# Current Session Directory Path
my $spider_file = "spider.xml";					# Spider Results
my $webapplications_file = "webapplications.xml";		# Web Application Results
my $spider_results;						# Spider Results Path
my $webapplications_results;					# Web Applications Results Path
	
### Page Properties ###
my $bgcolor = "FFFFFF";			# Page BGCOLOR
my $link = "FF3300";			# Page LINK COLOR
my $vlink = "3300FF";			# Page VLINK COLOR


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


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

# Print XHTML Header
print <<EOF;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
        "http://www.w3.org/TR/2000/REC-xhtml1-20000126/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<HEAD>
EOF


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


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

controller();


	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";
		}
	}
	
	
print "<FONT FACE=\"Arial\" STYLE=\"font-size: 14px; font-family:arial,sans-serif\"><B>[:: Spidering Complete ::]</B><BR>\n";

print "</BODY></HTML>\n";
exit;
	
##################################################################################

### SUBROUTINES ##################################################################



##################
### Controller ###
##################
# Function control the function of the application.

sub controller {


	print "<TABLE BGCOLOR=\"#fdbe50\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\">\n";
	print "<TR><TD WIDTH=\"565\" 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 BGCOLOR=\"#fdbe50\"><TD ALIGN=\"LEFT\" VALIGN=\"TOP\" WIDTH=\"565\" >\n";
			printFont("<B>Spider Results</B> ", "18");
			printFont(" (" . HTMLEsc($mData{'SESSION'}) . ")", "12");
			print "</TD></TR>\n";



			print "<TR BGCOLOR=\"#fef5c7\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
		
				print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
				print "<TR>\n";
				
				print "<TD WIDTH=\"90\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Limit</B>: " . HTMLEsc($mData{'MAX'}), "12");
				print "</TD>\n";
	
				print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Browser Mimick</B>: " . HTMLEsc($mData{'MIMICK'}), "12");
				print "</TD>\n";
	
				print "<TD WIDTH=\"90\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>HTTP Fix</B>: " . HTMLEsc($mData{'HTTP_FIX'}), "12");
				print "</TD>\n";
				
				print "<TD WIDTH=\"90\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Host Fix</B>: " . HTMLEsc($mData{'HOST_FIX'}), "12");
				print "</TD>\n";
	
				print "</TR>\n";
			
				print "</TABLE>\n";
			
			print "</TD></TR>\n";
			
			
			print "</TABLE>\n";
	
		print "</TD></TR>\n";
		print "</TABLE>\n";

	print "</TD></TR>\n";
	print "</TABLE>\n";
	
	my @start_url = ($rData{'PATH'}, $rData{'PROTOCOL'}, $rData{'HOST'}, $rData{'PORT'});
	my $START = LW::utils_join_uri(@start_url);
	
	my $count = 0;
	
	$links_in{$START} = 1;
	$base_url = $START;
	
	print "<FONT FACE=\"Arial\" STYLE=\"font-size: 14px; font-family:arial,sans-serif\"><B>Starting URL</B>: <A HREF=\"$START\" TARGET=\"_BLANK\">$START</A></FONT>...<BR>\n";

	my ($i, $type, $data) = httpRequest($rData{'HOST'}, $rData{'PORT'}, $rData{'USERNAME'}, $rData{'PASSWORD'}, $rData{'PATH'}, $rData{'VERSION'}, $rData{'PROTOCOL'}, 2);
	$count++;
	
	if ($i eq "2") {
		$links_out{$START} = $type;
	} elsif ($i eq "1") {
		$track{$START} = $type;
	}
	
	
	if ($Debug == 1) {
		foreach my $key (keys %track) {
			print "TRACK: $key VAL: $track{$key}<BR>\n" if ($track{$key});
		}
	}
	
	if ($Debug == 1) {
		foreach my $key (keys %links_in) {
			print "IN: $key VAL: $links_in{$key}<BR>\n" if ($links_in{$key});
		}
	}
	
	if ($Debug == 1) {
		foreach my $key (keys %links_out) {
			print "OUT: $key VAL: $links_out{$key}<BR>\n" if ($links_out{$key});
		}
	}
	
	
	while ((my $key, my $value) = each %links_in) {
		my @parts = LW::utils_split_uri($key);
		
		$base_url = $key;
		print "BASE_URL:$base_url<BR>\n" if ($Debug == 1);
		
		if ($count > $mData{'MAX'}) {
			print "<FONT FACE=\"Arial\" STYLE=\"font-size: 14px; font-family:arial,sans-serif\"><B>[:: Maximum has been reach ::]</B><BR>\n";
			exit;
		}
		
		
		
		if ($Debug == 1) {
			foreach my $x (@parts) {
				print "$x <BR>\n" if (defined $x);
			}
		}
		
		if (defined $parts[2]) {
		
			if (exists $track{$key}) {
				print "VISITED:$base_url <BR>\n" if ($Debug == 1);
			} else {
				print "NOT SEEN: $key <BR>\n" if ($Debug == 1);
				$track{$key} = 1;
				
				
				my $params = $parts[4] || "";
				my $path = $parts[0];
				
				$path = $path . "?" . $params if ($params ne "");
				print "X: NEW PATH $path<BR>\n" if ($Debug == 1);
				
				if ($rData{'HOST'} eq $parts[2]) {
					print "LINK: $key <BR>\n" if ($Debug == 1);
					print "ON DOMAIN: $parts[2]<BR><BR>\n"if ($Debug == 1);
				
					($i, $type, $data) = httpRequest($parts[2], $parts[3], $rData{'USERNAME'}, $rData{'PASSWORD'}, $path, $rData{'VERSION'}, $parts[1], 1);
					
					
					if ($i eq "2") {
						$track{$key} = $type;
					} elsif ($i == 1) {
						webApplication($key) if ($params ne "");
						($i, $type, $data) = httpRequest($parts[2], $parts[3], $rData{'USERNAME'}, $rData{'PASSWORD'}, $parts[0], $rData{'VERSION'}, $parts[1], 2);
						$count++;
						$track{$key} = $type;
					}
	
	
	
				} else {
					print "LINK: $key <BR>\n"if ($Debug == 1);
					print "OFF DOMAIN $parts[2]<BR><BR>\n"if ($Debug == 1);
					errorXML($key, "Off Host");
					$links_out{$key} = 1;
				}
				
			}
			
		} else {
			print "LINK: $key NO HOST<BR>\n"if ($Debug == 1);
			errorXML($key, "Bad Link");
			$links_out{$key} = 1;
		}
		
		delete $links_in{$key};
		
	}
		
	
	if ($Debug == 1) {
		foreach my $key (keys %track) {
			print "TRACK: $key VAL: $track{$key}<BR>\n" if ($track{$key});
		}
	}
	
	if ($Debug == 1) {
		foreach my $key (keys %links_in) {
			print "IN: $key VAL: $links_in{$key}<BR>\n" if ($links_in{$key});
		}
	}
	
	if ($Debug == 1) {
		foreach my $key (keys %links_out) {
			print "OUT: $key VAL: $links_out{$key}<BR>\n" if ($links_out{$key});
		}
	}
	
	
	
} # End Controller SubRoutine





####################
### HTTP Request ###
####################
# Function send an HTTP Request

sub httpRequest {

	my $host = shift;		# Host
	my $port = shift;		# Port
	my $username = shift;		# Web Auth Username
	my $password = shift;		# Web Auth Password
	my $path = shift;		# URI
	my $bpath = URI->new($path);	# Base URI
	my $version = shift;		# HTTP Version
	my $protocol = shift;		# HTTP Protocol
	my $flag = shift; # 1 for Check || 2 for OK. # Content Type Check Flag
	
	
	print "HOST: $host<BR>\n" if ($Debug == 1);
	print "PORT: $port<BR>\n" if ($Debug == 1);
	print "USERNAME: $username<BR>\n" if ($Debug == 1);
	print "PASSWORD: $password<BR>\n" if ($Debug == 1);
	print "PATH: $path<BR>\n" if ($Debug == 1);
	print "BASE PATH: $bpath<BR>\n" if ($Debug == 1);
	print "VERSION: $version<BR>\n" if ($Debug == 1);
	print "PROTOCOL: $protocol<BR>\n" if ($Debug == 1);
	print "FLAG: $flag<BR>\n" if ($Debug == 1);
	
	# Begin HTTP Objects
	my (%hin, %hout);
	
	# Initialize HTTP In
	LW::http_init_request(\%hin);
	
	
	# Load in Connection Properties and Attributes
	$hin{'whisker'}->{'host'} = $host;		# Load Host
	$hin{'whisker'}->{'port'} = $port;		# Load Port
	$hin{'whisker'}->{'uri'} = $path;		# Load Path
	$hin{'whisker'}->{'http_ver'} = $version;	# Set Version
	$hin{'User-Agent'} = $useragent;		# heh back at ya
	
	
	# Check Flag to see whether to check content-type
	if ($flag == 1) { # Need to Check File
		$hin{'whisker'}->{'method'} = "HEAD";		# Set Method
	} elsif ($flag == 2) { # Check performed, Download File
		$hin{'whisker'}->{'method'} = "GET";		# Set Method
	} # End Checking
	
	print $hin{'whisker'}->{'method'} . "<BR>\n" if ($Debug == 1);
	
	# Set Web Authentication Credential
	if (($rData{'USERNAME'} ne "") || ($rData{'PASSWORD'} ne "")) { # If username or password given
		print "Setting Basic Auth<BR>\n" if ($Debug == 1);
		LW::auth_set_header('basic', \%hin, $rData{'USERNAME'}, $rData{'PASSWORD'}); # Set Basic Auth Credentials
	} # End Web Auth if
	
	# SSL Support, Check Protocol
	if ($protocol =~ /^(https)$/i) { # If protocol is SSL
		print "GO SSL<BR>\n" if ($Debug == 1);
		$hin{'whisker'}->{'port'} = $rData{'PORT'} || 443;
		$hin{'whisker'}->{'ssl'} = 1;
		$hin{'whisker'}->{'save_ssl_info'} = 1;
	}

	
	# 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
	
	
	my $ctype = "";
	
	# Write Cookie Information
	LW::cookie_write(\%jar,\%hin);
	
	
	# Check for HTTP Fixup Flag
	if ($FORM{'M_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
	
	
	
	if ($Debug == 1) {
		foreach my $i (keys %hin) {
			if ($i eq "whisker") {
				foreach my $x (keys %{$hin{$i}}) {
					print "<B>$x</B> : ${$hin{$i}}{$x}<BR>\n";
				}
			} else {
				print "<B><I>$i</I></B> : $hin{$i}<BR>\n";
			}
		}
	}
	
	
	# actually make the request (and get response)
	if(LW::http_do_request(\%hin,\%hout)){

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

		
		my $code = $hout{'whisker'}->{'code'} || "";
		my $data = $hout{'whisker'}->{'data'} || "";
		
		my $size;
		if (defined $hout{'whisker'}->{'data'}) {
			$size = SizeConvert(length $hout{'whisker'}->{'data'});
		} else {
			$size = 0;
		}
		my $date = dtime();
		print "CODE: $hout{'whisker'}->{'code'} TYPE: $hin{'whisker'}->{'method'}<BR>\n" if ($Debug == 1);
		#print $data;
		
		$ctype = LW::utils_find_lowercase_key(\%hout, "Content-Type") || "";
		
		
		LW::cookie_read(\%jar, \%hout);
		
		
	
		# 302|301 Redirect If
		if ((defined $hout{'Location'}) && ($hout{'whisker'}->{'code'} =~ /^(301|302)$/)) {
			my $base_uri = URI->new($base_url);
			my $redir_url = URI->new($hout{'Location'});
			$redir_url = $redir_url->abs($base_uri);
			
			$links_in{$redir_url} = $base_url;
			errorXML($redir_url, "Re-Direct, will spider");
			return (2, $ctype, $data);
			
		} # End 302 Redirect If
	
	
	
	
	print "<TABLE BGCOLOR=\"#fde350\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\">\n";
	print "<TR><TD WIDTH=\"565\" 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=\"565\" BGCOLOR=\"#fde350\"><TD ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";
			printFont("<B>Request Information</B>", "14");
			print "</TD></TR>\n";



			print "<TR BGCOLOR=\"#fef5c7\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
		
				print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
				print "<TR>\n";
				print "<TD WIDTH=\"210\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Host</B>: $host", "10");
				print "</TD>\n";
			
				print "<TD WIDTH=\"80\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Port</B>: $port", "10");
				print "</TD>\n";
	
				print "<TD WIDTH=\"80\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Protocol</B>: $protocol", "10");
				print "</TD>\n";
				
				print "<TD WIDTH=\"80\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Method</B>: $hin{'whisker'}->{'method'}", "10");
				print "</TD>\n";
				
				print "<TD WIDTH=\"100\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#fef5c7\">\n";
				printFont("<B>Version</B>: HTTP/$version", "10");
				print "</TD>\n";
	
				print "</TR>\n";
			
				print "</TABLE>\n";
			
			print "</TD></TR>\n";
			
			
			print "</TABLE>\n";
	
		print "</TD></TR>\n";
		print "</TABLE>\n";

	print "</TD></TR>\n";
	print "</TABLE>\n";
	
	
	print "<TABLE BGCOLOR=\"#cee3f0\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\">\n";
	print "<TR><TD WIDTH=\"565\" 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";
	
			
			my $wbase_url = WrapString($base_url, 55);
			
			print "<TR WIDTH=\"565\" BGCOLOR=\"#cee3f0\"><TD ALIGN=\"LEFT\" VALIGN=\"TOP\">\n";
			printFont("<B>URL</B>: <A HREF=\"$base_url\" TARGET=\"_blank\">$wbase_url</A>", "12");
			print "</TD></TR>\n";
			
			
			print "<TR BGCOLOR=\"#FFFFFF\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
		
				print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
				print "<TR>\n";
				print "<TD WIDTH=\"110\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#EEEEEE\">\n";
				printFont("<B>Path</B>", "10");
				print "</TD>\n";
			
				print "<TD WIDTH=\"453\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				printFont("<A HREF=\"javascript: void(0);\" OnClick=\"parent.topbar.document.control.URL.value = \'$base_url\'\;\">$wbase_url</A>", "10");
				print "</TD>\n";
	
				print "</TR>\n";
			
				print "</TABLE>\n";
			
			print "</TD></TR>\n";
			
			print "<TR BGCOLOR=\"#FFFFFF\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
		
				print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
				print "<TR>\n";
				print "<TD WIDTH=\"110\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#EEEEEE\">\n";
				printFont("<B><A HREF=\"javascript: void(0);\" OnClick=\"parent.topbar.document.control.URL.value = \'$links_in{$base_url}\'\;\">Referer</A></B>", "10");
				print "</TD>\n";
			
				
				my $wreferer = WrapString($links_in{$base_url}, 55);
				print "<TD WIDTH=\"453\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#FFFFFF\">\n";
				printFont("<A HREF=\"$links_in{$base_url}\" TARGET=\"_blank\">$wreferer</A>", "10");
				print "</TD>\n";
	
				print "</TR>\n";
			
				print "</TABLE>\n";
			
			print "</TD></TR>\n";
			
			
			print "</TABLE>\n";
	
		print "</TD></TR>\n";
		print "</TABLE>\n";

	print "</TD></TR>\n";
	print "</TABLE>\n";
	
	
	
	print "<TABLE BGCOLOR=\"#cee3f0\" BORDER=\"0\" CELLSPACING=\"2\" CELLPADDING=\"0\">\n";
	print "<TR><TD WIDTH=\"565\" 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 BGCOLOR=\"#FFFFFF\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
		
				print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
				print "<TR>\n";
			
				print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#cee3f0\">\n";
				printFont("<B>Response Information</B>: ", "12");
				print "</TD>\n";
	
				print "<TD WIDTH=\"75\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#cee3f0\">\n";
				printFont("<B>Code</B>: $code", "12");
				print "</TD>\n";
				
	
				print "<TD WIDTH=\"200\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#cee3f0\">\n";
				printFont("<B>Content-Type</B>: $ctype", "12");
				print "</TD>\n";
	
				print "<TD WIDTH=\"120\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#cee3f0\">\n";
				printFont("<B>Size</B>: $size bytes", "12");
				print "</TD>\n";
	
				print "</TR>\n";
			
				print "</TABLE>\n";
			
			print "</TD></TR>\n";
			
			
	
		
		foreach my $hdr (keys %hout) {
			#print "HRD: $hdr $hout{$hdr}<BR>\n" unless ($hdr eq "whisker");
		}
		
		
		if ((-e $spider_results) && (-w $spider_results)) {
		
			cutEnd($spider_results);
			
			open(FILE, ">>$spider_results") or die "Cant Open spider results $!<BR>\n";
			
			
			print FILE "\t<WEBPAGE>\n";
	
			print FILE "\t\t<REQUEST-INFORMATION>\n";
			
			print FILE "\t\t\t<TIME>" . XMLEsc($date) . "</TIME>\n";
			print FILE "\t\t\t<REFERER>" . XMLEsc($links_in{$base_url}) . "</REFERER>\n";
			print FILE "\t\t\t<HOST><![CDATA[$host]]></HOST>\n";
			print FILE "\t\t\t<PORT><![CDATA[$port]]></PORT>\n";
			print FILE "\t\t\t<USERNAME><![CDATA[$username]]></USERNAME>\n";
			print FILE "\t\t\t<PASSWORD><![CDATA[$password]]></PASSWORD>\n";
			print FILE "\t\t\t<PROTOCOL><![CDATA[$protocol]]></PROTOCOL>\n";
			print FILE "\t\t\t<PATH><![CDATA[$path]]></PATH>\n";
			print FILE "\t\t\t<URL><![CDATA[$base_url]]></URL>\n";
			print FILE "\t\t\t<METHOD><![CDATA[$hin{'whisker'}->{'method'}]]></METHOD>\n";
			print FILE "\t\t\t<VERSION><![CDATA[$version]]></VERSION>\n";
		
			if (keys %hin > 1) {
				print FILE "\t\t\t<REQUEST-HEADERS>\n";
	
				foreach my $hdr (keys %hin) {
					my $name = XMLEsc(substr($hdr, 0, 128));
					my $value = substr($hin{$hdr}, 0, 2056);
					print FILE "\t\t\t\t<REQUEST-HEADER NAME=\"$name\"><![CDATA[" . $value . "]]></REQUEST-HEADER>\n" unless ($hdr eq "whisker");
				}
		
				print FILE "\t\t\t</REQUEST-HEADERS>\n";
			}
	
	
			print FILE "\t\t</REQUEST-INFORMATION>\n\n";
			
			
			print FILE "\t\t<RESPONSE-INFORMATION>\n";
			print FILE "\t\t\t<STATUS-LINE><![CDATA[$hout{'whisker'}->{'http_resp_message'}]]></STATUS-LINE>\n";
			
			print FILE "\t\t\t<CODE><![CDATA[$code]]></CODE>\n";
	
			
			if (keys %hout > 1) {
				print FILE "\t\t\t<RESPONSE-HEADERS>\n";
	
				foreach my $hdr (keys %hout) {
					$hout{$hdr} = "" unless (defined $hout{$hdr});
					my $name = XMLEsc(substr($hdr, 0, 128));
					my $value = substr($hout{$hdr}, 0, 2056) || "";
					print FILE "\t\t\t\t<RESPONSE-HEADER NAME=\"$name\"><![CDATA[$value]]></RESPONSE-HEADER>\n" unless ($hdr eq "whisker");
				}
		
				if (defined $hin{'whisker'}->{'save_ssl_info'}) {
					print FILE "\t\t\t\t<RESPONSE-HEADER NAME=\"SSL cipher\"><![CDATA[$hout{'whisker'}->{'ssl_cipher'}]]></RESPONSE-HEADER>\n";
					print FILE "\t\t\t\t<RESPONSE-HEADER NAME=\"Server cert\"><![CDATA[$hout{'whisker'}->{'ssl_cert_subject'}]]></RESPONSE-HEADER>\n";
					print FILE "\t\t\t\t<RESPONSE-HEADER NAME=\"Cert issuer\"><![CDATA[$hout{'whisker'}->{'ssl_cert_issuer'}]]></RESPONSE-HEADER>\n";
				}
		
				print FILE "\t\t\t</RESPONSE-HEADERS>\n";
			}
	
			htmlProcess($data, $base_url);
	
	
			print FILE "\t\t</RESPONSE-INFORMATION>\n";
			
			print FILE "\t</WEBPAGE>\n";
	
	
			print FILE "</HTMLPAGES>\n";
		
		
			close(FILE);
			
		}
		
		
		if ($ctype =~ /^(text)(\/)(html)/i) {
			return (1, $ctype, $data);
		} else {
			return (2, $ctype, $data);
		}
		
		
		&LW::http_reset;
		
		
	}	
	
} # End HTTP Request SubRoutine



sub htmlProcess {
		my $data = shift;
		my $bpath = shift;
		my $size = length $data || "0";
		my @response = split(/>/, $data);       # Split HTTP Response By Tag
		
		
		my $scripts = 0;
		my $comments = 0;
		my $links = 0;
		my @forms = ();
		
		my $flen = "None";
		
		foreach my $lin (@response) { # Look for FILE URLs
               		$lin = $lin . ">";    # Fix Split Routine
                	$lin =~ s/(.*)(<)/$2/eg;
                	$lin =~ s/\n/ /g;
                	$lin =~ s/\t/ /g;
		
		
			# Turn Parsing On|Off
                	if ($lin =~ /(<!--)([\s])/i) {
				$comments++;  	
                	}
		
		
			if ($lin =~ /(<SCRIPT)/i) {
				$scripts++
			}
			
			if ($lin =~ /([\s])(HREF|SRC)(=)/i) {
				$links++
			}
		
			if ($lin =~ /<FORM/i) {        
				if($lin =~ /(ACTION)(=)(["]?|[']?)([\w\d\`\~\!\@\#\$\%\^\&\*\(\)\-\_\=\+\[\]\{\}\;\:\,\.\/\?\\\']+)(["]?[']?[>]?)/i) { # 'ACTION ELEMENT
					my $form_action = URI->new($4);
                			# Make the Action URL Absolute
                			$form_action = $form_action->abs($bpath);
					push(@forms, $form_action);
					$flen = "Yes";
				} # End Action
			}
		}
		
		
		
		
			print "<TR BGCOLOR=\"#EEEEEE\" ALIGN=\"LEFT\" VALIGN=\"TOP\"><TD>\n";
		
				print "<TABLE BORDER=\"0\" CELLSPACING=\"0\" CELLPADDING=\"2\">\n";
				print "<TR>\n";
			
				print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#EEEEEE\">\n";
				printFont("<B>Comments</B>: $comments", "12");
				print "</TD>\n";
	
				print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#EEEEEE\">\n";
				printFont("<B>Scripts</B>: $scripts", "12");
				print "</TD>\n";
				
	
				print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#EEEEEE\">\n";
				printFont("<B>Forms</B>: $flen", "12");
				print "</TD>\n";
	
				print "<TD WIDTH=\"150\" ALIGN=\"LEFT\" VALIGN=\"TOP\" BGCOLOR=\"#EEEEEE\">\n";
				printFont("<B>Links</B>: $links", "12");
				print "</TD>\n";
	
				print "</TR>\n";
			
				print "</TABLE>\n";
			
			print "</TD></TR>\n";
			
			
			print "</TABLE>\n";
	
		print "</TD></TR>\n";
		print "</TABLE>\n";

	print "</TD></TR>\n";
	print "</TABLE>\n";
	

		
		#my $base64_data = LW::encode_base64($data);
		#$base64_data =~ s/(\r|\n)//g;	# Remove line feeds and breaks
	
		print FILE "\t\t\t<DATA SIZE=\"$size\" ENOCODING=\"BASE64\"><![CDATA[]]></DATA>\n";
	
	
		if ($comments) {
			print FILE "\t\t\t<COMMENTS>" . XMLEsc($comments) . "</COMMENTS>\n";
		} else {
			print FILE "\t\t\t<COMMENTS>0</COMMENTS>\n";
		}
	
		if ($links) {
			print FILE "\t\t\t<LINKS>"  . XMLEsc($links) . "</LINKS>\n";
		} else {
			print FILE "\t\t\t<LINKS>0</LINKS>\n";
		}
	
	
		if ($scripts) {
			print FILE "\t\t\t<SCRIPTS>" . XMLEsc($scripts) . "</SCRIPTS>\n";
		} else {
			print FILE "\t\t\t<SCRIPTS>0</SCRIPTS>\n";
		}
	
	
	
		if (scalar @forms > 0) {
			print FILE "\t\t\t<FORMS>\n";
		
			foreach my $url (@forms) {
				print FILE "\t\t\t\t<FORM TYPE=\"absolute\" ENCODING=\"TEXT\"><![CDATA[$url]]></FORM>\n";
			}
			print FILE "\t\t\t</FORMS>\n";
		}

		#my $base64_data = LW::encode_base64($data);
		#$base64_data =~ s/(\r|\n)//g;	# Remove line feeds and breaks
	
		print FILE "\t\t\t<DATA SIZE=\"$size\" ENOCODING=\"BASE64\"><![CDATA[]]></DATA>\n";
	
	

		LW::html_find_tags(\$data, \&linkExtract);

}



sub linkExtract {
	my $tag = shift;
	my $attr = shift;
	
	my $b_url = URI->new($base_url);
	
	if ($tag =~ /^($TagsPipe)$/i) {
		#print "TAG: $tag<BR>\n";
		
		if ($Debug == 0) {
			foreach my $key (keys %{$attr}) {
				my $k = lc($key);
				my $v = $attr->{$key};
				delete $attr->{$key};
				$attr->{$k} = $v;
				
				#print "KEY: $key VAL: $attr->{$k}<BR>\n";
			}
		}
		
		my $uri = "";
		my $new_url = "";
		
		if (defined %{$attr}->{'href'}) {
			$new_url = makeAbsolute($b_url, $attr->{'href'});
			#print "HREF: $attr->{'href'}<BR>\n";
			$links_in{$new_url} = $base_url;
		}
		if (defined %{$attr}->{'src'}) {
			$new_url = makeAbsolute($b_url, $attr->{'src'});
			#print "SRC: $attr->{'src'}<BR>\n";
			$links_in{$new_url} = $base_url;
		}
		if (defined %{$attr}->{'classid'}) {
			$new_url = makeAbsolute($b_url, $attr->{'classid'});
			#print "SRC: $attr->{'classid'}<BR>\n";
			$links_in{$new_url} = $base_url;
		}
		if (defined %{$attr}->{'codebase'}) {
			$new_url = makeAbsolute($b_url, $attr->{'codebase'});
			#print "SRC: $attr->{'codebase'}<BR>\n";
			$links_in{$new_url} = $base_url;
		}
		if (defined %{$attr}->{'data'}) {
			$new_url = makeAbsolute($b_url, $attr->{'data'});
			#print "SRC: $attr->{'data'}<BR>\n";
			$links_in{$new_url} = $base_url;
		}
		if (defined %{$attr}->{'background'}) {
			$new_url = makeAbsolute($b_url, $attr->{'background'});
			#print "SRC: $attr->{'background'}<BR>\n";
			$links_in{$new_url} = $base_url;
		}
		
	}
	
	return 0;

}

sub makeAbsolute {
	my $base = shift;
	my $url = shift;
	
	$base = URI->new($base);
	$url = URI->new($url);
	
	print "BASE: $base URL: $url<BR>\n" if ($Debug == 1);
	
	my $new_url = $url->abs($base);
			
	return $new_url;

}


sub webApplication {
	my $url = shift;
	print "URL: $url<BR>\n" if ($Debug == 1);
	
	$url =~ s/&amp;/&/g;
	
	my @parts = LW::utils_split_uri($url);
	my $params = $parts[4] || "";
	
	if ($Debug == 1) {
		foreach my $x (@parts) {
			print "X: $x<BR>\n" if (defined $x);
		}
	}
	
	if ($params ne "") {
		my @kvpairs = split(/&/, $params);
		
		
		if ((-e $webapplications_results) && (-w $webapplications_results)) {
		
			cutEnd($webapplications_results);
			
			open(FILE, ">>$webapplications_results") or die "Cant Open spider results $!<BR>\n";
			
			print FILE "\t<WEBAPPLICATION>\n";
			print FILE "\t\t<TIME>" . dtime() . "</TIME>\n";
			print FILE "\t\t<REFERER>" . XMLEsc($base_url). "</REFERER>\n";
			print FILE "\t\t<HOST><![CDATA[$parts[2]]]></HOST>\n" if (defined $parts[2]);
			print FILE "\t\t<PORT><![CDATA[$parts[3]]]></PORT>\n" if (defined $parts[3]);
			print FILE "\t\t<USERNAME><![CDATA[$rData{'USERNAME'}]]></USERNAME>\n";
			print FILE "\t\t<PASSWORD><![CDATA[$rData{'PASSWORD'}]]></PASSWORD>\n";
			print FILE "\t\t<PROTOCOL><![CDATA[$parts[1]]]></PROTOCOL>\n" if (defined $parts[1]);
			print FILE "\t\t<PATH><![CDATA[$parts[0]]]></PATH>\n" if (defined $parts[0]);
			print FILE "\t\t<URL><![CDATA[$url]]></URL>\n";
			print FILE "\t\t<METHOD><![CDATA[GET]]></METHOD>\n";
			print FILE "\t\t<VERSION><![CDATA[$rData{'VERSION'}]]></VERSION>\n";
		
			# If HTTP Request Headers Exist
			if (length @req_headers > 0) {
				print FILE "\t\t<REQUEST-HEADERS>\n";
				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;
						
						$hname = XMLEsc(substr($hname, 0, 128));
						$hvalue = substr($hvalue, 0, 2056) || "";
						
						print "H NAME: $hname<BR>\n" if ($Debug == 1);
						print "H VALUE: $hvalue<BR>\n" if ($Debug == 1);
						print FILE "\t\t\t<REQUEST-HEADER NAME=\"$hname\"><![CDATA[$hvalue]]></REQUEST-HEADER>\n";
					} # End Header Format if
				} # End Foreach
		
				print FILE "\t\t</REQUEST-HEADERS>\n";
			} # End Load HTTP Request Headers If
	
	
			if (length @kvpairs > 0 ) {
				print FILE "\t\t<PARAMETERS>\n";
				foreach my $lin (@kvpairs) {
					if ($lin =~ /(.*)(=)(.*)/) {
						my $name = $1;
						my $value = $3 || "";
						
						
						$name = XMLEsc(substr($name, 0, 512));
						$value = substr($value, 0, 2056) || "";
						
						print FILE "\t\t\t<PARAMETER NAME=\"$name\"><![CDATA[$value]]></PARAMETER>\n";
					}
				}
		
				print FILE "\t\t</PARAMETERS>\n";
			}
		
			print FILE "\t</WEBAPPLICATION>\n";
			print FILE "</WEBAPPLICATIONS>\n";
			
			close(FILE);
		}
	}
	
}




sub errorXML {

	my $url = shift || "";
	$url =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # URL Decode
	
	my $wurl = WrapString($url, 55);
	
	
	my $note = shift || "";
	
print <<EOF;
<TABLE BORDER="0" CELLPADDING="2" CELLSPACING="0" WIDTH=565><TR><TD BGCOLOR="#CCCCCC">

<TABLE BORDER="0" CELLPADDING="2" CELLSPACING="0" WIDTH=565>
<TR>
<TD ALIGN="LEFT" WIDTH="150" BGCOLOR="#EEEEEE">
<FONT FACE="Arial" COLOR="FF0000" STYLE="font-size: 10px; font-family:arial,sans-serif"><B>Skipped</B></FONT>
<FONT FACE="Arial" STYLE="font-size: 10px; font-family:arial,sans-serif"> (<I>$note</I>)</FONT>
</TD>

<TD ALIGN="LEFT" BGCOLOR="#EEEEEE" WIDTH=415>
<FONT FACE="Arial" STYLE="font-size: 10px; font-family:arial,sans-serif"><B><A HREF="$url" TARGET="_BLANK">$wurl</A></B></FONT>
</TD>

</TR>

</TABLE>
	
</TD></TR></TABLE>	
EOF


}




###################
##  Sanity Check ##
###################
# Sanity checks all %FORM data as its passing into the cgi.
# Params: Nothing. Just grabs the globally accessible %FORM array for sanity checking
# Return: Nothing. Takes proper action based on the sanity result of each expect input.
# Usage: sanityCheck()
sub sanityCheck {

	print "CHECKING SANITY<BR>\n" if ($Debug == 1);
	
	
	
	
	# Session Name Sanity Checks
	if (defined $FORM{'M_SESSION'}) { # Session Name Exists
	
		if (($FORM{'M_SESSION'} ne "NO SESSION") && ($FORM{'M_SESSION'} =~ /^([\w\d\s]{1,32})$/i)) { # Session Name Exists, but Valid?
	
			# Path to Current Session Directory
			$session_path = $session_dir . $FORM{'M_SESSION'};
			
			# Session path test if Exists
			if (-e $session_path) { # Session Dir Exists
				
				# check if session path is a directory
				if (-d $session_path) { # Session path is a directory
					
					# check if session path is writable
					if (-w $session_path) { # Session path is writable
						$mData{'SESSION'} = $FORM{'M_SESSION'};	# Set Session Name
			
						print "M: SESSION NAME: $mData{'SESSION'}<BR>\n" if ($Debug == 1);
						print "SESSION DIR: $session_dir PATH: $session_path<BR>\n" if ($Debug == 1);

						# Spider Results Path
						$spider_results = $session_path . "/" . $spider_file;
			
						# Web Applications Results Path
						$webapplications_results = $session_path . "/" . $webapplications_file;

						print "SPIDER PATH: $spider_results WEBAPPLICATIONS PATH: $webapplications_results<BR>\n" if ($Debug == 1);

						# Check if Spider Results Path exists. If not, Start XML File
						if (!-e $spider_results) {
							open(RES, ">$spider_results") || die "Cant create $spider_results $!\n";
							print RES "<?xml version=\"1.0\"?>\n";
							print RES "<?xml-stylesheet type=\"text/xsl\" href=\"/wharsenal/styles/spider.xsl\"?>\n";
							print RES "<HTMLPAGES>\n";
							print RES "</HTMLPAGES>";
							close(RES);
							
							
						} else { # Seed in Spider Log file URLs. Support For continous spidering
							my $pages = XMLin($spider_results);
			
							if (defined $pages->{'WEBPAGE'}) {
							
								# Loop thru web page entries
								for (my $i = 0; $i < scalar (@{$pages->{'WEBPAGE'}}); $i++) {
									my $url = "";
									# Load Files Information
									# Check if there are HTTP Response Headers
									if (defined $pages->{'WEBPAGE'}[$i]->{'REQUEST-INFORMATION'}->{'URL'}) {
										$url = $pages->{'WEBPAGE'}[$i]->{'REQUEST-INFORMATION'}->{'URL'};
										$track{$url} = 1 unless($url eq "");
									}
								}
							}
							
						} # End Spider Results Path if
			
						# Check if Web Applications Results Path exists. If not, Start XML File
						if (!-e $webapplications_results) {
							open(RES, ">$webapplications_results") || die "Cant create $webapplications_results $!\n";
							print RES "<?xml version=\"1.0\"?>\n";
							print RES "<?xml-stylesheet type=\"text/xsl\" href=\"/wharsenal/styles/webapplications.xsl\"?>\n";
							print RES "<WEBAPPLICATIONS>\n";
							print RES "</WEBAPPLICATIONS>\n";
							close(RES);
							
							
						} else { # Seed in Web Applications Log file URLs. Support For continous spidering
							my $webapps = XMLin($webapplications_results);
							
							if (defined $webapps->{'WEBAPPLICATION'}) { 
								# Loop thru web page entries
								for (my $i = 0; $i < scalar (@{$webapps->{'WEBAPPLICATION'}}); $i++) {
									my $url = "";
									# Load Files Information
									# Check if there are HTTP Response Headers
									if (defined $webapps->{'WEBAPPLICATION'}[$i]->{'URL'}) {
										$url = $webapps->{'WEBAPPLICATION'}[$i]->{'URL'};
										$track{$url} = 1 unless($url eq "");
									}
								}
							}
						} # End Web Applications Results Path if
				

					} 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{'M_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 a 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{'M_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{'M_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{'M_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
	
	
	# Sanity Check Method
	if (defined $FORM{'R_METHOD'}) { # If Method Given
		if($FORM{'R_METHOD'} =~ /^([\w\d\-]){1,36}/) { # Method
			$rData{'METHOD'} = $FORM{'R_METHOD'};	# Set Method
			print "R: METHOD: $rData{'METHOD'}<BR>\n" if ($Debug == 1);
		} else { # No Valid METHOD Given. Default
			$rData{'METHOD'} = "GET";	# Set Method
		} # End Method Sanity Check if
	
	} else { # No Method Given
		$rData{'METHOD'} = "GET";	# Set Method
	} # End Method Check If
			
			
			
	
	# Check if URL is absoulute
	if ($FORM{'R_URL'} =~ /^(http)([s]?)(:\/\/)(.*)/) {
		print "URL " . $FORM{'R_URL'} . "<BR>\n" if ($Debug == 1);
		
		
		my @uri_parts = LW::utils_split_uri($FORM{'R_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{'R_USERNAME'}, 0, 256) unless ($rData{'USERNAME'} ne "");
	$rData{'PASSWORD'} = substr($FORM{'R_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{'M_MIMICK'}) { # If Mimic Given
	
		# Browser Mimic Sanity Check
		if($FORM{'M_MIMICK'} =~ /^(ON|OFF)$/i) {
			$mData{'MIMICK'} = $FORM{'M_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{'M_HTTP_FIX'}) {
		if ($FORM{'M_HTTP_FIX'} =~ /^(ON|OFF)$/i) {
			$mData{'HTTP_FIX'} = $FORM{'M_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{'M_HOST_FIX'}) {
		if ($FORM{'M_HOST_FIX'} =~ /^(ON|OFF)$/i) {
			$mData{'HOST_FIX'} = $FORM{'M_HOST_FIX'};
			print "M: HOST FIX: $mData{'HOST_FIX'}<BR>\n" if ($Debug == 1);
		} else {
			$mData{'HOST_FIX'} = "ON"; 
		} 
	
	} else {
		$mData{'HOST_FIX'} = "ON";  
	} 
	
	
	
	
	if(defined $FORM{'M_MAX'}) {
		if ($FORM{'M_MAX'} =~ /^([\d]{1,6})$/i) {
			$mData{'MAX'} = $FORM{'M_MAX'};
			print "M: MAX: $mData{'MAX'}<BR>\n" if ($Debug == 1);
		} elsif ($FORM{'M_MAX'} eq "UNLIMITED") {
			$mData{'MAX'} = "100000";
		} else {
			$mData{'MAX'} = "25"; 
		} 

	} else {
		$mData{'MAX'} = "25";  
	} 
	
	
	
	# Set HTTP Request Headers
	$rData{'HEADERS'} = $FORM{'R_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
	
	
	
} # End Check 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


