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