xCAT/xcat-core
2
0
Fork 0
mirror of https://github.com/xcat2/xcat-core.git synced 2026-09-04 20:17:55 +00:00
Code Issues Releases Wiki Activity

Merge pull request #7811 from VersatusHPC/fix/xml-parser-entity-expansion

Browse Source 
fix(xcatd): refuse an XML request that carries a document type declaration
This commit is contained in:
Daniel Hilst
2026-09-02 19:10:48 -03:00
committed by GitHub
parent b4579ef459 43495f7e56
commit c72406cbd1
3 changed files with 108 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files
xCAT-server/lib/perl/xCAT/XML.pm
+8 -14
View File
@@ -50,13 +50,7 @@ sub build_tree_xml_parser {
carp "'nsexpand' option requires XML::SAX";
}
my $xp = XML::Parser->new(Style => 'Tree',
[ load_ext_dtd => 0,
ext_ent_handler => undef,
no_network => 1,
expand_entities => 0,
]);
$xp->setHandlers(ExternEnt => sub { return $_[2] });
my $xp = _hardened_parser();
my($tree);
if($filename) {
# $tree = $xp->parsefile($filename); # Changed due to prob w/mod_perl
@@ -72,13 +66,13 @@ sub build_tree_xml_parser {
sub new_xml_parser {
my($self) = @_;
my $xp = XML::Parser->new(Style => 'Tree',
[ load_ext_dtd => 0,
ext_ent_handler => undef,
no_network => 1,
expand_entities => 0,
]);
$xp->setHandlers(ExternEnt => sub {return $_[2]});
return _hardened_parser();
}
sub _hardened_parser {
my $xp = XML::Parser->new(Style => 'Tree');
$xp->setHandlers(ExternEnt => sub { return $_[2] },
Doctype => sub { croak 'XML document type declaration is not accepted' });
return $xp;
}
1;
xCAT-test/unit/xml_doctype_refused.t
+93
View File
@@ -0,0 +1,93 @@
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use Test::More;
my $libdir = "$FindBin::Bin/../../xCAT-server/lib/perl";
my $xmlpm = "$libdir/xCAT/XML.pm";
plan skip_all => 'xCAT::XML not found' unless -r $xmlpm;
eval { require XML::Simple; require XML::Parser; 1 }
or plan skip_all => 'XML::Simple and XML::Parser are required';
# xCAT::XML loads xCAT::MsgUtils, which loads much of the xCAT tree. The parser
# paths never call it. Stub it before loading xCAT::XML.
BEGIN { $INC{'xCAT/MsgUtils.pm'} = 1; }
{ package xCAT::MsgUtils; }
unshift @INC, $libdir;
require xCAT::XML;
require Data::Dumper;
# An entity that names another entity grows the document on every level.
my $in_text = <<'XML';
<?xml version="1.0"?>
<!DOCTYPE r [ <!ENTITY a "AAAAAAAAAA"> <!ENTITY b "&a;&a;&a;&a;&a;"> ]>
<data>&b;</data>
XML
# The same growth, with the reference inside an attribute value. The option
# that stops the parser expanding an entity does not reach an attribute, so
# this is the case that a refusal of the declaration has to cover.
my $in_attribute = <<'XML';
<?xml version="1.0"?>
<!DOCTYPE r [ <!ENTITY a "AAAAAAAAAA"> <!ENTITY b "&a;&a;&a;&a;&a;"> ]>
<data><child attr="&b;">t</child></data>
XML
# A declaration that carries no entity at all is still refused.
my $bare_doctype = <<'XML';
<?xml version="1.0"?>
<!DOCTYPE xcatrequest>
<xcatrequest><command>rpower</command></xcatrequest>
XML
# What a request normally looks like.
my $ordinary =
'<?xml version="1.0"?><xcatrequest><command>rpower</command>'
. '<noderange>n1</noderange><arg>stat</arg></xcatrequest>';
sub parse_doc {
my ($doc) = @_;
my $tree = eval { xCAT::XML->new->XMLin($doc, SuppressEmpty => undef, ForceArray => 1) };
return ($@, defined($tree) ? Data::Dumper::Dumper($tree) : '');
}
sub check_path {
my ($label) = @_;
foreach my $case ([ 'in element text', $in_text ],
[ 'in an attribute', $in_attribute ],
[ 'with no entity', $bare_doctype ]) {
my ($name, $doc) = @$case;
my ($err, $dump) = parse_doc($doc);
isnt($err, '', "$label: a declaration $name is refused");
unlike($dump, qr/AAAAAAAAAA/, "$label: nothing expands for a declaration $name");
}
my ($err, $dump) = parse_doc($ordinary);
is($err, '', "$label: an ordinary request parses");
like($dump, qr/rpower/, "$label: the command of an ordinary request survives");
like($dump, qr/n1/, "$label: the noderange of an ordinary request survives");
like($dump, qr/stat/, "$label: the argument of an ordinary request survives");
}
# The modern path: XML::Simple with new_xml_parser.
SKIP: {
skip 'XML::Simple lacks new_xml_parser on this system', 10
unless exists &{'XML::Simple::new_xml_parser'};
check_path('modern path');
}
# Force the older compatibility path (build_tree_xml_parser's own code) by
# removing new_xml_parser, as on XML::Simple 2.20-2.24.
{
no strict 'refs';
no warnings 'redefine';
undef *{'XML::Simple::new_xml_parser'} if exists &{'XML::Simple::new_xml_parser'};
}
ok(!exists &{'XML::Simple::new_xml_parser'}, 'compatibility path is forced');
check_path('compatibility path');
done_testing();
xCAT-test/unit/xml_external_entity.t
+7 -7
View File
@@ -38,23 +38,23 @@ sub parsed_tree {
return ($tree, $@);
}
# A parser path must parse the payload, replace the external entity with its
# system identifier, and never read the file contents.
# The contract this file guards is that the contents of the file an external
# entity names never reach the parsed document. A parser path may deliver that
# either by parsing the payload and leaving the entity unresolved, or by
# refusing the payload. Assert the outcome, not the route.
sub check_path {
my ($label) = @_;
my ($tree, $error) = parsed_tree();
is($error, '', "$label: the payload parses without error");
ok(defined($tree), "$label: the parser returns a tree");
my $dump = defined($tree) ? Data::Dumper::Dumper($tree) : '';
like($dump, qr{\Q$secret_path\E},
"$label: the external entity is replaced by its system identifier");
unlike($dump, qr/SECRET-CONTENT-DO-NOT-LEAK/,
"$label: the external entity content is not read");
unlike($error, qr/SECRET-CONTENT-DO-NOT-LEAK/,
"$label: the external entity content does not reach the error either");
}
# The modern path: XML::Simple with new_xml_parser.
SKIP: {
skip 'XML::Simple lacks new_xml_parser on this system', 4
skip 'XML::Simple lacks new_xml_parser on this system', 2
unless exists &{'XML::Simple::new_xml_parser'};
check_path('modern path');
}