Revision 68ca5cc3
Von Moritz Bunkus vor mehr als 17 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 70 | 70 |
$main::lxdebug->enter_sub(2); |
| 71 | 71 |
|
| 72 | 72 |
my ($input) = @_; |
| 73 |
my ($i, $loc, $key, $val); |
|
| 74 |
my (%ATTACH, $f, $header, $header_body, $len, $buf); |
|
| 75 |
my ($boundary, @list, $size, $body, $x, $blah, $name); |
|
| 76 |
|
|
| 77 |
if ($ENV{'CONTENT_TYPE'}
|
|
| 78 |
&& ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/)) {
|
|
| 79 |
$boundary = quotemeta('--' . $1);
|
|
| 80 |
@list = split(/$boundary/, $input); |
|
| 81 |
|
|
| 82 |
# For some reason there are always 2 extra, that are empty |
|
| 83 |
$size = @list - 2; |
|
| 84 |
|
|
| 85 |
for ($x = 1; $x <= $size; $x++) {
|
|
| 86 |
$header_body = $list[$x]; |
|
| 87 |
$header_body =~ /\r\n\r\n|\n\n/; |
|
| 88 |
|
|
| 89 |
# Here we split the header and body |
|
| 90 |
$header = $`; |
|
| 91 |
$body = $'; #' |
|
| 92 |
$body =~ s/\r\n$//; |
|
| 93 |
|
|
| 94 |
# Now we try to get the file name |
|
| 95 |
$name = $header; |
|
| 96 |
$name =~ /name=\"(.+)\"/; |
|
| 97 |
($name, $blah) = split(/\"/, $1); |
|
| 98 |
|
|
| 99 |
# If the form name is not attach, then we need to parse this like |
|
| 100 |
# regular form data |
|
| 101 |
if ($name ne "attach") {
|
|
| 102 |
$body =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
|
|
| 103 |
$ATTACH{$name} = $body;
|
|
| 104 |
|
|
| 105 |
# Otherwise it is an attachment and we need to finish it up |
|
| 106 |
} elsif ($name eq "attach") {
|
|
| 107 |
$header =~ /filename=\"(.+)\"/; |
|
| 108 |
$ATTACH{'FILE_NAME'} = $1;
|
|
| 109 |
$ATTACH{'FILE_NAME'} =~ s/\"//g;
|
|
| 110 |
$ATTACH{'FILE_NAME'} =~ s/\s//g;
|
|
| 111 |
$ATTACH{'FILE_CONTENT'} = $body;
|
|
| 112 |
|
|
| 113 |
for ($i = $x; $list[$i]; $i++) {
|
|
| 114 |
$list[$i] =~ s/^.+name=$//; |
|
| 115 |
$list[$i] =~ /\"(\w+)\"/; |
|
| 116 |
$ATTACH{$1} = $'; #'
|
|
| 73 |
|
|
| 74 |
if (!$ENV{'CONTENT_TYPE'}
|
|
| 75 |
|| ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
|
|
| 76 |
$main::lxdebug->leave_sub(2); |
|
| 77 |
return _input_to_hash($input); |
|
| 78 |
} |
|
| 79 |
|
|
| 80 |
my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr); |
|
| 81 |
my %params; |
|
| 82 |
|
|
| 83 |
my $boundary = '--' . $1; |
|
| 84 |
|
|
| 85 |
foreach my $line (split m/\n/, $input) {
|
|
| 86 |
last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));
|
|
| 87 |
|
|
| 88 |
if (($line eq $boundary) || ($line eq "$boundary\r")) {
|
|
| 89 |
$params{$name} =~ s|\r?\n$|| if $name;
|
|
| 90 |
|
|
| 91 |
undef $name, $filename; |
|
| 92 |
|
|
| 93 |
$headers_done = 0; |
|
| 94 |
$content_type = "text/plain"; |
|
| 95 |
$boundary_found = 1; |
|
| 96 |
$need_cr = 0; |
|
| 97 |
|
|
| 98 |
next; |
|
| 99 |
} |
|
| 100 |
|
|
| 101 |
next unless $boundary_found; |
|
| 102 |
|
|
| 103 |
if (!$headers_done) {
|
|
| 104 |
$line =~ s/[\r\n]*$//; |
|
| 105 |
|
|
| 106 |
if (!$line) {
|
|
| 107 |
$headers_done = 1; |
|
| 108 |
next; |
|
| 109 |
} |
|
| 110 |
|
|
| 111 |
if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) {
|
|
| 112 |
if ($line =~ m|filename\s*=\s*"(.*?)"|i) {
|
|
| 113 |
$filename = $1; |
|
| 114 |
substr $line, $-[0], $+[0] - $-[0], ""; |
|
| 115 |
} |
|
| 116 |
|
|
| 117 |
if ($line =~ m|name\s*=\s*"(.*?)"|i) {
|
|
| 118 |
$name = $1; |
|
| 119 |
substr $line, $-[0], $+[0] - $-[0], ""; |
|
| 117 | 120 |
} |
| 121 |
|
|
| 122 |
$params{$name} = "";
|
|
| 123 |
$params{FILENAME} = $filename if ($filename);
|
|
| 124 |
|
|
| 125 |
next; |
|
| 126 |
} |
|
| 127 |
|
|
| 128 |
if ($line =~ m|^content-type\s*:\s*(.*?)$|i) {
|
|
| 129 |
$content_type = $1; |
|
| 118 | 130 |
} |
| 131 |
|
|
| 132 |
next; |
|
| 119 | 133 |
} |
| 120 | 134 |
|
| 121 |
$main::lxdebug->leave_sub(2); |
|
| 122 |
return %ATTACH; |
|
| 135 |
next unless $name; |
|
| 123 | 136 |
|
| 124 |
} else {
|
|
| 125 |
$main::lxdebug->leave_sub(2); |
|
| 126 |
return _input_to_hash($input); |
|
| 137 |
$params{$name} .= "${line}\n";
|
|
| 127 | 138 |
} |
| 139 |
|
|
| 140 |
$params{$name} =~ s|\r?\n$|| if $name;
|
|
| 141 |
|
|
| 142 |
$main::lxdebug->leave_sub(2); |
|
| 143 |
return %params; |
|
| 128 | 144 |
} |
| 129 | 145 |
|
| 130 | 146 |
sub new {
|
Auch abrufbar als: Unified diff
Der bisherige Code, um Post-Anfragen mit enctype="multipart/form-data" zu parsen, hat leider bei Binärdaten versagt.