diff --git a/xCAT-server/lib/perl/xCAT/XML.pm b/xCAT-server/lib/perl/xCAT/XML.pm index 972b331d2..9c3a2afdc 100644 --- a/xCAT-server/lib/perl/xCAT/XML.pm +++ b/xCAT-server/lib/perl/xCAT/XML.pm @@ -56,6 +56,7 @@ sub build_tree_xml_parser { no_network => 1, expand_entities => 0, ]); + $xp->setHandlers(ExternEnt => sub { return $_[2] }); my($tree); if($filename) { # $tree = $xp->parsefile($filename); # Changed due to prob w/mod_perl diff --git a/xCAT-test/unit/xml_external_entity.t b/xCAT-test/unit/xml_external_entity.t new file mode 100644 index 000000000..02f68605c --- /dev/null +++ b/xCAT-test/unit/xml_external_entity.t @@ -0,0 +1,72 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use File::Temp qw(tempfile); +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; } + +# Prepend so the source-tree module wins over any installed xCAT::XML. +unshift @INC, $libdir; +require xCAT::XML; +require Data::Dumper; + +my ($sfh, $secret_path) = tempfile('xcat_xxe_XXXXXX', TMPDIR => 1, UNLINK => 1); +print {$sfh} "SECRET-CONTENT-DO-NOT-LEAK"; +close $sfh; + +my $payload = <<"XML"; + + ]> +&xxe; +XML + +sub parsed_tree { + my $parser = xCAT::XML->new; + my $tree = eval { $parser->XMLin($payload, SuppressEmpty => undef, ForceArray => 1) }; + return ($tree, $@); +} + +# A parser path must parse the payload, replace the external entity with its +# system identifier, and never read the file contents. +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"); +} + +# The modern path: XML::Simple with new_xml_parser. +SKIP: { + skip 'XML::Simple lacks new_xml_parser on this system', 4 + 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();