print "<HTML><BODY>";
print "<font size=+2 color=#990033><B><CENTER>";
print "Sambar Server CGI Environment Variables\n";
print "</CENTER></B></font><P>";

#
# Only allow localhost to dump environment variables 
# (ONLY remove after reading the syshelp/security.htm documentation)
#
$content_type = $ENV{'CONTENT_TYPE'};
$content_len = $ENV{'CONTENT_LENGTH'};
$host_test = $ENV{'REMOTE_ADDR'};
if (!($host_test eq '127.0.0.1'))
{
	print "Only localhost is allowed to use this script!\n";
	exit(1);
}

#
# Parse and display the FORM data.
#
print "<font size=+1 color=#990033><B>CGI FORM Variables</B></font><BR><PRE>\n";

	# Buffer the POST content
	binmode STDIN;
	read(STDIN, $buffer, $content_len);

	if ((!$content_type) ||
	    ($content_type eq 'application/x-www-form-urlencoded'))
	{
		# Process the name=value argument pairs
		@args = split(/&/, $buffer);

		$data = '';
		foreach $pair (@args) 
		{
			($name, $value) = split(/=/, $pair);
	
			# Unescape the argument value 
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

			# Print the name=value pair
			print "<B>$name</B>: $value\n";
		}
	}
	elsif ($content_type =~ m#^multipart/form-data#)
	{
		# find boundary
		# Eric Poulsen fixed the following to allow for quotes.
		#
		# ($boundary = $content_type) =~ s/^.*boundary=(.*)$/\1/;
		($boundary = $content_type) =~ s/^.*boundary="?(.*?)"?$/\1/;

		@pairs = split(/--$boundary/, $buffer);
		@pairs = splice(@pairs,1,$#pairs-1);

		for $part (@pairs) 
		{
			($dump,$fline,$value) = split(/\r\n/,$part,3);
			next if $fline =~ /filename=\"\"/;
			$fline =~ s/^Content-Disposition: form-data; //;
			(@columns) = split(/;\s+/, $fline);
			($name = $columns[0]) =~ s/^name="([^"]+)"$/\1/g;

			if ($#columns > 0) 
			{
				if ($value =~ /^Content-Type:/) 
				{
					($dump,$dump,$value) = split(/\r\n/,$value,3);
				}
				else 
				{
					($dump,$value) = split(/\r\n/,$value,2);
				}
			}
			else 
			{
				($dump,$value) = split(/\r\n/,$value,2);
				if (grep(/^$name$/, keys(%CGI))) 
				{
					# Print the name=value pair
					print "<B>$name</B>: $value\n";
				}
				else 
				{
					next if $value =~ /^\s*$/;
					
					# Print the name=value pair
					print "<B>$name</B>: $value\n";
				}
				next;
			}

			$FORM{$name} = $value;
		}
	}
	else
	{
		print "Invalid content type (expecting POST)!\n";
		exit(1);
	}

#
# Display the shell environment variables first
#
print "</PRE><P>\n";
print "<font size=+1 color=#990033><B>Shell Environment</B></font><BR><PRE>\n";
while(my($key,$val) = each(ENV))
{
	print "<B>$key</B>: $val \n";
}


#
# DONE
#
print "</PRE>";
print "</BODY></HTML>";

exit(0);
