You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

125 lines
3.0 KiB

#!/usr/bin/perl
#
# $Id: tmprequest.pl,v 1.3 2004/01/29 07:57:04 jeffo Exp $
#
# Source File: tmprequest.pl
# Get config
require 'sitecfg.pl';
print "Content-Type: text/html\n\n";
print "<HTML>\n<BODY>\n<TABLE>\n";
&testing_initialize;
@lines = ();
print "<TR>\n<TD>UPLOADED FILES</TD>\n<TD>";
for (keys %UPLOADED_FILES) {
print "$_ ";
}
print "</TD>\n</TR>\n";
for (keys %FORM) {
push @lines, "<TR>\n<TD>$_</TD>\n<TD>$FORM{$_}</TD>\n</TR>\n";
}
@outlines = sort @lines;
foreach $line (@outlines) {
print $line;
}
print "</TABLE>\n</BODY>\n</HTML>\n";
@lines = ();
@outlines = ();
sub testing_initialize {
# set variables from query parameters based on the request method
$reqmeth = $ENV{'REQUEST_METHOD'};
@cookies = split(/\;/,$ENV{'HTTP_COOKIE'});
foreach $cookie (@cookies) {
($nm, $vlu) = split(/=/, $cookie);
$nm =~ s/ //g;
$vlu =~ tr/+/ /;
$vlu = unmunge($vlu);
$COOKIES{$nm} = $vlu;
}
if ($reqmeth =~ /POST/i) {
if ($acceptpost) { read (STDIN, $qstr, $ENV{'CONTENT_LENGTH'});}
} else {
if ($reqmeth =~ /GET/i) {
if ($acceptget) { $qstr=$ENV{'QUERY_STRING'};}
}
}
if ($qstr) {
$contenttype=$ENV{'CONTENT_TYPE'};
if ($contenttype =~ 'multipart/form-data') {
$srch="boundary\=";
($trash,$boundary) = split(/$srch/, $contenttype);
($boundary, $trash) = split(/ /, $boundary);
$endboundary = join('', $boundary, "\-\-");
$boundary = join('', $boundary, "\r\n");
($qstr, $trash) = split(/$endboundary/, $qstr);
@parts = split(/$boundary/, $qstr);
$trash = shift @parts;
$consep = "\r\n\r\n";
foreach $part (@parts) {
($contype, $content) = split(/$consep/, $part);
if ($contype ne '') {
chop($content);
chop($content);
$contype =~ s/\: /=/g;
$contype =~ s/\r\n/; /g;
@lines = split(/\; /, $contype);
$nme = "";
$fname = "";
$ftype = "";
foreach $line (@lines) {
$line =~ s/\"//g;
($nm,$vlu) = split(/=/, $line);
$vlu =~ tr/+/ /;
$vlu = unmunge($vlu);
if ($nm eq 'filename') {
@segs = split(/\./, $vlu);
$ftype = $segs[$#segs];
} else {
if ($nm eq 'name') {
$nme = $vlu;
}
}
}
if ($ftype eq '') {
$content =~ s/\r\n//g;
$content =~ tr/+/ /;
$content = unmunge($content);
if($FORM{$nme} ne '') {
$FORM{$nme} = join(',', $FORM{$nme}, $content);
} else {$FORM{$nme} = $content;}
} else {
$content =~ s/(.*)\r\n/$1/;
$UPLOADED_FILES{"$nme.$ftype"} = $content
# $outfile=join($pathsep, $testgraphic, "$nme.$ftype");
# open (OUTFILE, ">$outfile") or $msg="failed";
# if ($msg ne "failed") {
# binmode(OUTFILE);
# print OUTFILE $content;
# close OUTFILE;
# }
}
}
}
} else {
# parse request parameters into variables
@parameters = split(/&/, $qstr);
foreach $pair (@parameters) {
($nm, $vlu) = split(/=/, $pair);
$vlu =~ tr/+/ /;
$vlu = unmunge($vlu);
$FORM{$nm} = $vlu;
}
unless ($language) {$FORM{'lng'}="us";}
}
return 1;
} else {
return 0;
}
}