xapi-idl: Delete String.{explode,implode} functions

These are highly inefficient.

Also changes some functions to be able to have less types and make normal usage
clearer. This comes at the cost of having to destructure the main type when
pattern-matching it.

Moves the device_number tests to its own executable to easily iterate on the
tests.

Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>

ocaml/idl/markdown_backend.ml

@@ -43,8 +43,6 @@ let compare_case_ins x y =
   compare (String.lowercase_ascii x) (String.lowercase_ascii y)
 
 let escape s =
-  let open Xapi_stdext_std.Xstringext in
-  let sl = String.explode s in
   let esc_char = function
     | '\\' ->
         "\"
@@ -79,8 +77,7 @@ let escape s =
     | c ->
         String.make 1 c
   in
-  let escaped_list = List.map esc_char sl in
-  String.concat "" escaped_list
+  String.to_seq s |> Seq.map esc_char |> List.of_seq |> String.concat ""
 
 let rec of_ty_verbatim = function
   | SecretString | String ->

ocaml/libs/http-lib/http.ml

@@ -24,8 +24,6 @@ exception Forbidden
 
 exception Method_not_implemented
 
-exception Malformed_url of string
-
 exception Timeout
 
 exception Too_large
@@ -145,61 +143,8 @@ let output_http fd headers =
   |> String.concat ""
   |> Unixext.really_write_string fd
 
-let explode str = Astring.String.fold_right (fun c acc -> c :: acc) str []
-
-let implode chr_list =
-  String.concat "" (List.map Astring.String.of_char chr_list)
-
-let urldecode url =
-  let chars = explode url in
-  let rec fn ac = function
-    | '+' :: tl ->
-        fn (' ' :: ac) tl
-    | '%' :: a :: b :: tl ->
-        let cs =
-          try int_of_string (implode ['0'; 'x'; a; b])
-          with _ -> raise (Malformed_url url)
-        in
-        fn (Char.chr cs :: ac) tl
-    | x :: tl ->
-        fn (x :: ac) tl
-    | [] ->
-        implode (List.rev ac)
-  in
-  fn [] chars
-
 (* Encode @param suitably for appearing in a query parameter in a URL. *)
-let urlencode param =
-  let chars = explode param in
-  let rec fn = function
-    | x :: tl ->
-        let s =
-          if x = ' ' then
-            "+"
-          else
-            match x with
-            | 'A' .. 'Z'
-            | 'a' .. 'z'
-            | '0' .. '9'
-            | '$'
-            | '-'
-            | '_'
-            | '.'
-            | '!'
-            | '*'
-            | '\''
-            | '('
-            | ')'
-            | ',' ->
-                Astring.String.of_char x
-            | _ ->
-                Printf.sprintf "%%%2x" (Char.code x)
-        in
-        s ^ fn tl
-    | [] ->
-        ""
-  in
-  fn chars
+let urlencode param = Uri.pct_encode ~component:`Query param
 
 (** Parses strings of the form a=b;c=d (new, RFC-compliant cookie format)
     and a=b&c=d (old, incorrect style) into [("a", "b"); ("c", "d")] *)
@@ -219,7 +164,7 @@ let parse_cookies xs =
   List.map
     (function
       | k :: vs ->
-          (urldecode k, urldecode (String.concat "=" vs))
+          (Uri.pct_decode k, Uri.pct_decode (String.concat "=" vs))
       | [] ->
           raise Http_parse_failure
       )

ocaml/libs/http-lib/http.mli

@@ -235,6 +235,7 @@ val output_http : Unix.file_descr -> string list -> unit
 val parse_cookies : string -> (string * string) list
 
 val urlencode : string -> string
+(** Encode parameter suitably for appearing in a query parameter in a URL. *)
 
 type 'a ll = End | Item of 'a * (unit -> 'a ll)
 

ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml

@@ -39,10 +39,6 @@ module String = struct
     done ;
     !accu
 
-  let explode string = fold_right (fun h t -> h :: t) string []
-
-  let implode list = concat "" (List.map of_char list)
-
   (** True if string 'x' ends with suffix 'suffix' *)
   let endswith suffix x =
     let x_l = String.length x and suffix_l = String.length suffix in
@@ -56,16 +52,6 @@ module String = struct
   (** Returns true for whitespace characters, false otherwise *)
   let isspace = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false
 
-  (** Removes all the characters from the ends of a string for which the predicate is true *)
-  let strip predicate string =
-    let rec remove = function
-      | [] ->
-          []
-      | c :: cs ->
-          if predicate c then remove cs else c :: cs
-    in
-    implode (List.rev (remove (List.rev (remove (explode string)))))
-
   let escaped ?rules string =
     match rules with
     | None ->
@@ -81,24 +67,28 @@ module String = struct
         in
         concat "" (fold_right aux string [])
 
-  (** Take a predicate and a string, return a list of strings separated by
-      runs of characters where the predicate was true (excluding those characters from the result) *)
   let split_f p str =
-    let not_p x = not (p x) in
-    let rec split_one p acc = function
-      | [] ->
-          (List.rev acc, [])
-      | c :: cs ->
-          if p c then split_one p (c :: acc) cs else (List.rev acc, c :: cs)
+    let split_one seq =
+      let not_p c = not (p c) in
+      let a = Seq.take_while not_p seq in
+      let b = Seq.drop_while not_p seq in
+      (a, b)
     in
-    let rec alternate acc drop chars =
-      if chars = [] then
+    let drop seq = Seq.drop_while p seq in
+    let rec split acc chars =
+      if Seq.is_empty chars then
         acc
       else
-        let a, b = split_one (if drop then p else not_p) [] chars in
-        alternate (if drop then acc else a :: acc) (not drop) b
+        let a, b = split_one chars in
+        let b = drop b in
+        let acc = if Seq.is_empty a then acc else Seq.cons a acc in
+        split acc b
     in
-    List.rev (List.map implode (alternate [] true (explode str)))
+    String.to_seq str
+    |> split Seq.empty
+    |> Seq.map String.of_seq
+    |> List.of_seq
+    |> List.rev
 
   let index_opt s c =
     let rec loop i =

ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli

@@ -29,12 +29,6 @@ module String : sig
   val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a
   (** Iterate over the characters in a string in reverse order. *)
 
-  val explode : string -> char list
-  (** Split a string into a list of characters. *)
-
-  val implode : char list -> string
-  (** Concatenate a list of characters into a string. *)
-
   val endswith : string -> string -> bool
   (** True if string 'x' ends with suffix 'suffix' *)
 
@@ -44,17 +38,15 @@ module String : sig
   val isspace : char -> bool
   (** True if the character is whitespace *)
 
-  val strip : (char -> bool) -> string -> string
-  (** Removes all the characters from the ends of a string for which the predicate is true *)
-
   val escaped : ?rules:(char * string) list -> string -> string
   (** Backward-compatible string escaping, defaulting to the built-in
       	OCaml string escaping but allowing an arbitrary mapping from characters
       	to strings. *)
 
   val split_f : (char -> bool) -> string -> string list
   (** Take a predicate and a string, return a list of strings separated by
-      	runs of characters where the predicate was true *)
+      runs of characters where the predicate was true. Avoid if possible, it's
+      very costly to execute. *)
 
   val split : ?limit:int -> char -> string -> string list
   (** split a string on a single char *)

ocaml/perftest/createpool.ml

@@ -350,24 +350,20 @@ let create_sdk_pool session_id sdkname pool_name key ipbase =
   let pingable = Array.make (Array.length hosts) false in
   let firstboot = Array.make (Array.length hosts) false in
   let string_of_status () =
-    Xstringext.String.implode
-      (Array.to_list
-         (Array.mapi
-            (fun i ping ->
-              let boot = firstboot.(i) in
-              match (ping, boot) with
-              | false, false ->
-                  '.'
-              | true, false ->
-                  'P'
-              | true, true ->
-                  'B'
-              | _, _ ->
-                  '?'
-            )
-            pingable
-         )
-      )
+    Array.to_seq pingable
+    |> Seq.mapi (fun i ping ->
+           let boot = firstboot.(i) in
+           match (ping, boot) with
+           | false, false ->
+               '.'
+           | true, false ->
+               'P'
+           | true, true ->
+               'B'
+           | _, _ ->
+               '?'
+       )
+    |> String.of_seq
   in
   let has_guest_booted i _vm =
     let ip = Printf.sprintf "192.168.%d.%d" pool.ipbase (i + 1) in
@@ -469,24 +465,20 @@ let create_sdk_pool session_id sdkname pool_name key ipbase =
   let live = Array.make (Array.length hosts) false in
   let enabled = Array.make (Array.length hosts) false in
   let string_of_status () =
-    Xstringext.String.implode
-      (Array.to_list
-         (Array.mapi
-            (fun i live ->
-              let enabled = enabled.(i) in
-              match (live, enabled) with
-              | false, false ->
-                  '.'
-              | true, false ->
-                  'L'
-              | true, true ->
-                  'E'
-              | _, _ ->
-                  '?'
-            )
-            live
-         )
-      )
+    Array.to_seq live
+    |> Seq.mapi (fun i live ->
+           let enabled = enabled.(i) in
+           match (live, enabled) with
+           | false, false ->
+               '.'
+           | true, false ->
+               'L'
+           | true, true ->
+               'E'
+           | _, _ ->
+               '?'
+       )
+    |> String.of_seq
   in
   let has_host_booted rpc session_id i host =
     try