qt5base-lts/tests/testserver/apache2/testdata/www/cgi-bin/multipart.cgi
Mårten Nordheim b77e239c5e Fix perl script warning
The apache logs are filled with warnings about this when it's used.

https://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/

Change-Id: I977d2b022d706d9587c033fd8e80f129e60c439c
Reviewed-by: Timur Pocheptsov <timur.pocheptsov@qt.io>
Reviewed-by: Edward Welbourne <edward.welbourne@qt.io>
2020-03-19 14:15:04 +00:00

43 lines
1.1 KiB
Perl
Executable File

#!/usr/bin/perl
use CGI;
use Digest::MD5 qw(md5_hex);
$q = new CGI;
print $q->header();
$contentType = $ENV{"CONTENT_TYPE"};
print "content type: $contentType\n";
if ($contentType =~ /^multipart\/form-data/) {
foreach my $key ($q->param) {
foreach my $value (scalar $q->param($key)) {
if ($key =~ /text/) {
$retValue = $value;
} else {
$retValue = md5_hex($value);
}
print "key: $key, value: $retValue\n";
}
}
} else {
#$contentLength = $ENV{"CONTENT_LENGTH"};
#print "content length: $contentLength\r\n";
$data = $q->param('POSTDATA');
$data =~ s/--\S*--$//; # remove ending boundary
@parts = split(/--\S*\r\n/, $data);
shift(@parts);
foreach (@parts) {
#print "raw: $_";
($header, $content) = split("\r\n\r\n");
@headerFields = split("\r\n", $header);
foreach (@headerFields) {
($fieldName, $value) = split(": ");
print "header: $fieldName, value: '$value'\n";
}
$content =~ s/\r\n//;
print "content: $content\n\n";
}
}