Change 32683 by [EMAIL PROTECTED] on 2007/12/21 03:14:20
Subject: [perl #37607] CGI file upload file name parsing errors
From: [EMAIL PROTECTED] (Marko Asplund)
Date: Fri, 4 Nov 2005 13:40:05 +0200 (EET)
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/lib/CGI.pm#69 edit
Differences ...
==== //depot/perl/lib/CGI.pm#69 (text) ====
Index: perl/lib/CGI.pm
--- perl/lib/CGI.pm#68~32661~ 2007-12-19 11:55:00.000000000 -0800
+++ perl/lib/CGI.pm 2007-12-20 19:14:20.000000000 -0800
@@ -19,7 +19,7 @@
# http://stein.cshl.org/WWW/software/CGI/
$CGI::revision = '$Id: CGI.pm,v 1.240 2007/11/30 18:58:27 lstein Exp $';
-$CGI::VERSION='3.31';
+$CGI::VERSION='3.31_01';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -3379,7 +3379,11 @@
$param .= $TAINTED;
# Bug: Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{'Content-Disposition'}=~/ filename="([^"]*)"/;
+ # See RFC 1867, 2183, 2045
+ # 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/;
# Test for Opera's multiple upload feature
my($multipart) = ( defined( $header{'Content-Type'} ) &&
$header{'Content-Type'} =~ /multipart\/mixed/ ) ?
End of Patch.
