Skip to content
Permalink
Browse files Browse the repository at this point in the history
Fix XML Parser to fail on external entities
Bump dependency on LibXML to the latest because of their recent
new() signature change
  • Loading branch information
yannk committed Jun 13, 2011
1 parent 3fc3698 commit b41d6dc
Show file tree
Hide file tree
Showing 4 changed files with 58 additions and 6 deletions.
1 change: 1 addition & 0 deletions Makefile.PL
Expand Up @@ -9,6 +9,7 @@ WriteMakefile(
PREREQ_PM => {
'Danga::Socket' => 1.51,
'XML::SAX' => 0,
'XML::LibXML' => 1.70,
'XML::LibXML::SAX' => 0,
'Net::DNS' => 0.48,
'Net::SSLeay' => 0,
Expand Down
12 changes: 11 additions & 1 deletion lib/DJabberd/XMLParser.pm
Expand Up @@ -16,7 +16,17 @@ sub new {

# 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;

Expand Down
1 change: 1 addition & 0 deletions t/v.txt
@@ -0,0 +1 @@
vuln
50 changes: 45 additions & 5 deletions t/xmlparsing.t
Expand Up @@ -6,7 +6,7 @@ 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'>
Expand Down Expand Up @@ -43,14 +43,49 @@ 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;
Expand Down Expand Up @@ -80,9 +115,14 @@ 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 {
Expand Down

0 comments on commit b41d6dc

Please sign in to comment.