ANNOUNCE: MIME-Tools security patch
Julian Field
jkf at ecs.soton.ac.uk
Fri Jun 7 11:32:11 IST 2002
A very nice person on the Bugtraq mailing list has found some potential
security problems with the current stable release of the MIME-Tools module
which is used by MailScanner. These are likely to be exploited fairly soon
as the hackers all read Bugtraq too.
A patch to correct these problems is attached to this message.
You should find that the command
patch -p0 < mime-tools-patch.txt
will install the patch, but it will probably ask you to locate the 2 files
it needs to patch. Have a hunt round your Perl installation for the
site_perl directory and take a look in there. If you can't find your
site_perl directory anywhere, then run this perl script:
#!/usr/bin/perl
print join("\n", @INC);
and the output of that will tell you where to look for it.
Please don't ask me for more advice on using the patch command, there's a
perfectly good man page about it and patch is very intelligent anyway, so
you shouldn't have much problem.
Jules.
-------------- next part --------------
diff -c -r MIME-tools-5.411-ORIG/lib/MIME/Field/ParamVal.pm MIME-tools-5.411/lib/MIME/Field/ParamVal.pm
*** MIME-tools-5.411-ORIG/lib/MIME/Field/ParamVal.pm Sat Nov 4 14:54:49 2000
--- MIME-tools-5.411/lib/MIME/Field/ParamVal.pm Mon May 27 13:55:40 2002
***************
*** 9,50 ****
=head1 SYNOPSIS
# Create an object for a content-type field:
! $field = new Mail::Field 'Content-type';
!
# Set some attributes:
$field->param('_' => 'text/html');
$field->param('charset' => 'us-ascii');
$field->param('boundary' => '---ABC---');
!
# Same:
$field->set('_' => 'text/html',
'charset' => 'us-ascii',
'boundary' => '---ABC---');
!
# Get an attribute, or undefined if not present:
print "no id!" if defined($field->param('id'));
!
# Same, but use empty string for missing values:
print "no id!" if ($field->paramstr('id') eq '');
!
# Output as string:
print $field->stringify, "\n";
=head1 DESCRIPTION
! This is an abstract superclass of most MIME fields. It handles
fields with a general syntax like this:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Comments are supported I<between> items, like this:
Content-Type: Message/Partial; (a comment)
! number=2 (another comment) ; (yet another comment) total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
=head1 PUBLIC INTERFACE
--- 9,50 ----
=head1 SYNOPSIS
# Create an object for a content-type field:
! $field = new Mail::Field 'Content-type';
!
# Set some attributes:
$field->param('_' => 'text/html');
$field->param('charset' => 'us-ascii');
$field->param('boundary' => '---ABC---');
!
# Same:
$field->set('_' => 'text/html',
'charset' => 'us-ascii',
'boundary' => '---ABC---');
!
# Get an attribute, or undefined if not present:
print "no id!" if defined($field->param('id'));
!
# Same, but use empty string for missing values:
print "no id!" if ($field->paramstr('id') eq '');
!
# Output as string:
print $field->stringify, "\n";
=head1 DESCRIPTION
! This is an abstract superclass of most MIME fields. It handles
fields with a general syntax like this:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Comments are supported I<between> items, like this:
Content-Type: Message/Partial; (a comment)
! number=2 (another comment) ; (yet another comment) total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
=head1 PUBLIC INTERFACE
***************
*** 100,105 ****
--- 100,108 ----
# 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,113 ****
--- 111,119 ----
# 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 = '[^;]+';
#------------------------------
#
***************
*** 133,139 ****
'total' => 3,
'id' => "ocj=pbe0M2");
! Note that a single argument is taken to be a I<reference> to
a paramhash, while multiple args are taken to be the elements
of the paramhash themselves.
--- 139,145 ----
'total' => 3,
'id' => "ocj=pbe0M2");
! Note that a single argument is taken to be a I<reference> to
a paramhash, while multiple args are taken to be the elements
of the paramhash themselves.
***************
*** 160,175 ****
it as a hash reference. For example, here is a field with parameters:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Here is how you'd extract them:
$params = $class->parse_params('content-type');
if ($$params{'_'} eq 'message/partial') {
! $number = $$params{'number'};
! $total = $$params{'total'};
! $id = $$params{'id'};
}
Like field names, parameter names are coerced to lowercase.
--- 166,181 ----
it as a hash reference. For example, here is a field with parameters:
Content-Type: Message/Partial;
! number=2; total=3;
! id="oc=jpbe0M2Yt4s at thumper.bellcore.com"
Here is how you'd extract them:
$params = $class->parse_params('content-type');
if ($$params{'_'} eq 'message/partial') {
! $number = $$params{'number'};
! $total = $$params{'total'};
! $id = $$params{'id'};
}
Like field names, parameter names are coerced to lowercase.
***************
*** 181,190 ****
--- 187,226 ----
=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,208 ****
$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);
debug " field param <$param> = <$params{$param}>";
}
--- 236,282 ----
$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($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}>";
}
***************
*** 227,233 ****
# Allow use as constructor, for MIME::Head:
ref($self) or $self = bless({}, $self);
!
# Get params, and stuff them into the self object:
$self->set($self->parse_params($string));
}
--- 301,307 ----
# Allow use as constructor, for MIME::Head:
ref($self) or $self = bless({}, $self);
!
# Get params, and stuff them into the self object:
$self->set($self->parse_params($string));
}
diff -c -r MIME-tools-5.411-ORIG/lib/MIME/Words.pm MIME-tools-5.411/lib/MIME/Words.pm
*** MIME-tools-5.411-ORIG/lib/MIME/Words.pm Fri Nov 10 11:45:12 2000
--- MIME-tools-5.411/lib/MIME/Words.pm Mon May 27 14:07:22 2002
***************
*** 186,192 ****
$@ = ''; ### error-return
### Collapse boundaries between adjacent encoded words:
! $encstr =~ s{(\?\=)\r?\n[ \t](\=\?)}{$1$2}gs;
pos($encstr) = 0;
### print STDOUT "ENC = [", $encstr, "]\n";
--- 186,192 ----
$@ = ''; ### error-return
### Collapse boundaries between adjacent encoded words:
! $encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs;
pos($encstr) = 0;
### print STDOUT "ENC = [", $encstr, "]\n";
-------------- next part --------------
--
Julian Field Teaching Systems Manager
jkf at ecs.soton.ac.uk Dept. of Electronics & Computer Science
Tel. 023 8059 2817 University of Southampton
Southampton SO17 1BJ
More information about the MailScanner
mailing list