[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>

diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml
index c17f79f62f8d667669c32da961fbccd15e430dda..3f1dba3a2289ada2cb30c83450c007fd5fd232e3 100644 (file)
--- 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>";