CVE-2024-4140 (published 2024-05-02T20:15Z)

An excessive memory use issue (CWE-770) exists in Email-MIME, before version 1.954, which can cause denial of service when parsing multipart MIME messages. The patch set (from 2020 and 2024) limits excessive depth and the total number of parts.


Weakness information:
cwe_id: NVD-CWE-noinfo
cwe_name: Insufficient Information
description: There is insufficient information about the issue to classify it; details are unkown or unspecified.
extended_description: Insufficient Information

Fix information:
repo_url: https://github.com/rjbs/Email-MIME
commit_details: repo_url: https://github.com/rjbs/Email-MIME
author: Ricardo Signes
author_date: 2020-05-09 13:53:27-04:00
msg: add MAX_DEPTH to limit depth of parsed emails
repository: repo_url: https://github.com/rjbs/Email-MIME
repo_name: rjbs/Email-MIME
description: perl library for parsing MIME messages
repo_language: Perl
owner: rjbs
file_changes: filename: MIME.pm
change_type: ModificationType.MODIFY
diff: @@ -377,10 +377,17 @@ sub body_str {
   return $str;
 }
 
+our $MAX_DEPTH = 10;
+
 sub parts_multipart {
   my $self     = shift;
   my $boundary = $self->{ct}->{attributes}->{boundary};
 
+  our $DEPTH ||= 0;
+
+  Carp::croak("attempted to parse a MIME message more than $MAX_DEPTH deep")
+    if $MAX_DEPTH && $DEPTH > $MAX_DEPTH;
+
   # Take a message, join all its lines together.  Now try to Email::MIME->new
   # it with 1.861 or earlier.  Death!  It tries to recurse endlessly on the
   # body, because every time it splits on boundary it gets itself. Obviously
@@ -411,6 +418,7 @@ sub parts_multipart {
   for my $bit (@bits) {
     $bit =~ s/\A[\n\r]+//smg;
     $bit =~ s/(?<!\x0d)$self->{mycrlf}\Z//sm;
+    local $DEPTH = $DEPTH + 1;
     my $email = (ref $self)->new($bit, { encode_check => $self->encode_check });
     push @parts, $email;
   }

programming_language: Perl
repo_url: https://github.com/rjbs/Email-MIME
commit_details: repo_url: https://github.com/rjbs/Email-MIME
author: Ricardo Signes
author_date: 2020-05-09 14:20:56-04:00
msg: hang onto this stupid test for testing
repository: repo_url: https://github.com/rjbs/Email-MIME
repo_name: rjbs/Email-MIME
description: perl library for parsing MIME messages
repo_language: Perl
owner: rjbs
file_changes: filename: stupid-big.t
change_type: ModificationType.ADD
diff: @@ -0,0 +1,56 @@
+#!perl
+# vim:ft=perl
+use strict;
+use warnings;
+
+use Test::More;
+use Email::MIME;
+
+sub very_deep_email_string {
+  my $depth = $_[0] || 250_000;
+
+  my $str = q{};
+  my $boundary_prefix = "a" x 77;
+  for my $i (1 .. $depth) {
+    my $boundary = sprintf "$boundary_prefix%08x", $i;
+    $str .= "Content-Type: multipart/mixed; boundary=$boundary\n";
+    $str .= "\n";
+    $str .= "--$boundary\n\n";
+  }
+
+  for my $i (reverse(1 .. $depth)) {
+    $str .= sprintf "--${boundary_prefix}%08x--\n\n", $i;
+  }
+
+  return $str;
+}
+
+sub very_attached_email_string {
+  my $parts = $_[0] || 250_000;
+
+  my $str = q{};
+  my $boundary_prefix = "a" x 77;
+  for my $i (1 .. $parts) {
+    my $boundary = sprintf "$boundary_prefix%08x", $i;
+    $str .= "Content-Type: text/plain; boundary=$boundary\n";
+    $str .= "\n";
+    $str .= "--$boundary\n\n";
+    $str .= sprintf "--${boundary_prefix}%08x--\n\n", $i;
+  }
+
+  return $str;
+}
+
+print `ps -o rss -p $$`;
+
+my $VAES = very_attached_email_string;
+warn length($VAES) / 1024;
+my $email = Email::MIME->new($VAES);
+
+print `ps -o rss -p $$`;
+
+# local $Email::MIME::MAX_DEPTH = 2;
+
+$email = Email::MIME->new( very_deep_email_string() );
+
+print `ps -o rss -p $$`;

programming_language: Perl
repo_url: https://github.com/rjbs/Email-MIME
commit_details: repo_url: https://github.com/rjbs/Email-MIME
author: Ricardo Signes
author_date: 2020-05-09 14:23:02-04:00
msg: document MAX_DEPTH
repository: repo_url: https://github.com/rjbs/Email-MIME
repo_name: rjbs/Email-MIME
description: perl library for parsing MIME messages
repo_language: Perl
owner: rjbs
file_changes: filename: MIME.pm
change_type: ModificationType.MODIFY
diff: @@ -1057,6 +1057,12 @@ For example:
     + text/plain
     + text/html
 
+=head1 CONFIGURATION
+
+The variable C<$Email::MIME::MAX_DEPTH> is the maximum depth of parts that will
+be processed.  It defaults to 10, already higher than legitimate mail is ever
+likely to be.  This value may go up over time as the parser is improved.
+
 =head1 TODO
 
 All of the Email::MIME-specific guts should move to a single entry on the

programming_language: Perl
repo_url: https://github.com/rjbs/Email-MIME
commit_details: repo_url: https://github.com/rjbs/Email-MIME
author: Ricardo Signes
author_date: 2024-04-22 20:24:09-04:00
msg: do not allow an excessive number of parts

This is annoying!  It bugs me that making a mere 100,000 parts should lead
to excessive consumption of memory… but really, nobody does that for
a good reason.

This makes top-level (non-recursive) Email::MIME->new set a localized
part counter to 0 and increment before it makes new subpart objects.
If the counter exceeds the max, it will die early.

It would be better to work, but this is better than eating all memory and
crashing, right?

Put together with help from Marc Bradshaw.

Test forthcoming.
repository: repo_url: https://github.com/rjbs/Email-MIME
repo_name: rjbs/Email-MIME
description: perl library for parsing MIME messages
repo_language: Perl
owner: rjbs
file_changes: filename: MIME.pm
change_type: ModificationType.MODIFY
diff: @@ -18,6 +18,11 @@ use Scalar::Util qw(reftype weaken);
 
 our @CARP_NOT = qw(Email::MIME::ContentType);
 
+our $MAX_DEPTH = 10;
+
+our $CUR_PARTS = 0;
+our $MAX_PARTS = 100;
+
 =head1 SYNOPSIS
 
 B<Wait!>  Before you read this, maybe you just need L<Email::Stuffer>, which is
@@ -123,6 +128,12 @@ my $NO_ENCODE_RE = qr/
 /ix;
 
 sub new {
+  local $CUR_PARTS = 0;
+  my ($class, @rest) = @_;
+  $class->_new(@rest);
+}
+
+sub _new {
   my ($class, $text, $arg, @rest) = @_;
   $arg ||= {};
 
@@ -374,8 +385,6 @@ sub body_str {
   return $str;
 }
 
-our $MAX_DEPTH = 10;
-
 sub parts_multipart {
   my $self     = shift;
   my $boundary = $self->{ct}->{attributes}->{boundary};
@@ -408,14 +417,16 @@ sub parts_multipart {
   # 2006-11-27
   $self->SUPER::body_set(shift @bits) if index(($bits[0] || ''), ':') == -1;
 
-  my $bits = @bits;
+  local $CUR_PARTS = $CUR_PARTS + @bits;
+  Carp::croak("attempted to parse a MIME message with more than $MAX_PARTS parts")
+    if $MAX_PARTS && $CUR_PARTS > $MAX_PARTS;
 
   my @parts;
   for my $bit (@bits) {
     $bit =~ s/\A[\n\r]+//smg;
     $bit =~ s/(?<!\x0d)$self->{mycrlf}\Z//sm;
     local $DEPTH = $DEPTH + 1;
-    my $email = (ref $self)->new($bit, { encode_check => $self->encode_check });
+    my $email = (ref $self)->_new($bit, { encode_check => $self->encode_check });
     push @parts, $email;
   }
 

programming_language: Perl
repo_url: https://github.com/rjbs/Email-MIME
commit_details: repo_url: https://github.com/rjbs/Email-MIME
author: Ricardo Signes
author_date: 2024-05-02 13:11:20-04:00
msg: document $MAX_PARTS
repository: repo_url: https://github.com/rjbs/Email-MIME
repo_name: rjbs/Email-MIME
description: perl library for parsing MIME messages
repo_language: Perl
owner: rjbs
file_changes: filename: MIME.pm
change_type: ModificationType.MODIFY
diff: @@ -1060,6 +1060,14 @@ The variable C<$Email::MIME::MAX_DEPTH> is the maximum depth of parts that will
 be processed.  It defaults to 10, already higher than legitimate mail is ever
 likely to be.  This value may go up over time as the parser is improved.
 
+The variable C<$Email::MIME::MAX_PARTS> is the maximum number of parts that
+will be processed.  It defaults to 100, already higher than legitimate mail is
+ever likely to be.  This value may go up over time as the parser is improved or
+as research suggests that our starting position was wrong.
+
+Increasing either of these variables risks significant consumption of memory.
+Test before changing things.
+
 =head1 SEE ALSO
 
 L<Email::Simple>

programming_language: Perl
repo_url: https://github.com/rjbs/Email-MIME
commit_details: repo_url: https://github.com/rjbs/Email-MIME
author: Ricardo Signes
author_date: 2024-05-02 13:22:46-04:00
msg: Changes: mention $MAX_PARTS
repository: repo_url: https://github.com/rjbs/Email-MIME
repo_name: rjbs/Email-MIME
description: perl library for parsing MIME messages
repo_language: Perl
owner: rjbs
file_changes: filename: Changes
change_type: ModificationType.MODIFY
diff: @@ -1,6 +1,11 @@
 Revision history for Perl extension Email::MIME.
 
 {{$NEXT}}
+        - Fix for CVE-2024-4140: An excessive memory use issue (CWE-770)
+          exists in Email-MIME, before version 1.954, which can cause denial of
+          service when parsing multipart MIME messages.  The fix is the new
+          $MAX_PARTS configuration limits how many parts we will consider
+          parsing.  The default $MAX_PARTS is 100.
 
 1.953     2023-01-08 19:02:24-05:00 America/New_York
         - as promised, this release no longer works on v5.8; in fact, due to

programming_language: Markdown