#!/usr/bin/perl $read_parse'maxdata = 131072; $read_parse'writefiles = 0; $read_parse'filepre = "read-parse"; $read_parse'bufsize = 8192; $read_parse'maxbound = 100; $read_parse'headerout = 0; sub ReadParse { local (*in) = shift if @_; local (*incfn, *inct, *insfn) = @_; local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got); $perlwarn = $^W; $^W = 0; binmode(STDIN); binmode(STDOUT); binmode(STDERR); $type = $ENV{'CONTENT_TYPE'}; $len = $ENV{'CONTENT_LENGTH'}; $meth = $ENV{'REQUEST_METHOD'}; if ($len > $read_parse'maxdata) { #' &CgiDie("read-parse.pl: Request to receive too much data: $len bytes\n"); } if (!defined $meth || $meth eq '' || $meth eq 'GET' || $type eq 'application/x-www-form-urlencoded') { local ($key, $val, $i); if (!defined $meth || $meth eq '') { $in = $ENV{'QUERY_STRING'}; $cmdflag = 1; # also use command-line options } elsif($meth eq 'GET' || $meth eq 'HEAD') { $in = $ENV{'QUERY_STRING'}; } elsif ($meth eq 'POST') { if (($got = read(STDIN, $in, $len) != $len)) {$errflag="Short Read: wanted $len, got $got\n"}; } else { &CgiDie("read-parse.pl: Unknown request method: $meth\n"); } @in = split(/[&;]/,$in); push(@in, @ARGV) if $cmdflag; foreach $i (0 .. $#in) { $in[$i] =~ s/\+/ /g; ($key, $val) = split(/=/,$in[$i],2); $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $in{$key} .= "\0" if (defined($in{$key})); $in{$key} .= $val; } } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) { $errflag = !(eval <<'END_MULTIPART'); local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen); local ($bpos, $lpos, $left, $amt, $fn, $ser); local ($bufsize, $maxbound, $writefiles) = ($read_parse'bufsize, $read_parse'maxbound, $read_parse'writefiles); $buf = ''; ($boundary) = $type =~ /boundary="([^"]+)"/; #"; ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary; &CgiDie ("Boundary not provided: probably a bug in your server") unless $boundary; $boundary = "--" . $boundary; $blen = length ($boundary); if ($ENV{'REQUEST_METHOD'} ne 'POST') { &CgiDie("Invalid request method for multipart/form-data: $meth\n"); } if ($writefiles) { local($me); stat ($writefiles); $writefiles = "/tmp" unless -d _ && -r _ && -w _; # ($me) = $0 =~ m#([^/]*)$#; $writefiles .= "/$read_parse'filepre"; } $left = $len; PART: # find each part of the multi-part while reading data while (1) { die $@ if $errflag; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf): $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; $in{$name} .= "\0" if defined $in{$name}; $in{$name} .= $fn if $fn; $name=~/([-\w]+)/; if (defined $1) { $insfn{$1} .= "\0" if defined $insfn{$1}; $insfn{$1} .= $fn if $fn; } BODY: while (($bpos = index($buf, $boundary)) == -1) { die $@ if $errflag; if ($name) { if ($fn) { print FILE substr($buf, 0, $bufsize); } else { $in{$name} .= substr($buf, 0, $bufsize); } } $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } if (defined $name) { if ($fn) { print FILE substr($buf, 0, $bpos-2); } else { $in {$name} .= substr($buf, 0, $bpos-2); } } close (FILE); last PART if substr($buf, $bpos + $blen, 4) eq "--\r\n"; substr($buf, 0, $bpos+$blen+2) = ''; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf) : $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; undef $head; undef $fn; HEAD: while (($lpos = index($buf, "\r\n\r\n")) == -1) { die $@ if $errflag; $head .= substr($buf, 0, $bufsize); $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf); $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } $head .= substr($buf, 0, $lpos+2); push (@in, $head); @heads = split("\r\n", $head); ($cd) = grep (/^\s*Content-Disposition:/i, @heads); ($ct) = grep (/^\s*Content-Type:/i, @heads); ($name) = $cd =~ /\bname="([^"]+)"/i; #"; ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name; ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname; $incfn{$name} .= (defined $in{$name} ? "\0" : "") . $fname; ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #"; ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype; $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype; if ($writefiles && defined $fname) { $ser++; $fn = $writefiles . ".$$.$ser"; open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n"); binmode (FILE); } substr($buf, 0, $lpos+4) = ''; undef $fname; undef $ctype; } 1; END_MULTIPART if ($errflag) { local ($errmsg, $value); $errmsg = $@ || $errflag; foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie($errmsg); } else { } } else { &CgiDie("read-parse.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n"); } $insfn = $insfn; $incfn = $incfn; $inct = $inct; $^W = $perlwarn; return ($errflag ? undef : scalar(@in)); } &ReadParse(*input); print "Content-Type: text/plain\n\n"; print<-->
Make your own free website on Tripod.com