Bug 18697 - в версии 3.37, судя по всему, есть ошибка.
Summary: в версии 3.37, судя по всему, есть ошибка.
Status: CLOSED FIXED
Alias: None
Product: Branch 4.1
Classification: Distributions
Component: perl-CGI (show other bugs)
Version: unspecified
Hardware: all Linux
: P2 normal
Assignee: at@altlinux.org
QA Contact: qa-4.1@altlinux.org
URL:
Keywords:
Depends on:
Blocks:
 
Reported: 2009-01-30 12:38 MSK by Sergey Y. Afonin
Modified: 2009-03-18 17:00 MSK (History)
1 user (show)

See Also:


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Sergey Y. Afonin 2009-01-30 12:38:03 MSK
Из-за неё не работает TWiki:
http://twiki.org/cgi-bin/view/Support/ARGPullingMyHairOutConfigureBroken

Апдейт до 3.42 из Сизифа проблему решает.
Comment 1 Konstantin Uvarin (lodin) 2009-03-18 16:57:29 MSK
+1, нашёл в гугле: 
http://rt.cpan.org/Public/Bug/Display.html?id=36340

А вот и патч. 

--- /usr/lib/perl5/vendor_perl/CGI.pm   2008-04-24 01:35:45 +0400
+++ CGI.pm      2009-03-18 16:50:53 +0300
@@ -3387,8 +3387,11 @@
         # NB: File content will be loaded into memory should
         # content-disposition parsing fail.
         my ($filename) = $header{'Content-Disposition'}
-                      =~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
-        $filename =~ s/^"([^"]*)"$/$1/;
+               =~/ filename=((\"[^\"]*\")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
+       if ($filename) {
+               $filename =~ s/^\"([^\"]*)\"$/$1/;
+       };
+
        # Test for Opera's multiple upload feature
        my($multipart) = ( defined( $header{'Content-Type'} ) &&
                $header{'Content-Type'} =~ /multipart\/mixed/ ) ?
Comment 2 Konstantin Uvarin (lodin) 2009-03-18 17:00:23 MSK
Скрипт для проверки данного бага: 

Тестируется путём захода на http://localhost/cgi-bin/test.pl и затем отправки произвольного файла. 

bash$ cat /var/www/cgi-bin/test.pl 
#!/usr/bin/perl -w -T

use strict;

print "Content-type: text/html; charset=utf-8\n\n";

print <<'EOF';
<HTML>
 <HEAD><title>Upload a file</title></HEAD>
 <BODY>
 <FORM METHOD="POST" ENCTYPE="multipart/form-data">
 Filename: <INPUT TYPE="file" NAME="file"> 
 <INPUT TYPE="submit" NAME="Submit" VALUE="Submit!"><br><br>
EOF

open STDERR, ">&STDOUT";
$ENV{PATH} = '/bin:/usr/bin';

use POSIX qw/strftime/;

use CGI;
my $q = CGI->new(); 


print "<br><br>OK";