mirror of
https://github.com/xcat2/xcat-core.git
synced 2026-09-04 20:17:55 +00:00
Vinícius Ferrão
cfb54fcf1a
The test required the parser to parse a payload that names an external entity and to leave the system identifier of that entity in the document. That is one way to keep the contents of the named file out of the document, and it is the way the parser behaves today, but it is not the contract. The contract is that the contents never arrive. Assert that instead: the contents reach neither the document nor the error. A parser that refuses the payload keeps the contract as well as a parser that parses it and leaves the entity alone. Behaviour does not change. The test passes against this branch and against the current parser.
73 lines
2.4 KiB
Perl
73 lines
2.4 KiB
Perl
#!/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";
|
|
<?xml version="1.0"?>
|
|
<!DOCTYPE r [ <!ENTITY xxe SYSTEM "file://$secret_path"> ]>
|
|
<data>&xxe;</data>
|
|
XML
|
|
|
|
sub parsed_tree {
|
|
my $parser = xCAT::XML->new;
|
|
my $tree = eval { $parser->XMLin($payload, SuppressEmpty => undef, ForceArray => 1) };
|
|
return ($tree, $@);
|
|
}
|
|
|
|
# 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();
|
|
my $dump = defined($tree) ? Data::Dumper::Dumper($tree) : '';
|
|
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', 2
|
|
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();
|