From: Marko Asplund <aspa@merlot.kronodoc.fi>
Date: Fri, 4 Nov 2005 13:40:05 +0000 (+0200)
Subject: [perl #37607] CGI file upload file name parsing errors
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=959037a055713bbf644c83e4acd1a40a7f4d58c7;p=p5sagit%2Fp5-mst-13.2.git

[perl #37607] CGI file upload file name parsing errors
Message-ID: <5.8.7_13518_1131102897@merlot.kronodoc.fi>

p4raw-id: //depot/perl@32683
---

diff --git a/lib/CGI.pm b/lib/CGI.pm
index bd665b5..0e23450 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -19,7 +19,7 @@ use Carp 'croak';
 #   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 @@ sub read_multipart {
         $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/ ) ?