[interchange] Improve application/json POST support

commit 59dd4cd1c764a4113e1f3ff45d9b7b7148481bd9
Author: David Christensen <[email protected]>
Date:   Sat Dec 20 14:48:22 2014 -0600

    Improve application/json POST support
    
    While the code already existed to support "application/json" as a valid content-type for POST
    requests, this did not do anything useful in practice.  So this commit adds the following:
    
    - Add automatic decoding of the POST entity into the variable $CGI::json_ref.  If this variable
      exists, it is already guaranteed to be structurally valid.
    
    - Conditionally handle "application/json" POST mapping into CGI space, using the new UnpackJSON
    directive.  This means that for the POSTed JSON object we will populate %CGI::values with the keys
    of that object with the (potentially deep structured) values of the same object.
    
    We enable UnpackJSON handling by default, though this value is up for debate.  Considering that we
    already don't (shouldn't) trust CGI values, simply making it easier to have structured data using a
    JSON request doesn't seem like there are additional security implications.  Additionally, by shoving
    this into CGI space, we already have ITL/tag support for accessing the values of the response, which
    seem to make this much easier than having redundant UserTags/SystemTags to support inspection of
    $CGI::json_ref for the common use case.

 lib/Vend/Config.pm |    1 +
 lib/Vend/Server.pm |   20 +++++++++++++++++++-
 2 files changed, 20 insertions(+), 1 deletions(-)
---
diff --git a/lib/Vend/Config.pm b/lib/Vend/Config.pm
index 86a63f5..1f9a48a 100644
--- a/lib/Vend/Config.pm
+++ b/lib/Vend/Config.pm
@@ -513,6 +513,7 @@ sub global_directives {
 	['Catalog',			 'catalog',     	 ''],
 	['SubCatalog',		 'catalog',     	 ''],
 	['AutoVariable',	 'autovar',     	 'UrlJoiner'],
+	['UnpackJSON',		 'yesno',	     	 'Yes'],
 	['XHTML',			 'yesno',	     	 'No'],
 	['UTF8',			 'yesno',	     	 $ENV{MINIVEND_DISABLE_UTF8} ? 'No' : 'Yes'],
 	['External',		 'yesno',	     	 'No'],
diff --git a/lib/Vend/Server.pm b/lib/Vend/Server.pm
index 575400b..09fe475 100644
--- a/lib/Vend/Server.pm
+++ b/lib/Vend/Server.pm
@@ -35,6 +35,7 @@ use Errno qw/:POSIX/;
 use Config;
 use Socket;
 use Symbol;
+use JSON ();
 use strict;
 
 no warnings qw(uninitialized);
@@ -260,6 +261,8 @@ EOF
 
 #::logDebug("CGI::query_string=" . $CGI::query_string);
 #::logDebug("entity=" . ${$h->{entity}});
+#::logDebug("request_method=$CGI::request_method");
+#::logDebug("content_type=$CGI::content_type");
 
 #::logDebug("Check robot UA=$Global::RobotUA IP=$Global::RobotIP");
 	if ($Global::RobotIP and $CGI::remote_addr =~ $Global::RobotIP) {
@@ -320,7 +323,22 @@ sub parse_cgi {
 		if ($CGI::content_type =~ m{^(?:multipart/form-data|application/x-www-form-urlencoded|application/xml|application/json)\b}i) {
 			parse_post(\$CGI::query_string, 1)
 				if $Global::TolerateGet;
-			parse_post($h->{entity});
+			if ($CGI::content_type =~ m{^application/json\s*(?:;|$)}i) {
+				$CGI::post_ref = $h->{entity};
+				undef $CGI::json_ref;
+				eval {
+					$CGI::json_ref = JSON::from_json($$CGI::post_ref);
+#::logDebug('json: %s', ::uneval($CGI::json_ref));
+					# populate CGI from json_ref; maybe make a directive?
+					if ($Global::UnpackJSON && ref $CGI::json_ref eq 'HASH') {
+						@CGI::values{keys %$CGI::json_ref} = values %$CGI::json_ref;
+					}
+				};
+				logError("Error parsing JSON data: $@") if $@;
+			}
+			else {
+				parse_post($h->{entity});
+			}
 		}
 		else {
 			## invalid content type for POST