From 41d3977e22ad6bb141861bc324b9a140e1125984 Mon Sep 17 00:00:00 2001
From: Jarrod Johnson <jjohnson2@lenovo.com>
Date: Fri, 6 Dec 2019 15:43:04 -0500
Subject: [PATCH] Fix insecure processing of XML input

XML::Simple is not up to the task.  Switch to
XML::LibXML::Simple and coax it to not do as much
XML to avoid XXE attacks.
---
 xCAT-server/sbin/xcatd       | 22 +++++++++++++++++++---
 xCAT-server/xCAT-server.spec |  2 +-
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/xCAT-server/sbin/xcatd b/xCAT-server/sbin/xcatd
index 06d6c4036..5513d33ab 100755
--- a/xCAT-server/sbin/xcatd
+++ b/xCAT-server/sbin/xcatd
@@ -119,6 +119,7 @@ use IO::Handle;
 use IO::Select;
 use XML::Simple;
 $XML::Simple::PREFERRED_PARSER = 'XML::Parser';
+use XML::LibXML::Simple;
 use xCAT::Table;
 my $dbmaster;
 use xCAT::ExtTab;
@@ -691,7 +692,12 @@ sub do_discovery_process {
             IO::Uncompress::Gunzip::gunzip(\$data, \$bigdata);
             $data = $bigdata;
         }
-        my $req = eval { XMLin($data, SuppressEmpty => undef, ForceArray => 1) };
+        my $req = eval { XMLin($data, SuppressEmpty => undef, ForceArray => qr/.*/, ParserOpts => [
+            load_ext_dtd => 0,
+            ext_ent_handler => undef,
+            no_network => 1,
+            expand_entities => 0,
+        ]) };
         if ($req and $req->{command} and ($req->{command}->[0] eq "findme" and $sport < 1000)) { # only consider priveleged port requests to start with
             $req->{'_xcat_clientip'}   = $clientip;
             $req->{'_xcat_clientport'} = $sport;
@@ -2716,7 +2722,12 @@ sub send_response {
         my $cmdlog_xml = "<massresponse>";
         $tmp_xml =~ s/\e/xxxxESCxxxx/g;
         $cmdlog_xml .= $tmp_xml . "</massresponse>";
-        my $cmdlog_rsp = XMLin($cmdlog_xml, SuppressEmpty => undef, ForceArray => 1);
+        my $cmdlog_rsp = XMLin($cmdlog_xml, SuppressEmpty => undef, ForceArray => qr/.*/, ParserOpts => [
+            load_ext_dtd => 0,
+            ext_ent_handler => undef,
+            no_network => 1,
+            expand_entities => 0,
+        ]);
         cmdlog_collectlog($cmdlog_rsp);
 
         # ----used for command log end --------
@@ -2773,7 +2784,12 @@ sub get_request {
                 return undef;
             }
         }
-        return eval { XMLin($request, SuppressEmpty => undef, ForceArray => 1) };
+        return eval { XMLin($request, SuppressEmpty => undef, ForceArray => qr/.*/, ParserOpts => [
+            load_ext_dtd => 0,
+            ext_ent_handler => undef,
+            no_network => 1,
+            expand_entities => 0,
+        ]) };
     } elsif ($encode eq "storable") {
         my $return = eval { fd_retrieve($sock); };   # suppres end of stream err
         return $return;
diff --git a/xCAT-server/xCAT-server.spec b/xCAT-server/xCAT-server.spec
index 2df34e621..a4f1cc748 100644
--- a/xCAT-server/xCAT-server.spec
+++ b/xCAT-server/xCAT-server.spec
@@ -47,7 +47,7 @@ Obsoletes: atftp-xcat
 %endif
 
 %if "%{dist}" == ".el8"
-Requires: perl-Time-HiRes perl-Sys-Syslog perl-Text-Balanced perl-DB_File perl-XML-LibXML perl-Expect net-snmp-perl perl-Net-DNS perl-Net-Ping
+Requires: perl-Time-HiRes perl-Sys-Syslog perl-Text-Balanced perl-DB_File perl-XML-LibXML perl-Expect net-snmp-perl perl-Net-DNS perl-Net-Ping perl-XML-LibXML-Simple
 %endif
 
 # The aix rpm cmd forces us to do this outside of ifos type stmts