home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2001 August
/
PCWorld_2001-08_cd.bin
/
Komunikace
/
sambar
/
_setup.1
/
dumpenv.pl
< prev
next >
Wrap
Text File
|
2000-06-05
|
3KB
|
122 lines
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);