CVE-2011-2206: Resource Management Errors (CWE-399)
value: XMLParser.pm in DJabberd before 0.85 allows remote authenticated users to read arbitrary files, and possibly send HTTP requests to intranet servers or cause a denial of service (CPU and memory consumption), via an XML external entity declaration in conjunction with an entity reference, a different vulnerability than CVE-2011-1757.
CWE description: Weaknesses in this category are related to improper management of system resources.
Published: 2011-06-22T22:55Z
Repository: https://github.com/djabberd/DJabberd
Language: Other
Files changed: Makefile.PL, lib/DJabberd/XMLParser.pm, t/v.txt, t/xmlparsing.t
Commit date: 2011-06-13 14:50:25 -0700
Commit message: Fix XML Parser to fail on external entities

Bump dependency on LibXML to the latest because of their recent
new() signature change

Diff: diff --git a/Makefile.PL b/Makefile.PL
index cfc06e2..64e9546 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -7,10 +7,11 @@ WriteMakefile(
               EXE_FILES    => ['djabberd'],
               ABSTRACT_FROM => 'lib/DJabberd.pm',
               PREREQ_PM    => {
                   'Danga::Socket'                => 1.51,
                   'XML::SAX'                     => 0,
+                  'XML::LibXML'                  => 1.70,
                   'XML::LibXML::SAX'             => 0,
                   'Net::DNS'                     => 0.48,
                   'Net::SSLeay'                  => 0,
                   'Log::Log4perl'                => 0,
                   'Digest::HMAC_SHA1'            => 0,
diff --git a/lib/DJabberd/XMLParser.pm b/lib/DJabberd/XMLParser.pm
index acac810..09b9aa4 100644
--- a/lib/DJabberd/XMLParser.pm
+++ b/lib/DJabberd/XMLParser.pm
@@ -14,11 +14,21 @@ sub new {
     my ($class, @params) = @_;
     my $self = $class->SUPER::new(@params);
 
     # libxml mode:
     if (1) {
-        my $libxml = XML::LibXML->new;
+        my $libxml = XML::LibXML->new({
+            no_network => 1,
+            load_ext_dtd => 0,
+            expand_entities => 0,
+            expand_xinclude => 0,
+            ext_ent_handler => sub {
+                # my ($sys_id, $pub_id) = @_;
+                # warn "Received external entity: $sys_id:$pub_id";
+                "";
+            },
+        });
         $libxml->set_handler($self);
         $self->{LibParser} = $libxml;
 
         # this buys nothing but less noise when using Devel::Cycle:
         # make it a developer option?
diff --git a/t/v.txt b/t/v.txt
new file mode 100644
index 0000000..d8f7879
--- /dev/null
+++ b/t/v.txt
@@ -0,0 +1 @@
+vuln
diff --git a/t/xmlparsing.t b/t/xmlparsing.t
index f1c662b..e4a46f4 100644
--- a/t/xmlparsing.t
+++ b/t/xmlparsing.t
@@ -4,11 +4,11 @@ use strict;
 use warnings;
 use XML::SAX;
 use DJabberd::XMLParser;
 use XML::SAX::PurePerl;
 use Scalar::Util qw(weaken);
-use Test::More tests => 10;
+use Test::More tests => 14;
 use Data::Dumper;
 
 my $fulldoc = qq{<?xml version="1.0"?><root xmlns='root' xmlns:a='aa' global='foo' xmlns:b='bb' a:name='aname' b:name='bname' name='globalname'>
   <a:tag />
   <b:tag />
@@ -41,18 +41,53 @@ my $ref;
 ok(!$ref, "p went away");
 
 {
     my $handler = EventRecorder->new(\$dummy);
     my $p       = DJabberd::XMLParser->new(Handler => $handler);
-    $p->parse_more("<foo><tag>");
+    $p->parse_more("<foo>&lt;<tag>");
     $p->finish_push;
     like($dummy, qr/foo.+tag/s);
     $ref = \$p;
     weaken($ref);
 }
 ok(!$ref, "p went away");
 
+## external entities are disabled
+{
+    use FindBin;
+    my $v = "$FindBin::Bin/v.txt";
+
+    my $xml1 = <<"EOF";
+<?xml version="1.0"?>
+<!DOCTYPE foo [
+<!ENTITY a PUBLIC "//foo" "file:$v">
+]>
+<root>
+  <a>&lt; A=&a;</a>
+</root>
+EOF
+    my $xml2 = <<"EOF";
+<?xml version="1.0"?>
+<!DOCTYPE foo [
+<!ENTITY b SYSTEM "file://$v">
+]>
+<root>
+  <b>B=&b;</b>
+</root>
+EOF
+    for ($xml1, $xml2) {
+        my $handler = EventRecorder->new(\$dummy);
+        my $p       = DJabberd::XMLParser->new(Handler => $handler);
+        eval {
+            $p->parse_more($_);
+            $p->finish_push;
+        };
+        ok $@, "died on unknown entity: $@";
+        unlike($dummy, qr/vuln/si);
+    }
+}
+
 # byte at a time
 my $n = 0;
 my $byte_events;
 while ($n < ($ENV{BYTE_RUNS} || 1)) {
     $n++;
@@ -78,13 +113,18 @@ use base qw(XML::SAX::Base);
 use Data::Dumper;
 
 sub new {
     my ($class, $outref) = @_;
     $$outref = "";
-    return bless {
-        outref => $outref,
-    };
+    my $self = $class->SUPER::new();
+    $self->{outref} = $outref;
+    return $self;
+}
+
+sub characters {
+    my ($self, $data) = @_;
+    ${ $self->{outref} } .= $data->{Data};
 }
 
 sub start_element {
     my ($self, $data) = @_;
     $Data::Dumper::Sortkeys = 1;

Vulnerable code:         my $libxml = XML::LibXML->new;
use Test::More tests => 10;
    $p->parse_more("<foo><tag>");
    return bless {
        outref => $outref,
    };
Fixed code:                   'XML::LibXML'                  => 1.70,
        my $libxml = XML::LibXML->new({
            no_network => 1,
            load_ext_dtd => 0,
            expand_entities => 0,
            expand_xinclude => 0,
            ext_ent_handler => sub {
                # my ($sys_id, $pub_id) = @_;
                # warn "Received external entity: $sys_id:$pub_id";
                "";
            },
        });
vuln
use Test::More tests => 14;
    $p->parse_more("<foo>&lt;<tag>");
## external entities are disabled
{
    use FindBin;
    my $v = "$FindBin::Bin/v.txt";

    my $xml1 = <<"EOF";
<?xml version="1.0"?>
<!DOCTYPE foo [
<!ENTITY a PUBLIC "//foo" "file:$v">
]>
<root>
  <a>&lt; A=&a;</a>
</root>
EOF
    my $xml2 = <<"EOF";
<?xml version="1.0"?>
<!DOCTYPE foo [
<!ENTITY b SYSTEM "file://$v">
]>
<root>
  <b>B=&b;</b>
</root>
EOF
    for ($xml1, $xml2) {
        my $handler = EventRecorder->new(\$dummy);
        my $p       = DJabberd::XMLParser->new(Handler => $handler);
        eval {
            $p->parse_more($_);
            $p->finish_push;
        };
        ok $@, "died on unknown entity: $@";
        unlike($dummy, qr/vuln/si);
    }
}

    my $self = $class->SUPER::new();
    $self->{outref} = $outref;
    return $self;
}

sub characters {
    my ($self, $data) = @_;
    ${ $self->{outref} } .= $data->{Data};