1 files changed, 114 insertions, 0 deletions
diff --git a/mail/p5-MIME-Tools/files/patch-ParamVal.pm b/mail/p5-MIME-Tools/files/patch-ParamVal.pm
new file mode 100644
index 000000000000..afc85edda148
--- /dev/null
+++ b/mail/p5-MIME-Tools/files/patch-ParamVal.pm
@@ -0,0 +1,114 @@
+--- lib/MIME/Field/ParamVal.pm.orig	Sun Nov  5 04:54:49 2000
++++ lib/MIME/Field/ParamVal.pm	Thu Jun  6 10:15:15 2002
+@@ -100,6 +100,9 @@
+ #      token      =  1*<any  (ASCII) CHAR except SPACE, CTLs, or tspecials>
+ #
+ my $TSPECIAL = '()<>@,;:\</[]?="';
++
++#" Fix emacs highlighting...
++
+ my $TOKEN    = '[^ \x00-\x1f\x80-\xff' . "\Q$TSPECIAL\E" . ']+';
+ 
+ # Encoded token:
+@@ -108,6 +111,9 @@
+ # Pattern to match spaces or comments:
+ my $SPCZ     = '(?:\s|\([^\)]*\))*';
+ 
++# Pattern to match non-semicolon as fallback for broken MIME
++# produced by some viruses
++my $BADTOKEN = '[^;]+';
+ 
+ #------------------------------
+ #
+@@ -181,10 +187,40 @@
+ 
+ =cut
+ 
++sub rfc2231decode {
++    my($val) = @_;
++    my($enc, $lang, $rest);
++
++    if ($val =~ m/^([^\']*)\'([^\']*)\'(.*)$/) {
++	# SHOULD REALLY DO SOMETHING MORE INTELLIGENT WITH ENCODING!!!
++	$enc = $1;
++	$lang = $2;
++	$rest = $3;
++	$rest = rfc2231percent($rest);
++    } elsif ($val =~ m/^([^\']*)\'([^\']*)$/) {
++	$enc = $1;
++	$rest = $2;
++	$rest = rfc2231percent($rest);
++    } else {
++	$rest = rfc2231percent($val);
++    }
++    return $rest;
++}
++
++sub rfc2231percent {
++    # Do percent-subsitution
++    my($str) = @_;
++    $str =~ s/%([0-9a-fA-F]{2})/pack("c", hex($1))/ge;
++    return $str;
++}
++
+ sub parse_params {
+     my ($self, $raw) = @_;
+     my %params = ();
++    my %rfc2231params = ();
+     my $param;
++    my $val;
++    my $part;
+ 
+     # Get raw field, and unfold it:
+     defined($raw) or $raw = '';
+@@ -200,9 +236,47 @@
+ 	$raw =~ m/\G$SPCZ\;$SPCZ/og or last;             # skip leading separator
+ 	$raw =~ m/\G($PARAMNAME)\s*=\s*/og or last;      # give up if not a param
+ 	$param = lc($1);
+-	$raw =~ m/\G(\"([^\"]+)\")|\G($TOKEN)|\G($ENCTOKEN)/g or last;   # give up if no value
+-	my ($qstr, $str, $token, $enctoken) = ($1, $2, $3, $4);
+-	$params{$param} = defined($qstr) ? $str : (defined($token) ? $token : $enctoken);
++	$raw =~ m/\G(\"([^\"]+)\")|\G($ENCTOKEN)|\G($BADTOKEN)|\G($TOKEN)/g or last;   # give up if no value"
++	my ($qstr, $str, $enctoken, $badtoken, $token) = ($1, $2, $3, $4, $5);
++	if (defined($badtoken)) {
++	    # Strip leading/trailing whitespace from badtoken
++	    $badtoken =~ s/^\s*//;
++	    $badtoken =~ s/\s*$//;
++	}
++	$val = defined($qstr) ? $str :
++	    (defined($enctoken) ? $enctoken :
++	     (defined($badtoken) ? $badtoken : $token));
++
++	# Do RFC 2231 processing
++	if ($param =~ /\*/) {
++	    my($name, $num);
++	    # Pick out the parts of the parameter
++	    if ($param =~ m/^([^*]+)\*([^*]+)\*?$/) {
++		# We have param*number* or param*number
++		$name = $1;
++		$num = $2;
++	    } else {
++		# Fake a part of zero... not sure how to handle this properly
++		$param =~ s/\*//g;
++		$name = $param;
++		$num = 0;
++	    }
++	    # Decode the value unless it was a quoted string
++	    if (!defined($qstr)) {
++		$val = rfc2231decode($val);
++	    }
++	    $rfc2231params{$name}{$num} .= $val;
++	} else {
++	    # Make a fake "part zero" for non-RFC2231 params
++	    $rfc2231params{$param}{"0"} = $val;
++	}
++    }
++
++    # Extract reconstructed parameters
++    foreach $param (keys %rfc2231params) {
++	foreach $part (sort { $a <=> $b } keys %{$rfc2231params{$param}}) {
++	    $params{$param} .= $rfc2231params{$param}{$part};
++	}
+ 	debug "   field param <$param> = <$params{$param}>";
+     }
+