From 683d8b3fd64f9baf467d8b659dec1ca7796b429d Mon Sep 17 00:00:00 2001
From: Dylan William Hardison <dylan@hardison.net>
Date: Tue, 2 Oct 2018 20:25:35 -0400
Subject: Bug 1495834 - xmlrpc.cgi outputs headers in request-body

---
 t/.perlcritic-history |  2 +-
 xmlrpc.cgi            | 40 ++++++++++++++++++++++++++++------------
 2 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/t/.perlcritic-history b/t/.perlcritic-history
index fc5e3d6eb..0119922a7 100644
--- a/t/.perlcritic-history
+++ b/t/.perlcritic-history
@@ -77,7 +77,7 @@ $VAR1 = [
             'Perl::Critic::Policy::Modules::RequireEndWithOne' => 0,
             'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 2,
             'Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion' => 0,
-            'Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls' => 3,
+            'Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls' => 4,
             'Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars' => 0,
             'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
             'Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks' => 0,
diff --git a/xmlrpc.cgi b/xmlrpc.cgi
index 07c1020aa..620187e5a 100755
--- a/xmlrpc.cgi
+++ b/xmlrpc.cgi
@@ -16,27 +16,43 @@ use Bugzilla;
 use Bugzilla::Constants;
 use Bugzilla::Error;
 use Bugzilla::WebService::Constants;
+use Capture::Tiny qw(capture_stdout);
+
 BEGIN {
-    if (!Bugzilla->feature('xmlrpc')) {
-        ThrowCodeError('feature_disabled', { feature => 'xmlrpc' });
-    }
+  if (!Bugzilla->feature('xmlrpc')) {
+    ThrowCodeError('feature_disabled', {feature => 'xmlrpc'});
+  }
 }
 use Bugzilla::WebService::Server::XMLRPC;
 
-Bugzilla->usage_mode(USAGE_MODE_XMLRPC);
+my $stdout = capture_stdout {
+  Bugzilla->usage_mode(USAGE_MODE_XMLRPC);
 
 # Fix the error code that SOAP::Lite uses for Perl errors.
-local $SOAP::Constants::FAULT_SERVER;
-$SOAP::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
+  local $SOAP::Constants::FAULT_SERVER;
+  $SOAP::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
+
 # The line above is used, this one is ignored, but SOAP::Lite
 # might start using this constant (the correct one) for XML-RPC someday.
-local $XMLRPC::Constants::FAULT_SERVER;
-$XMLRPC::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
+  local $XMLRPC::Constants::FAULT_SERVER;
+  $XMLRPC::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
+
+  local @INC = (bz_locations()->{extensionsdir}, @INC);
+  my $server = new Bugzilla::WebService::Server::XMLRPC;
 
-local @INC = (bz_locations()->{extensionsdir}, @INC);
-my $server = new Bugzilla::WebService::Server::XMLRPC;
 # We use a sub for on_action because that gets us the info about what
 # class is being called. Note that this is a hack--this is technically
 # for setting SOAPAction, which isn't used by XML-RPC.
-$server->on_action(sub { $server->handle_login(WS_DISPATCH, @_) })
-       ->handle();
+  $server->on_action(sub { $server->handle_login(WS_DISPATCH, @_) })->handle();
+};
+my $C = $Bugzilla::Quantum::CGI::C;
+my ($header_str, $body) = split(/(?:\r\n\r\n|\n\n)/, $stdout, 2);
+my $headers = Mojo::Headers->new;
+$headers->parse("$header_str\r\n\r\n");
+foreach my $name (@{$headers->names}) {
+  $C->res->headers->header($name => $headers->header($name));
+}
+my ($code) = $headers->header('Status') =~ /^(\d+)/;
+$C->res->code($code) if $code;
+$C->write($body);
+exit;
-- 
cgit v1.2.3-24-g4f1b