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
125 lines
3.0 KiB
4 months ago
|
#!/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;
|
||
|
|
}
|
||
|
|
}
|