Merge pull request #5881 from psafont/xen_types

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/listext.ml

@@ -208,4 +208,15 @@ module List = struct
   let find_minimum compare =
     let min a b = if compare a b <= 0 then a else b in
     function [] -> None | x :: xs -> Some (List.fold_left min x xs)
+
+  let find_index f l =
+    let rec loop i = function
+      | [] ->
+          None
+      | x :: _ when f x ->
+          Some i
+      | _ :: xs ->
+          loop (i + 1) xs
+    in
+    loop 0 l
 end

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

@@ -60,6 +60,13 @@ module List : sig
       the sort order of [cmp], or [None] if the list is empty. When two ore
       more elements match the lowest value, the left-most is returned. *)
 
+  val find_index : ('a -> bool) -> 'a list -> int option
+  (** [find_index f l] returns the position of the first element in [l] that
+      satisfies [f x]. If there is no such element, returns [None].
+
+      When using OCaml compilers 5.1 or later, please use the standard library
+      instead. *)
+
   (** {1 Using indices to manipulate lists} *)
 
   val chop : int -> 'a list -> 'a list * 'a list

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