# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID a571cd80dcb8a38c72b58bbc05b49cf14409c883
# Parent  908be71d7e00c6ebedb89a674276686cd62ec433
[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@xxxxxxxxxx>

diff -r 908be71d7e00 -r a571cd80dcb8 rpc-light/xmlrpc.ml
--- a/rpc-light/xmlrpc.ml	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.ml	Fri Jan 08 13:47:46 2010 +0000
@@ -22,14 +22,38 @@
 (* 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 @@
 
 	| String s ->
 		f "<value>";
-		f (check s);
+		f (encode s);
 		f "</value>"
 
 	| Enum l ->
@@ -88,7 +112,7 @@
 	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>";