Prevent internal subset entity expansion with XML::Parser

Author: scop

lib/XML/Simple.pm

@@ -453,8 +453,9 @@ sub build_tree_xml_parser {
 sub new_xml_parser {
   my($self) = @_;
 
-  my $xp = XML::Parser->new(Style => 'Tree', @{$self->{opt}->{parseropts}});
-  $xp->setHandlers(ExternEnt => sub {return ''});
+  my $xp = XML::Parser->new(Style => 'Tree', NoExpand => 1,
+                            @{$self->{opt}->{parseropts}});
+  $xp->setHandlers(ExternEnt => sub {return ''}, Default => sub {});
 
   return $xp;
 }

t/E_Internal_Entities.t

@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Test::More;
+
+eval { require XML::Parser; };
+if($@) {
+  plan skip_all => 'no XML::Parser';
+}
+
+plan tests => 2;
+
+use XML::Simple;
+
+$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
+
+my $xml = qq(<?xml version="1.0"?>
+<!DOCTYPE foo [
+<!ENTITY b "XML bomb" >]>
+<foo>&b;</foo>
+);
+
+my $opt = XMLin($xml);
+isnt($opt, 'XML bomb', 'Internal subset entity not expanded');
+is_deeply($opt, {}, 'Internal subset entity left as empty');
+
+exit(0);