#!c:\perl\bin\perl

# ========================================================================
# Hello! This is the source code for the ELZA interpreter.
# Make sure you edit elza.def before using this script.
# This script is placed in the public domain. Use as you see fit.
# The homepage of the project is http://phiphi.hypermart.net .
# The contact email is philip_stoev@iname.com. Feedback is always welcome.
# ========================================================================

use Socket;

$DEF{'version'} = '1.4.3';	# ELZA Version

# Read various default values from elza.def
$DEFAULTS = 'elza.def';
open DEFAULTS or shout ('critical', "Unable to open defaults file $DEFAULTS: $!");
foreach $Line (<DEFAULTS>) {eval $Line;}
close DEFAULTS;

if ($DefaultsReviewed != 1) {
	shout ('critical', "Please review the defaults in $DEFAULTS before running the ELZA.");
}

# Initally, no successful requests
$VAR{'tot_req'} = 0;	$SuccessfulRequests = 0;
$BytesSent = 0;		$VAR{'tot_rcv'} = 0; 
$VAR{'tot_ok'} = 0;		$RedirRequests = 0;
$VAR{'tot_pass'} = 0;
$SocketOpened = 0;

# We will normally have 2nd and 3rc command line parameter if we are forked.
$VAR{'instance'} = $ARGV[1];
$VAR{'instances'} = $ARGV[2];

# Unbuffer STDOUT, otherwise Linux misbehaves on printraw statements.
$| = 1;

$LastPosition = 0;

# If we are called via GET / HEAD ...
if (($ENV{'REQUEST_METHOD'} ne '') && ($ENV{'REQUEST_METHOD'} ne 'POST')) {
	print STDOUT "Content-type: text/plain\n\n";
	print STDOUT "Please execute ELZA with POST.\n";
	exit;
}

# If we are called via a POST ...
if ($ENV{'REQUEST_METHOD'} eq 'POST') {
	# Read the fields of the form
	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	@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;
		$FORM{$name} = $value;
		shout ('verbose' , "Received from POST request: $name \= $value .");
	}
	if ($FORM{'silent'} eq 'on') {
		$VAR{'silent'} = $FORM{'silent'};
	} else {
		shout ('raw', 'Content-type: text/plain\n\n');
		shout ('normal', "--- Hello. This is the ELZA interpreter version $DEF{'version'}.");
		shout ('normal', "--- Running in remote mode. Called from $ENV{'REMOTE_ADDR'} .");
	}
	# The file to execute is within the 'elza-web-script' field
	$SCRIPT = "<$FORM{'elza-web-script'}";	
	$| = 1;
} else {
	# The file to execute is the first argument of the command line
	shout ('info', "Hello. This is the ELZA interpreter version $DEF{'version'}.");
	if ($VAR{'instance'} ne '') {
		shout ('info', "I am instance $VAR{'instance'} of total $VAR{'instances'} instances.");
	}
	if ($ARGV[0] eq '') {
		print STDOUT "??? Please enter script to execute: ";
		$SCRIPT = <STDIN>;
		$SCRIPT =~ s/[\r\n]//g;
		if ($SCRIPT eq '') {
			shout ('critical',"No script name was entered.");
		} else {
			$SCRIPT = '<'.$SCRIPT;
		}
	} else {
		$SCRIPT = '<'.$ARGV[0];
	}
}

$startclock = time();

open SCRIPT or shout ('critical', "Unable to open script $SCRIPT: $!");
shout ('info',"Now processing commands from $SCRIPT");

$IsWebEnabled = 0;
$ProcName = '';
# Process the main command file, labels, procs, etc.
$LineNum = 0;
while (<SCRIPT>) {
	# Strip CR/LF, whitespace, comments
	s/[\r\n]//g;	s/^[ \t]*//;
	next if(/^\#/);	next if( $_ eq '');
	if ($_ =~ /^label (.*)/) {
		if ($ProcName ne '') {
			shout ('critical',"You can not define a label inside a procedure.");
		}

		if ($LABEL{$1} ne '') {
			shout ('critical',"You can not define a label more than once.");
		} else {
			shout ('debug', "PARSE: Label $1");
			$LABEL{$1} = $LineNum - 1;
		}
		next;
	}

	if ($_ =~ /^proc (.*)/) {
		if ($ProcName ne '') {
			shout ('critical', "Nesting of procedure definitions is not allowed.");
		}
		shout ('debug', "PARSE: Proc start $1 .");
		$ProcName = $1;
		@PROC{$ProcName} = ();
		next;
	}

	if ($_ =~ /^endproc (.*)/) {
		if ($1 ne $ProcName) {
			shout ('critical', "Statement \'$_\' does not match the last 'proc' directive.");
		}
		shout ('debug', "PARSE: Proc end $1 .");
		$ProcName = '';
		next;
	}

	if ($_ eq 'elza-web-enabled') {
		$IsWebEnabled = 1;
		shout ('debug', "PARSE: Found elza-web-enabled tag.");
		next;
	}

	if ($ProcName ne '') {
		push @{$PROC{$ProcName}}, $_;
		shout ('debug', "PARSE: Pushing \' $_ \' into proc $ProcName");
	} else {
		push @RawScript, $_;
		shout ('debug', "PARSE: Pushing \' $_ \' into script body");
		$LineNum ++;
	}
}

if ($ProcName ne '') {
	shout ('critical', "An 'endproc' statement is missing.");
	exit;
}

# End processing main command file

if (($ENV{'REQUEST_METHOD'} eq 'POST') && ($IsWebEnabled == 0)) {
	# The script was called via POST, but the command file was not
	# specifically marked. This is to avoid attempts to execute
	# files like /etc/passwd, etc.
	print "!!! This file does not have an elza-web-enabled tag.\n";
	exit;
}

# Begin processing commands
$ScriptEnd = $#RawScript;
$LineNum = 0;
while  ($LineNum <= $ScriptEnd) {
	# Process the command
	&ProcessCommand ($RawScript[$LineNum]);
	$LineNum ++;
}

# End command processing loop

sub ProcessCommand {

	my @TempData;
	$TheCommand = $_[0];

	shout ('debug', "PROCESS: Command \' $TheCommand \'");

	# Perform subst substitution
	while (($key,$value) = each %FORM) {
		next if ($TheCommand =~ /^subst $key/);
		if (exists $SUBST{$key}) {
			if ($TheCommand =~ s/$key/$value/g) {
				shout ('debug', "PROCESS: Form subst \' $key \' with \' $value \'.");
			}
		}
	}

	foreach $key (keys %SUBST) {
		next if ($TheCommand =~ /^subst $key/);
		next if ($TheCommand =~ /^call/);
		if ($SUBTYPE{$key} ne 'array') {
			if ($TheCommand =~ s/$key/$SUBST{$key}/g) {
				shout ('debug', "PROCESS: Static subst \' $key \' with \' $SUBST{$key} \'.");
			}
		} else {
			if ($TheCommand =~ /$key/) {
				if ($SUBST{$key} > $#{$SUBARRAY{$key}}) {
					$SUBST{$key} = 0;
				}
				$ArrayValue = ${$SUBARRAY{$key}}[$SUBST{$key}];
				if ($TheCommand =~ s/$key/$ArrayValue/g) {
					shout ('debug', "PROCESS: Dynamic subst \' $key \' with \' $ArrayValue \'.");
				}
				if (!($TheCommand =~ /^print/)) {
					$SUBST{$key}++;
				}
			}
		}
	}

	while (($key,$value) = each %VAR) {
		if ($TheCommand  =~ s/%$key%/$value/g) {
			shout ('debug', "PROCESS: Var subst \'%$key%\' with \' $value \'.");
		}
	}
	
	# Split the command, placing parts in Param and ParamAfter

	my @Param = split(' ',$TheCommand);
	my @ParamAfter = ();
	for $PrmCnt (0..$#Param) {
		$ParamAfter[$PrmCnt] = '';
		for $Index ($PrmCnt..($#Param-1)) {
			$ParamAfter[$PrmCnt] .= "$Param[$Index] ";
		}
		$ParamAfter[$PrmCnt] .= $Param[$#Param];
	}

	if (($Param[0] eq "get") || ($Param[0] eq "post") || ($Param[0] eq "head") || ($Param[0] eq "request")) {
		if ($Param[0] ne 'request') {
			$VAR{'method'} = uc($Param[0]);
		} else {
			$VAR{'method'} = uc($VAR{'method'});
		}

		if ($Param[1] eq "url") {
			# Requesting an ordinary URL. Very simple.
			$VAR{'url'} = $Param[2];

		} elsif ($Param[1] eq "refresh" ) {
			# We will now try to find a "refresh" tag.
			$TagCode = 'refresh';
			$TagMethod = 'number';
			$TagMatch= '1';
			&FindTag;
			if ($FoundTag eq '%%NONE%%') {
				shout ('error', "Did not find an URL to refresh to. ");
			} else {
				($Garbage, $VAR{'url'}) = split (/; url=/i,$FoundTag);
				shout ('verbose', "<<< Refresh to $VAR{'url'}");
			}
		} else {
			# Requesting and URL contained within some tag

			# Look for a <base> tag.
			shout ('debug', "HTML: Looking for a <BASE> tag.");
			$TagCode = 'base';
			$TagMethod = 'number';
			$TagMatch= '1';
			&FindTag;
			if ($FoundTag ne '%%NONE%%') {
				shout ('verbose', "Accepted base URL $VAR{'base'} .");
				$VAR{'base'} = $FoundTag;
			} else {
				shout ('debug', "HTML: No <BASE> tag found.");
				$VAR{'base'} = '';
			}
		
			# Look for the tag specified in the command
			$TagCode = $Param[1];
			$TagMethod = $Param[2];
			$TagMatch = $ParamAfter[3];
			&FindTag;
			if ($FoundTag eq '%%NONE%%') {
				shout ('error', "Unable to locate tag: $ParamAfter[1] .");
				return;
			} else {
				shout ('verbose', "--- URL for $Param[0] located: $FoundTag .");
			}

			# If the next URL is not absolute, add <base>
			if ($FoundTag =~ /($DEF{'http'}|$DEF{'https'})/) {
				$VAR{'url'} = $FoundTag;
			} else {
				$VAR{'url'} = $VAR{'base'}.$FoundTag;
			}
		}
	
		# Send the next request.
		&SendRequestToHost;
		%FLD = ();
		shout ('debug', "REQUEST: We are done with \' $TheCommand \'");
		return;
	}

	if ($Param[0] eq 'pause') {
		print STDOUT "--- Ran into pause command. Hit ENTER to continue ...";
		$Bogus = <STDIN>;
		return;
	}

	if ($Param[0] eq "sleep") {
		shout ('verbose', "Ran into sleep command. Sleeping for $Param[1] second(s) ...");
		sleep $Param[1];
		return;
	}

	if ($Param[0] eq "exec") {
		shout ('verbose', "Executing $ParamAfter[1] ...");
		eval($ParamAfter[1]);
		return;
	}

	if (($Param[0] eq "subst") || ($Param[0] eq 'field') || 
		($Param[0] eq 'var') || ($Param[0] eq 'cookie')) {

		$TempValue = '';
		$ToBeDeleted = 0;

		if ($Param[2] eq '=') {
			$TempValue = $ParamAfter[3];
		}

		if ($Param[2] eq 'f=') {
			$TempValue = $FLD{$ParamAfter[3]};
		}

		if ($Param[2] eq 'c=') {
			$TempValue = $COOK{$ParamAfter[3]};
		}

		if ($Param[2] eq '-') {
			$ToBeDeleted = 1;
			shout ('debug', "OPER: Deleting $Param[0] \'$Param[1]\' .");
		}

		if ($Param[2] eq 'between') {
			$BeginHTML = $Param[3];
			$EndHTML = $Param[4];
			&FindHTML;
			if ($FoundHTML eq '%%NONE%%') {
				shout ('error', "Unable to locate HTML between $Param[3] and $Param[4]. ");
				return;
			} else {
				$TempValue = $FoundHTML;
				shout ('verbose', "HTML for $Param[1] located. ");
			}
		}

		if ($Param[2] eq 'line') {
			$FindLineNumber = $Param[3];
			&FindLine;
			return if ($FoundLine eq '%%NONE%%');
			$TempValue = $FoundLine;
		}

		if ($Param[2] eq '@') {
			@TempArray = ();
			for $Element (3..$#Param) {
				push @TempArray, $Param[$Element];
			}
		}

		if ($Param[2] eq 'random') {
			$Range = $Param[4] - $Param[3];
			srand;
			$TempValue = ($Param[3] +  rand $Range);
			$TempValue = sprintf ("%d", $TempValue);
		}

		if ($Param[2] eq 'from') {
			$TagCode = $Param[5];
			$TagMethod = $Param[6];
			$TagMatch = $ParamAfter[7];
			&FindTag;
			if ($FoundTag eq '%%NONE%%') {
				shout ('error', "Unable to locate value for $Param[1] in $ParamAfter[1] .");
				return;
			} else {
				$TempValue = $TAGA{$Param[3]};
				shout ('verbose', "Tag for $Param[1] located: $ParamAfter[5] .");
			}
		}

		if ($Param[2] eq 'raw') {
			$DATAFILE = "<$Param[3]";
			open DATAFILE or shout ('critical', "Unable to open data file $Param[3]: $!");
			binmode DATAFILE;
			read (DATAFILE, $TempValue, 1000000);
			close DATAFILE;
		}

		if ($Param[2] eq '?') {
			if ($ENV{'REQUEST_METHOD'} eq 'POST') {
				# If we are called via POST, we will not get value
				# from STDIN, but from %FORM
				$TempValue = $FORM{$Param[1]};
			} else {
				print STDOUT "??? Please enter value for $Param[0] \'$Param[1]\' [$ParamAfter[3]]: ";
				$TempValue = <STDIN>;
				$TempValue =~ s/[\r\n]//g;
				if ($TempValue eq '') { $TempValue = $ParamAfter[3]};
			}
		}

		if ($Param[2] eq '>') {
			shout ('verbose', "Overflowing $Param[0] \'$Param[1]\' with $Param[3] characters.");
			$TempValue = 'A' x $Param[3];
		}

		if ($Param[2] eq '$') {
			if ($Param[1] ne '%ALL%') {
				$TagCode = 'hidden';
				$TagMethod = 'name';
				$TagMatch = $Param[1];
				&FindTag;
				if ($FoundTag ne '%%NONE%%') {
					$FLD{$Param[1]} = $FoundTag;
				} else {
					shout ('error', "Hidden form field $Param[1] not found.");
				}
			} else {
				$TagEnumerate = 1;
				$TagCode = 'hidden';
				&FindTag;
				$TagEnumerate = 0;
			}
			return;
		}

		if ($Param[0] eq 'subst') {
			if ($ToBeDeleted > 0) {
				delete $SUBST{$Param[1]};
				delete $SUBTYPE{$Param[1]};
			} elsif ($Param[2] eq '@') {
				$SUBTYPE{$Param[1]} = 'array';
				$SUBST{$Param[1]} = 0;
				@{$SUBARRAY{$Param[1]}} = @TempArray;
			} else {
				$SUBST{$Param[1]} = $TempValue;
			}
			return;	
		}

		if ($Param[0] eq 'field') {
			if ($Param[1] eq '%BOGUS%') {
				$BogusField = 1;
				$BogusFieldSize = $Param[3];
				$BogusTextSize = $Param[4];
			} elsif ($ToBeDeleted > 0) {
				delete $FLD{$Param[1]};
			} else {
				$FLD{$Param[1]} = $TempValue;
			}
			$AnyFields = 1;
			return;
		}

		if ($Param[0] eq 'var') {
			$VAR{$Param[1]} = $TempValue;
			if ($Param[1] eq "rawfile") {
				unlink $VAR{'rawfile'};
			} elsif ($Param[1] eq "proxy") {
				shout ('verbose', "Bouncing through $Param[3] on port $Param[4]. ");
				$VAR{'proxyhost'} = $Param[3];
				$VAR{'proxyport'} = $Param[4];
				&CloseTheSocketForMe;
			} elsif (($Param[1] eq "proxyhost") || ($Param[1] eq "proxyport")) {
				&CloseTheSocketForMe;
			} elsif ($Param[1] eq "sockshost") {
				&CloseTheSocketForMe;
			} elsif ($Param[1] eq 'dictionary'){
				$DICTFILE = "<$TempValue";
				open DICTFILE or shout ('critical', "Unable to open dictionary $TempValue: $! .");
			} elsif ($Param[1] eq 'autopass') {
				$VAR{'password'} = $VAR{'autopass'};
			} elsif ($Param[1] eq 'password') {
				$VAR{'autopass'} = '';
			} elsif ($Param[1] eq 'autoresume') {
				# If we are about to resume a previous attack,
				# retrieve the current status
				$TEMPFILE = $VAR{'tmpfile'}.$VAR{'instance'};
				open TEMPFILE;
				$LastPosition = <TEMPFILE>;
				if ($LastPosition eq '') {
					$LastPosition = 1;
				} else {
					$LastPosition++;
					shout ('normal', "--- We will start from data line number $LastPosition .");
				}
				close TEMPFILE;
			}
			return;
		}

		if ($Param[0] eq 'cookie') {
			if ($ToBeDeleted > 0) {
				if ($Param[1] eq '%ALL%') {
					undef %COOK;
				} else {
					delete $COOK{$Param[1]};
				}
			} elsif ($Param[2] eq 'path') {
				$COOKP{$Param[1]} = $TempValue;
			} elsif ($Param[2] eq 'domain') {
				$COOKD{$Param[1]} = $TempValue;
			} else {
				$COOK{$Param[1]} = $TempValue;
			}
			return;
		}

		shout ('critical', "Syntax errror: $ParamAfter[0] .");
	}

	if ($Param[0] eq 'if') {
		if (($Param[1] =~ /$Param[3]/si) && ($Param[2] eq '==')) {
		      &ProcessCommand ($ParamAfter[4]);
		}

		if ((!($Param[1] =~ /$Param[3]/si)) && ($Param[2] eq '!=')) {
		      &ProcessCommand ($ParamAfter[4]);
		}

		if (($Param[1] > $Param[3]) && ($Param[2] eq '>')){
		      &ProcessCommand ($ParamAfter[4]);
		}

		if (($Param[1] < $Param[3]) && ($Param[2] eq '<')){
		      &ProcessCommand ($ParamAfter[4]);
		}
		return;
	}

	if ($Param[0] eq 'goto') {
		if ($Param[2] eq 'if') {
			if (($Param[3] =~ /$ParamAfter[5]/si) && ($Param[4] eq '==')) {
			      $LineNum = $LABEL{$Param[1]};
			}

			if ((!($Param[3] =~ /$ParamAfter[5]/si)) && ($Param[4] eq '!=')) {
		            $LineNum = $LABEL{$Param[1]};
			}

			if (($Param[3] > $ParamAfter[5]) && ($Param[4] eq '>')){
		            $LineNum = $LABEL{$Param[1]};
			}

			if (($Param[3] < $ParamAfter[5]) && ($Param[4] eq '<')){
		            $LineNum = $LABEL{$Param[1]};
			}
		} else {
	            $LineNum = $LABEL{$Param[1]};
		}
		return;
	}

	if ($Param[0] eq 'call') {
		if ($Param[2] eq 'if') {
			if (($Param[3] =~ /$ParamAfter[5]/si) && ($Param[4] eq '==')) {
				&ExecProc ($Param[1]);
			}
			if ((!($Param[3] =~ /$ParamAfter[5]/si)) && ($Param[4] eq '!=')) {
				&ExecProc ($Param[1]);
			}
			if (($Param[3] > $Param[5]) && ($Param[4] eq '>')) {
				&ExecProc ($Param[1]);
			}
			if (($Param[3] < $Param[5]) && ($Param[4] eq '<')) {
				&ExecProc ($Param[1]);
			}
			return;
		}

		if ($Param[2] eq '') {
			&ExecProc ($Param[1]);
			return;
		}

		if ($#{$PROC{$Param[1]}} == -1) {
			shout ('error', "Proc $Param[1] not defined.");
		}

		if ($Param[3] eq '@') {
			# Push the array specified in the directive
			for $Element (4..$#Param) {
				push @TempData, $Param[$Element];
			}
		}

		if ($Param[3] eq 'eachfield') {
			# Rotate for every field available
			@TempData = keys %FLD;
		}

		if ($Param[3] eq '#') {
			for $Element ($Param[4]..$Param[5]) {
				push @TempData, $Element;
			}
		}

		if ($Param[3] eq '?') {
			# Read from STDIN
			$ValueCount = 1;
			print STDOUT "??? Please enter values for \'$Param[2]\', then blank line to continue:\n";
			print STDOUT "??? Value number $ValueCount: ";
			RSTD: while (<STDIN>) {
				s/[\r\n]//g;
				if ($_ eq '') {	last RSTD;}
				push @TempData, $_;
				$ValueCount++;
				print STDOUT "??? Value number $ValueCount: ";
			}
			if ($#TempData == -1) {
				shout ('error', "No values entered. Skipping proc.");
				return;
			}
		}

		if (($Param[3] eq '%') || ($Param[3] eq 'forked')) {
			# Push the data from the file specified
			$VarFile = $Param[4];
			$DATAFILE = "<$VarFile";
			open DATAFILE or shout ('critical', "Unable to open data file $VarFile: $! .");
			$PushStart = $LineNum + 1;
			$FileLine =0;
			while (<DATAFILE>) {
				$_ =~ s/[\r\n]//g;
				next if ($_ eq '');
				if (($Param[3] eq 'forked') && ($VAR{'instances'} ne '')) {
					# Guys, we are forked, so we skip
					# if the line is not for us
					$Modulus = $FileLine % $VAR{'instances'};
					$FileLine++;
					next if (($Modulus + 1) != $VAR{'instance'});
				}
				push @TempData, $_;
			}
			close DATAFILE;
		}

		# And, finally, execute the proc
		$TempPosition = 0;
		foreach $SubstValue (@TempData) {
			$TempPosition++;
			next if ($LastPosition > $TempPosition);
			$SUBST{$Param[2]} = $SubstValue;
			&ExecProc ($Param[1]);
			if ($VAR{'autoresume'} eq 'on') {
				$TEMPFILE = '>'.$VAR{'tmpfile'}.$VAR{'instance'};
				open TEMPFILE or die 'gooofed';
				print TEMPFILE $TempPosition;
				close TEMPFILE;
			}
		}
		unlink $VAR{'tmpfile'}.$VAR{'instance'};
		return;
	}

	if ($Param[0] eq 'exit') {
		print " Exiting ... \n";
		exit;
	}

	if ($Param[0] eq 'print') {
		shout ('user', $ParamAfter[1]);
		return;
	}

	if ($Param[0] eq 'printraw') {
		shout ('raw', $ParamAfter[1]);
		return;
	}

	if ($Param[0] eq 'continue') {
		return;
	}

	if ($Param[0] eq 'hostmap') {
		if ($Param[3] ne '-') {
			$HOSTMAP{"$Param[1]:$Param[2]"} = $Param[3];
			$PORTMAP{"$Param[1]:$Param[2]"} = $Param[4];
		} else {
			delete $HOSTMAP{"$Param[1]:$Param[2]"};
			delete $PORTMAP{"$Param[1]:$Param[2]"};
		}
		return;
	}

	if ($Param[0] eq 'noproxy') {
		if ($Param[3] ne '-') {
			$NOPROXY{"$Param[1]:$Param[2]"} = 'on';
		} else {
			delete $NOPROXY{"$Param[1]:$Param[2]"};
		}
		return;
	}

	if ($Param[0] eq 'stats') {
		# Printing statistics
		$lenclock = time() - $startclock;
		$lenclock = 1 if ($lenclock == 0);
		($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($lenclock);
		$density = sprintf ("%d", ($VAR{'tot_req'} / $lenclock));
		$TotalBytes = $BytesSent + $VAR{'tot_rcv'};
		shout ('user', "Time:      $hour hrs / $min min / $sec sec - total $lenclock seconds.");
 		shout ('user', "STAT: Requests:  $VAR{'tot_req'} total, $SuccessfulRequests successful - $density requests / sec.");
		shout ('user', "STAT: Responses: $VAR{'tot_ok'} OK, $RedirRequests redirects.");
		shout ('user', "STAT: Bytes:     $TotalBytes total, $BytesSent sent.");
		$speed = sprintf ("%d", ($VAR{'tot_rcv'} / $lenclock));
		shout ('user', "STAT: Received:  $VAR{'tot_rcv'} bytes - $speed bytes / sec.");
		return;
	}

	shout ('critical', "Syntax error: $ParamAfter[0] .");
}

sub ExecProc {
	shout ('debug', "PROC: Executing proc \' $_[0] \'.");
	for $Index (0..$#{$PROC{$_[0]}}) {
		&ProcessCommand ($PROC{$_[0]}[$Index]);
	}
}


sub ParseURLParts {
# This subroutine will try to canonize an absolute or relative URL

	if ($VAR{'prefix'} eq '') {$VAR{'prefix'} = $DEF{'http'};}

	if ($VAR{'host'} eq '') {
		shout ('debug', "URL: Host not specified. Defaulting to \' $DEF{'host'} \'.");
		$VAR{'host'} = $DEF{'host'};
	}

	if ($VAR{'port'} eq '') {$VAR{'port'} = $DEF{'port'};}

	if ($VAR{'url'} =~ /^($DEF{'http'}|$DEF{'https'})(.*)/) {
		# The URL is absolute. Parsing...
	
		$RestPortion = $2;
		$VAR{'prefix'} = $1;

		if ($RestPortion =~ /\//) {
			$RestPortion =~ /^(.*?)\/(.*)/;
			$HostPortion = $1;
			$VAR{'request'} = '/'.$2;
		} else {
			$HostPortion = $RestPortion;
			$VAR{'request'} = '/';
		}

		# Set ports depending on protocol

		if ($VAR{'prefix'} eq $DEF{'https'}) {
			if ($VAR{'honorhttps'} ne 'no') {
				$VAR{'ssl'} = 'on';
			}
			$VAR{'port'} = $DEF{'sslport'};
		} else {
			$VAR{'ssl'} = 'no';
			$VAR{'port'} = $DEF{'port'};
		}

		# If URL contains port, use it instead
		if ($HostPortion =~ /:/) {
			($VAR{'host'}, $VAR{'port'}) = split (':',$HostPortion);
		} else {
			$VAR{'host'} = $HostPortion;
		}
	} else {
		#The URL is relative
		if (!($VAR{'url'} =~ /^\// ) ) {
			# The URL does not begin with '/'
			shout ('debug', "URL: \' $VAR{'url'} \' is relative. Have that in mind.");
			if ($VAR{'request'} =~ /\/$/) {
				# The last URL was a directory, so we append
				$VAR{'request'} = $VAR{'request'}.$VAR{'url'};
			} else {
				# The last URL was a file, so we find the dir
				$VAR{'request'} =~ /(.*)\/(.*?)/;
				$VAR{'request'} = $1.'/'.$VAR{'url'};
			}
		} else {
			# The URL begins with '/' => server root
			$VAR{'request'} = $VAR{'url'};
		}

		#Glue parts together
		$VAR{'url'} = $VAR{'prefix'}.$VAR{'host'}.':'.$VAR{'port'}.$VAR{'request'};
	}
}

sub ParseHeaderParts {

	($VAR{'protoversion'}, $VAR{'retcode'}, $VAR{'rettext'}) = split (' ', $RawResponse[0]);

	if (($InAttack > 0) && ($VAR{'retcode'} != '401') &&
		($VAR{'retcode'} != '400') &&  ($VAR{'retcode'} != '500')
		&& ($VAR{'dictionary'} ne '')) {
		shout ('normal', "\n--- Successful pair: $VAR{'user'} : $VAR{'autopass'} . Deactivating dictionary.");
		$VAR{'password'} = $VAR{'autopass'};
		$VAR{'dictionary'} = '';
		$InAttack = 0;
	}

	if (($InAttack > 0) && ($VAR{'retcode'} == '401')
		&& ($VAR{'dictionary'} ne '')) {
		# Display dots if we do a dictionary attack
		if ($VAR{'silent'} ne 'on') {print STDOUT '.';}
	} else {
		# Display the response otherwise
		shout ('normal', "<<< Response: $RawResponse[0]");
	}
	
	$InHeader = 2;

	foreach $RawResponseLine (@RawResponse) {

		if ($InHeader == 2) {
			# We are on the 1st line, so we skip
			$InHeader = 1;
			next;
		}
		# Check if we are entering the HTML
		if (($RawResponseLine eq '') || ($RawResponseLine eq "\r") || ($RawResponseLine eq "\r\n")) {
			$InHeader = 0;
			next;
		}

		if ($InHeader == 1) {
			$RawHeaders.="$RawResponseLine\n";
			# Parse the header
			($RawHeader, $RawHeaderValue) = split (': ',$RawResponseLine);

			shout ('debug', "HTTP: Header $RawHeader = $RawHeaderValue .");
			$VAR{$RawHeader} = $RawHeaderValue;

			# Extract the cookies
			if ($RawHeader eq 'Set-Cookie') {
				@CookieParams = ();

				# Split the cookie
				@CookieParts = split(';',$RawHeaderValue);

				if ($CookieParts[0] eq '') {
					# If we are sent a cookie without parameters, handle that
					shout ('error', "Malformed cookie received: $RawHeaderValue .");
				} else {
					# Extract name and value from the first part
					# This is not done with split, because I have
					# seen cookies with '=' in them.
					$CookieParts[0] =~ /(.*?)=(.*)/;
					$CookieName = $1; $CookieVal = $2;
					$COOK{$CookieName} = $CookieVal;

					# Extract cookie attributes
					foreach $CookiePart (@CookieParts) {
						($CookieParamName, $CookieParamValue) = split('=',$CookiePart);
						$CookieParamName =~ s/^[ \t]*//;	#Strip whitespace
						$CookieParams{lc($CookieParamName)} = lc($CookieParamValue);
					}
			
					# Place cookie parts in the arrays
					$COOKP{$CookieName} = $CookieParams{'path'};
					$COOKD{$CookieName} = $CookieParams{'domain'};
							
					print "<<< Cookie: $CookieName = $CookieVal\n";
				}
	               	}
		} else {
			# We are in the body
			$VAR{'body'}.="$RawResponseLine\n";
		}
	}

}

sub ParseRawResponse {

	&PrintToRaw;

	# Act upon a redirect
	if (($VAR{'retcode'} eq '301') or ($VAR{'retcode'} eq '302')) {
		$RedirRequests++;
		shout ('normal', "<<< Redirect: $VAR{'Location'} .");
		if ($VAR{'autoredir'} eq 'on') {
			$VAR{'url'} = $VAR{'Location'};
			$VAR{'method'} = "GET";
			%FLD = ();
			$AnyFields = 0;
			&SendRequestToHost;
		} else {
			shout ('debug', "HTTP: The redirect will not be followed automatically. Do it yourself.");
		}
		return;
	}

	# Act upon request for authentication by giving credentials
	if ($VAR{'retcode'} eq '401') {

		# Parsing the authenticate header
		if (!($VAR{'WWW-Authenticate'} =~ /(.*) realm=\"(.*?)\"/)) {
			shout ('error', "Unable to parse $VAR{'WWW-Authenticate'} .");
			return;
		} else {
			$VAR{'ses_auth'} = $1;
			$VAR{'ses_realm'} = $2;
		}

		if ($VAR{'ses_auth'} eq 'Digest') {
			if (!($VAR{'WWW-Authenticate'} =~ /(.*) nonce=\"(.*?)\"/)) {
				shout ('error', "Unable to parse $VAR{'WWW-Authenticate'} .");
				return;
			} else {
				$VAR{'ses_nonce'} = $2;
			}
			shout ('debug', "DIGEST: Server nonce: $VAR{'ses_nonce'}.");
		}

		if (($VAR{'dictionary'} ne '') && ($VAR{'password'} eq '')) {
			$VAR{'autopass'} = <DICTFILE>;
			if ($VAR{'autopass'} eq '') {
				shout ('error', "Dictionary file exhausted. $VAR{'tot_pass'} passwords tried.");
				return;
			}
			$VAR{'autopass'} =~ s/[\r\n]//g;
			$VAR{'tot_pass'}++;
			shout ('debug', "HTTPAUTH: Dictionary gave \' $VAR{'autopass'} \' as password.");
		} else {
			if ($VAR{'password'} eq ''){
				shout ('error', "No HTTP password defined.");
				return;
			}
			if ($VAR{'autopass'} eq $VAR{'password'}) {
				shout ('error', "Server did not accept HTTP password.");
				return;
			} else {
				$VAR{'autopass'} = $VAR{'password'};
			}
		}

		if ($VAR{'realm'} ne $VAR{'ses_realm'}) {
			shout ('error', "No user/pass pairs for realm \"$2\".");
			return;
		}
		$InAttack = 1;

		&SendRequestToHost;
		return;
	}

	if ($VAR{'retcode'} ne '200') {
		&ProcessError;
	} else {
		$VAR{'tot_ok'}++;
	}
}

sub FindTag {
# This engine will scan HTML for tags and return the info contained within
# number, raw, and text are artificial tag attributes

	if ($VAR{'container'} ne '') {
		$WorkingSpace = $VAR{'container'};
		shout ('debug', "FINDTAG: Restricted in a container of ".length($VAR{'container'})." bytes.");
	} else {
		$WorkingSpace = $VAR{'body'};
		shout ('debug', "FINDTAG: Working on an HTML body of ".length($VAR{'body'})." bytes.");
	}

	$FoundTag = '%%NONE%%';
	$TagNumber = 0;

	while ($WorkingSpace =~ s/$TagBegin{$TagCode}(.*?)$RightBrack//is) {
		$TagRest = $'; $TagNumber++;
		$TagBody = $1;
		%TAGA = ();
		$TAGA{'body'} = $TagBegin{$TagCode}.$1.$RightBrack;
		if ($TagClose{$TagCode} ne '') {
			# Tag has a close tag -> find the HTML within
			if ($TagRest =~ s/(.*?)$TagClose{$TagCode}//is) {
				$TagText = $1;
				$TAGA{'raw'} = $TagText;
				$TagText =~ s/$LeftBrack(.*?)$RightBrack//igs;
				$TagText =~ s/  / /ig;
				$TagText =~ s/&nbsp;/ /ig;
				$TAGA{'text'} = $TagText;
			}
		}

		$TAGA{'number'} = $TagNumber;

		# Collect all attributes of the tag.
		while ($TagBody =~ s|^(([a-zA-Z][a-zA-Z0-9\.\-_]*)\s*)||) {
			$TagAttrib = $2;
			$AttribValue = '';
			if ($TagBody =~ s|(^=\s*([\"\'])(.*?)\2\s*)||s) {
				$AttribValue = $3;
			} elsif ($TagBody =~ s|(^=\s*([^\"\'>\s][^>\s]*)\s*)||) {
				$AttribValue = $2;
			}
			$TAGA{lc($TagAttrib)} = $AttribValue;
		}

		if ($TagCode eq 'hidden') {
			if (lc($TAGA{'type'}) eq 'hidden') {
				$FoundTag = $TAGA{$TagVal{$TagCode}};
			}
		} elsif ($TagCode eq 'refresh') {
			# We have to find a refresh tag.
			# it is in fact a meta http-equiv tag.
			if (lc($TAGA{'http-equiv'}) eq 'refresh') {
				$FoundTag = $TAGA{$TagVal{$TagCode}};
			}
		} else {
			# We are looking for an ordinary tag.
			# See if we match.
			if ($TAGA{$TagMethod} =~ /$TagMatch/) {
				$FoundTag = $TAGA{$TagVal{$TagCode}};
			}
		}
		if ($TagEnumerate > 0) {
			# We have to find all occurences of this tag so
			# we do not stop parsing here.
			if (lc($TAGA{'type'}) eq 'hidden') {
				$FLD{$TAGA{'name'}} = $TAGA{'value'};
				print "<<< Field: $TAGA{'name'} = $FLD{$TAGA{'name'}}\n";
				$AnyFields = 1;
			}
		} else {
			if ($FoundTag ne '%%NONE%%') {
				return;
			}
		}
	}
}

sub FindHTML {

	if ($VAR{'container'} ne '') {
		$WorkingSpace = $VAR{'container'};
	} else {
		$WorkingSpace = $VAR{'body'};
	}

	$FoundHTML = '%%NONE%%';
	if ($WorkingSpace =~ s/$BeginHTML(.*?)$EndHTML//is) {
		$FoundHTML = $1;
	}
}

sub FindLine {
	$FoundLine = '%%NONE%%';
	if (!(defined $RawResponse[$FindLineNumber])) {
		shout ('error', "Line number $FindLineNumber does not exist.");
	} else {
		$FoundLine = $RawResponse[$FindLineNumber];
		chomp $FindLineNumber;
	}
}

sub SSLSpawnTunnel {
	my $TmpCmdLine;
	
	$TmpCmdLine = $DEF{'sslcmd'};
	$TmpCmdLine =~ s/SSLHOST/$SSLRemoteHost/g;
	$TmpCmdLine =~ s/SSLPORT/$SSLRemotePort/g;
	$TmpCmdLine =~ s/SSLLOCAL/$VAR{'ssllocal'}/g;

	if ($DEF{'sslconsole'} > 0 ) {
		$SSLProcessFlags = CREATE_NEW_CONSOLE;
	} else {
		$SSLProcessFlags = DETACHED_PROCESS;
	}

	#Spawn SSL Tunnel.
	shout ('verbose', "Spawning SSL Tunnel to $VAR{'host'}:$VAR{'port'}. Local port is $VAR{'ssllocal'}. ");
	if ($^O =~ /Win/) {
		# Win32::Process::Create and Win32::Sleep are hidden
		# behind print so that the interpreter does not complain
		# about undeclated functions under non-Win32 systems.
		print Win32::Process::Create($SSLTunnelPID, $DEF{'sslapp'}, $TmpCmdLine, 0, $SSLProcessFlags, ".") || die "Unable to spawn SSL Tunnel $!";

		# Sleeping a little bit is necessary to give stunnel.exe
		# time to start listening to the port. Otherwise, we will
		# not be able to connect and an error will occur.
		# Sorry for this race condition ...
		print " Spawned. Waiting for 5 seconds ...";
		print Win32::Sleep 5000;
		print " done ...\n";
	} else {
		print `$TmpCmdLine`;
		print " Spawned.\n";
	}

	$SSLTunnelFunctional = 1;
}

sub SSLKillTunnel {

	return if ($SSLTunnelFunctional != 1);
	
	shout ('verbose', "Killing SSL Tunnel to $VAR{'host'}:$VAR{'port'}. ");
	if ($^O =~ /win/i) {
		$SSLTunnelPID->Win32::Process::Kill('') || die "Unable to kill SSL Tunnel $DEF{'sslapp'}. Kill it yourself.";
	} else {
		`killall $DEF{'sslapp'}`;
	}

	$SSLTunnelFunctional = 0;
}

sub SendRequestToHost {
	&ParseURLParts;
	if ($#{$PROC{'BEFOREREQUEST'}} != -1) {&ExecProc ('BEFOREREQUEST')};
	$CombinedFields = '';
	$VAR{'container'} = '';
	$VAR{'body'} = '';
	$VAR{'Location'} = '';
	$VAR{'Set-cookie'} = '';
	@RawResponse = ();
	$RawHeaders = '';
	$PrevRawHost = $RawHost;
	$PrevRawPort = $RawPort;
	$VAR{'tot_req'}++;

	if ($AnyFields > 0 ) {
		# Build QUERY string
		while (($key,$value) = each %FLD) {
			$CombinedFields.="$key=$value&";
			shout ('verbose', ">>> Field: $key=$value");
		}
		$AnyFields = 0;
		$CombinedFields =~ s/ /+/g;
		$CombinedFields =~ s/&$//g;
	}

	if (($VAR{'proxyhost'} ne '') && ($NOPROXY{"$VAR{'host'}:$VAR{'port'}"} eq '')) {
		# If using proxy, send entire URL
		$RawRequest = $VAR{'url'};
	} else {
		# If not, send just the relative URL
		$RawRequest = $VAR{'request'};
	}

	if ($BogusField > 0) {
		$CombinedFields.= 'F' x $BogusFieldSize;
		$CombinedFields.= '=';
		$CombinedFields.= 'V' x $BogusTextSize;
		$CombinedFields.= '&';
		$BogusField = 0;
	}

	if (($VAR{'method'} eq 'GET') && ($CombinedFields ne '')){

		if (!($RawRequest =~ /\?/)) {
			$RawRequest.='?';
		}

		# Append fields to the URL
		$RawRequest.=$CombinedFields;
	}

	# Perform anti-IDS encoding (courtesy of r.f.p)
	if($VAR{'encode'} eq 'on') {
		$RawRequest =~ s/([-a-zA-Z0-9.])/sprintf("%%%x",ord($1))/ge;
	}

	# The first line of the request
	$RawRequest = "$VAR{'method'} $RawRequest $DEF{'protocol'}";

	if (($InAttack < 1) || ($VAR{'dictionary'} eq '')) {
		shout ('normal', ">>> Request: $RawRequest");
	}
	$RawRequest.= "\n";

	# Add the Host: part of the request
	$RawRequest.= "Host: $VAR{'host'}:$VAR{'port'}\n";

	# Add the user agent to the request
	if ($VAR{'sendagent'} eq 'on') {
		$RawRequest.= "User-Agent: $VAR{'agent'}\n";
	}

	# Add various bogus headers to the request
	if ($DEF{'headers'} ne '') {
		$RawRequest.= $DEF{'headers'};
	}

	# Add Referer

	if (($DEF{'sendreferer'} ne 'no') && ($VAR{'Referer'} ne '')) {
		$RawRequest.= "Referer: $VAR{'Referer'}\n";
	}

	# Add authentication
	if ($VAR{'autopass'} ne '') {
		if ($VAR{'ses_auth'} eq 'Digest') {
			my $md5 = new Digest::MD5;
			my(@digest);
			$md5->add(join(":", $VAR{'user'},$VAR{'realm'},$VAR{'autopass'}));
			push(@digest, $md5->hexdigest);
			$md5->reset;
			push(@digest, $VAR{'ses_nonce'});
			$md5->add(join(":",$VAR{'method'},$VAR{'request'}));
			push(@digest, $md5->hexdigest);
			$md5->reset;
			$md5->add(join(":", @digest));
			my($digest) = $md5->hexdigest;
			$md5->reset;
			$TheHeader = "Authorization: Digest username=\"$VAR{'user'}\", realm=\"$VAR{'realm'}\", nonce=\"$VAR{'ses_nonce'}\", uri=\"$VAR{'request'}\", response=\"$digest\"\n";
			$RawRequest.= $TheHeader;
		}
		if ($VAR{'ses_auth'} eq 'Basic') {
			$AuthEncoded = encode_base64($VAR{'user'}.':'.$VAR{'autopass'});
			$RawRequest.= "Authorization: Basic $AuthEncoded\n";
		}
	}

	# Add cookies destined for this path and domain
	$CookieLine = '';
	while (($RawCookieName,$RawCookieVal) = each %COOK) {
		if ($COOKD{$RawCookieName} eq '') {
			shout ('verbose', ">>> Our cookie: $RawCookieName = $RawCookieVal");
			$CookieLine.= "$RawCookieName=$RawCookieVal; ";
			next;
		}

		if ($VAR{'request'} =~ /^$COOKP{$RawCookieName}/) {
			if ($VAR{'host'} =~ /$COOKD{$RawCookieName}/) {
				shout ('verbose', ">>> Their cookie: $RawCookieName = $RawCookieVal");
				$CookieLine.= "$RawCookieName=$RawCookieVal; ";
			}
		} 
	}

	if ($CookieLine ne '') {$RawRequest.= "Cookie: $CookieLine\n";}

	# Self-explanatory. I wonder if I will be able to do
	# persistent connections someday.
	if ($VAR{'keepalive'} eq 'on') {
		$RawRequest.= "Connection: Keep-Alive\n";
		$RawRequest.= "Proxy-Connection: Keep-Alive\n";
	} else {
		$RawRequest.= "Connection: close\n";
	}

	# Add POST data
	if ($VAR{'method'} eq 'POST') {
		# Append fields to the request.
		$RawRequest.="Content-Type: application/x-www-form-urlencoded\n";
		$RawRequest.="Content-Length: ".length($CombinedFields)."\n\n";
		$RawRequest.="$CombinedFields\n";
	}

	# Terminate request
	$RawRequest.="\n";

	# Perform host:port mapping, if any

	if ($HOSTMAP{"$VAR{'host'}:$VAR{'port'}"} ne '') {
		$AfterMapHost = $HOSTMAP{"$VAR{'host'}:$VAR{'port'}"};
		$AfterMapPort = $PORTMAP{"$VAR{'host'}:$VAR{'port'}"};
		shout ("debug", "SOCKET: $VAR{'host'}:$VAR{'port'} will be mapped to $AfterMapHost:$AfterMapPort.");
	} else {
		$AfterMapHost = $VAR{'host'};
		$AfterMapPort = $VAR{'port'};
	}

	# And finally, determine the actual host:port to connect to
	if ($VAR{'ssl'} eq 'on' ) {
		#If it is a SSL request, send through tunnel
		$RawHost = '127.0.0.1';
		$RawPort = $VAR{'ssllocal'};
		$SSLRemoteHost = $AfterMapHost;
		$SSLRemotePort = $AfterMapPort;
		&SSLSpawnTunnel;
	} elsif (($VAR{'proxyhost'} ne '') && ($NOPROXY{"$VAR{'host'}:$VAR{'port'}"} eq '')) {
		# If through proxy, send through proxy
		$RawHost = $VAR{'proxyhost'};
		$RawPort = $VAR{'proxyport'};
		shout ('debug', "SOCKET: Using HTTP proxy $RawHost:$RawPort");
	} else {
		$RawHost = $AfterMapHost;
		$RawPort = $AfterMapPort;
	}

	$BytesSent = $BytesSent + length ($RawRequest);
	$VAR{'ses_rcv'} = 0;
	$VAR{'ses_lines'} = 0;
	$SessionStartTime = Win32::GetTickCount;
	if ($SessionStartTime == 0) {
		$SessionStartTime = (gmtime() * 1000);
	}
	
	$VAR{'Content-Length'} = '';

	if ($VAR{'keepalive'} eq 'on') {
		if (($PrevRawHost ne $RawHost) || ($PrevRawPort ne $RawPort)) {
			# We are connecting to a new host, so we
			# will open the socket again
			shout ('debug', "SOCKET: Making new connection to $RawHost:$RawPort.");
			&CloseTheSocketForMe;
		} else {
			shout ('debug', "SOCKET: Using Keep-Alive connection to $RawHost:$RawPort.");
		}
		if ($SocketOpened != 1) {
			OpenTheSocketForMe ();
			if ($SocketOpened == 0) {return;}
		}
	} else {
		OpenTheSocketForMe ();
		if ($SocketOpened == 0) {return;}
	}
	if (!(print $REMOTE $RawRequest)) {
		shout ('critical',"SOCKET: Unable to send data: $! .");
	} else {
		if ($VAR{'debug'} eq 'on') {
			$DebugRequest = $RawRequest;
			$DebugRequest =~ s/\n/ <CR> /g;
			shout ('debug', "SOCKET: Sending: $DebugRequest");
		}
	}
	# Consume the header
	while (<$REMOTE>) {
		$VAR{'ses_rcv'} = $VAR{'ses_rcv'} + length ($_);
		$_ =~ s/[\r\n]//g;
		last if ($_ eq '');
		push @RawResponse, $_;
	}
	&ParseHeaderParts;
		# If there is body, consume it
	if (($VAR{'method'} ne 'HEAD') && ($VAR{'forcehead'} ne 'on')) {
		if ($VAR{'Content-Length'} eq '') {
			if ($VAR{'binary'} eq 'on') {
				read ($REMOTE, $BinBody, 1000000);
			} else {
				$VAR{'body'} = '';
				while (<$REMOTE>) {
					$VAR{'ses_rcv'} = $VAR{'ses_rcv'} + length ($_);
					$VAR{'body'} .= $_;
				}
			}
		} else {
			read ($REMOTE, $VAR{'body'}, $VAR{'Content-Length'});
		}
	}

	if (($VAR{'Connection'} eq 'close') || ($VAR{'keepalive'} ne 'on')
		|| ($VAR{'Connection'} eq '') || ($VAR{'forcehead'} eq 'on')) {
		&CloseTheSocketForMe;
	}

	select(STDOUT);

	$SessionEndTime = Win32::GetTickCount;
	if ($SessionEndTime == 0) {
		$SessionEndTime = (gmtime() * 1000);
	}
	$VAR{'ses_time'} = (($SessionEndTime - $SessionStartTime) / 1000);
	if ($VAR{'ses_time'} == 0) {$VAR{'ses_time'} = 1};
	$VAR{'tot_rcv'} = $VAR{'tot_rcv'}+ $VAR{'ses_rcv'};
	$VAR{'ses_speed'} = $VAR{'ses_rcv'} / $VAR{'ses_time'};
	$VAR{'ses_speed'} = sprintf ("%d", $VAR{'ses_speed'});
	$SuccessfulRequests++;

	&SSLKillTunnel;

	if ($RawResponse[0] ne '') {
		$VAR{'Referer'} = $VAR{'url'};
		&ParseRawResponse;
	}
}

sub LastWin32Message {
	print Win32::FormatMessage(Win32::GetLastError());
}

sub PrintToRaw {
	if ($VAR{'rawfile'} ne '') {
		open FILEOUT, ">>$VAR{'rawfile'}" or die "Unable to open raw file $VAR{'rawfile'}: $!";
		if ($VAR{'binary'} eq 'on') {
			binmode FILEOUT;
			print FILEOUT $BinBody;
			shout ('verbose', "--- Saved a binary of ".length($BinBody). " bytes. ");
		} else {
			if ($VAR{'dumprequest'} ne '') {
				print FILEOUT "$RawRequest";
			}
	
			if ($VAR{'dumpheaders'} ne '') {
				print FILEOUT "$RawResponse[0]\n";
				print FILEOUT "$RawHeaders\n";
			}

			if ($VAR{'dumpbody'} ne '') {
				print FILEOUT $VAR{'body'};
			}

			print FILEOUT "\n";
		}
		close FILEOUT;
	}
}

sub ProcessError {
	shout ('debug', "ERRORHANDLE: Will now do \' $VAR{'onerror'} \'.");
	if ($VAR{'onerror'} eq 'exit') {
		shout ('critical', "If you do not want to die on error, use \'var onerror = continue\'. "); 
	} elsif ($VAR{'onerror'} eq '') {
		shout ('critical', "Error handler not defined. At least use \' var onerror = continue \'.");
	} elsif ($VAR{'onerror'} ne 'continue') {
		&ProcessCommand($VAR{'onerror'});
	} 
}

sub shout {
	$NoiseLevel = shift;
	$ShoutLine = shift;
	if ($NoiseLevel eq 'debug'){
		return if ($VAR{'debug'} ne 'on');
		print STDOUT "DEBUG: $ShoutLine\n";		
	} elsif ($NoiseLevel eq 'critical') {
		print STDOUT "!!! $ShoutLine";
		print STDOUT " Terminating ...\n";
		exit;
	} elsif ($NoiseLevel eq 'user') {
		print STDOUT "=== $ShoutLine\n";
	} elsif ($NoiseLevel eq 'raw') {
		$ShoutLine =~ s/\\n/\n/g;
		$ShoutLine =~ s/\\t/\t/g;
		print STDOUT $ShoutLine;
	} elsif ($VAR{'silent'} eq 'on') {
		return;
	} elsif ($NoiseLevel eq 'error') {
		print STDOUT "!!! $ShoutLine\n";
		&ProcessError;
	} elsif ($NoiseLevel eq 'info') {
		print STDOUT "--- $ShoutLine\n";
	} elsif (($NoiseLevel eq 'verbose') && ($VAR{'verbose'} ne 'off')) {
		print STDOUT "$ShoutLine\n";
	} elsif ($NoiseLevel eq 'normal') {
		print STDOUT "$ShoutLine\n";
	}
}

sub OpenTheSocketForMe {
	$SocketOpened = 0;
	if ($VAR{'sockshost'} ne '') {
		my $tmpsock = new Net::SOCKS(
			socks_addr => $VAR{'sockshost'},
			socks_port => $VAR{'socksport'},
			protocol_version => $VAR{'socksversion'}
		);

		if ($VAR{'socksuser'} ne '') {
			$tmpsock->param('user_id',$VAR{'socksuser'});
			$tmpsock->param('user_password',$VAR{'sockspassword'});
			$tmpsock->param('force_nonanonymous', 1);
		}
		shout ('debug', "SOCKET: Connecting to $RawHost:$RawPort via SOCKS proxy at $VAR{'sockshost'}:$VAR{'socksport'}.");
		$SOCK = $tmpsock->connect(peer_addr => $RawHost, peer_port => $RawPort);
		if ($tmpsock->param('status_num') != SOCKS_OKAY) {
			$DaMessage = Net::SOCKS::status_message($tmpsock->param('status_num'));
			shout ('critical', "SOCKET: Problem with SOCKS server $VAR{'sockshost'}:$VAR{'socksport'} - $DaMessage.");
		} else {
			shout ('debug', "SOCKET: Connected to $RawHost:$RawPort via SOCKS proxy at $VAR{'sockshost'}:$VAR{'socksport'}.");
		}
		$REMOTE = $SOCK;
	} else {
		shout ('debug', "SOCKET: Will attempt to connect to $RawHost:$RawPort");
		$Protocol = getprotobyname('tcp')||0;
		if(! ($RawIP = inet_aton($RawHost) ) ){
			shout ('error', "Unable to resolve $RawHost .");
			return;
		}
	
		if (! (socket(SOCK,PF_INET,SOCK_STREAM,$Protocol) ) ){
			shout ('critical', "Unable to create socket.");
		}
	
		if (! (connect(SOCK, sockaddr_in($RawPort, $RawIP)))) {
			shout ('error', "$RawHost does not respond on port $RawPort.");
			&SSLKillTunnel;
			return;
		}

		shout ('debug', "SOCKET: Connected to $RawHost:$RawPort.");
		select(SOCK);	$|=1;	select(STDOUT);
		$REMOTE = SOCK;
	}
	$SocketOpened = 1;
}

sub CloseTheSocketForMe {
	if ($SocketOpened == 0) {return;}
	if ($VAR{'sockshost'} ne '') {
		shout ('debug',"SOCKET: Closing SOCKS connection.");
		$SOCK->close();
	} else {
		shout ('debug',"SOCKET: Closing socket.");
		close(SOCK);
	}
	$SocketOpened = 0;
}
