From ec9284c0d30348480ffb444d6e94beef05ab4ec4 Mon Sep 17 00:00:00 2001
From: Thomas Gazagnaire <thomas.gazagnaire@eu.citrix.com>
Date: Mon, 11 Jan 2010 17:44:38 +0000
Subject: [PATCH] [rpc-light] Protect the XML strings as xml-light2.

xmlrpc converts '>' to '&gt', '<' to '&lt', '"' to '&quot' and do not erase weird characters (need to use a proper unicode validation functions at one point)

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@citrix.com>
---
 rpc-light/xmlrpc.ml | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml
index c17f79f..3f1dba3 100644
--- a/rpc-light/xmlrpc.ml
+++ b/rpc-light/xmlrpc.ml
@@ -22,14 +22,38 @@ let debug (fmt: ('a, unit, string, unit) format4) : 'a =
 (* marshalling/unmarshalling code *)
 
 (* The XML-RPC is not very clear about what characters can be in a string value ... *)
-let check s =
-	let aux c =
-		let code = int_of_char c in
-		if code <= 31 then
-			failwith (sprintf "%s is not a valid string (it contains char '\\%i')" s code) 
-	in
-	for i = 0 to String.length s - 1 do aux s.[i] done;
-	s
+let encode s =
+	let n = String.length s in
+	let aux = function
+		| '>'    -> Some "&gt;"
+		| '<'    -> Some "&lt;"
+		| '&'    -> Some "&amp;"
+		| '"'    -> Some "&quot;"
+		| c when (c >= '\x20' && c <= '\xff') || c = '\x09' || c = '\x0a' || c = '\x0d'
+		         -> None
+		| _      -> Some "" in
+	let need_encoding =
+		let b = ref false in
+		let i = ref 0 in
+		while not !b && !i < n-1 do
+			b := aux s.[ !i ] <> None;
+			incr i;
+		done;
+		!b in
+	if need_encoding then begin
+		let buf = Buffer.create 0 in
+		let m = ref 0 in
+		for i = 0 to n-1 do
+			match aux s.[i] with
+			| None   -> ()
+			| Some n ->
+				  Buffer.add_substring buf s !m (i - !m);
+				  Buffer.add_string buf n;
+				  m := i + 1
+		done;
+		Buffer.contents buf
+	end else
+		s
 
 let rec add_value f = function
 	| Null ->
@@ -52,7 +76,7 @@ let rec add_value f = function
 
 	| String s ->
 		f "<value>";
-		f (check s);
+		f (encode s);
 		f "</value>"
 
 	| Enum l ->
@@ -88,7 +112,7 @@ let string_of_call call =
 	let add = B.add_string buf in
 	add "<?xml version=\"1.0\"?>";
 	add "<methodCall><methodName>";
-	add (check call.name);
+	add (encode call.name);
 	add "</methodName><params>";
 	List.iter (fun p ->
 		add "<param>";
-- 
2.39.5