xapi-stdext-std: replace String.split_f with Astring functions

This also allows to drop String.isspace

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

Author: psafont

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

@@ -12,37 +12,6 @@
  * GNU Lesser General Public License for more details.
  *)
 module String = struct
-  (** Returns true for whitespace characters, false otherwise *)
-  let isspace = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false
-
-  let split_f p str =
-    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 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 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
-    String.to_seq str
-    |> split Seq.empty
-    |> Seq.map String.of_seq
-    |> List.of_seq
-    |> List.rev
-
   let sub_to_end s start =
     let length = String.length s in
     String.sub s start (length - start)

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

@@ -12,19 +12,11 @@
  * GNU Lesser General Public License for more details.
  *)
 module String : sig
-  val isspace : char -> bool
-  (** True if the character is whitespace *)
-
   val replaced : replace:(char -> string option) -> string -> string
   (** [replaced ~replacement str] applies [replace] to all characters in [str]
       and when it returns [Some rep] the character is replaced with [rep] in
       the resulting string *)
 
-  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. 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/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml

@@ -52,24 +52,6 @@ let test_split =
   in
   ("split", tests)
 
-let test_split_f =
-  let specs =
-    [
-      (XString.isspace, "foo bar", ["foo"; "bar"])
-    ; (XString.isspace, "foo  bar", ["foo"; "bar"])
-    ; (XString.isspace, "foo \n\t\r bar", ["foo"; "bar"])
-    ; (XString.isspace, " foo bar ", ["foo"; "bar"])
-    ; (XString.isspace, "", [])
-    ; (XString.isspace, " ", [])
-    ]
-  in
-  let test (splitter, splitted, expected) =
-    let name = Printf.sprintf {|"%s"|} (String.escaped splitted) in
-    test_list (XString.split_f splitter) (name, splitted, expected)
-  in
-  let tests = List.map test specs in
-  ("split_f", tests)
-
 let test_rtrim =
   let spec =
     [
@@ -90,5 +72,4 @@ let test_rtrim =
   in
   ("rtrim", List.map test spec)
 
-let () =
-  Alcotest.run "Xstringext" [test_split; test_split_f; test_rtrim]
+let () = Alcotest.run "Xstringext" [test_split; test_rtrim]

ocaml/tests/test_guest_agent.ml

@@ -42,9 +42,7 @@ module Networks = Generic.MakeStateless (struct
     )
 
   let construct_tree tree path =
-    let nodes =
-      Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path
-    in
+    let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in
     add_path_to_tree tree nodes
 
   let rec list_helper children = function
@@ -60,9 +58,7 @@ module Networks = Generic.MakeStateless (struct
     )
 
   let list (T (_root, children)) path =
-    let nodes =
-      Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path
-    in
+    let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in
     list_helper children nodes
 
   let transform input =
@@ -231,9 +227,7 @@ module Initial_guest_metrics = Generic.MakeStateless (struct
     )
 
   let construct_mtree mtree (path, leaf_value) =
-    let nodes =
-      Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path
-    in
+    let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in
     add_leaf_to_mtree nodes leaf_value mtree
 
   let rec list_helper children = function
@@ -254,9 +248,7 @@ module Initial_guest_metrics = Generic.MakeStateless (struct
     | Lf (_, _) ->
         []
     | Mt (_, children) ->
-        let nodes =
-          Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path
-        in
+        let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in
         list_helper children nodes
 
   let rec lookup_helper mtree = function
@@ -274,9 +266,7 @@ module Initial_guest_metrics = Generic.MakeStateless (struct
     )
 
   let lookup mtree path =
-    let nodes =
-      Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path
-    in
+    let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in
     lookup_helper mtree nodes
 
   let transform input =

ocaml/xapi/workload_balancing.ml

@@ -74,25 +74,12 @@ let raise_internal_error args =
   raise (Api_errors.Server_error (Api_errors.wlb_internal_error, args))
 
 let split_host_port url =
-  try
-    if url.[0] = '[' then (
-      (* IPv6 *)
-      let host_end = String.rindex url ']' in
-      if url.[host_end + 1] <> ':' then raise_url_invalid url ;
-      let host = String.sub url 1 (host_end - 1) in
-      let port =
-        String.sub url (host_end + 2) (String.length url - host_end - 2)
-      in
-      (host, int_of_string port)
-    ) else
-      match
-        Xapi_stdext_std.Xstringext.String.split_f (fun a -> a = ':') url
-      with
-      | [host; port] ->
-          (host, int_of_string port)
-      | _ ->
-          raise_url_invalid url
-  with _ -> raise_url_invalid url
+  let uri = Uri.of_string ("//" ^ url) in
+  match (Uri.host uri, Uri.port uri) with
+  | None, _ | _, None ->
+      raise_url_invalid url
+  | Some host, Some port ->
+      (host, port)
 
 let wlb_host_port ~__context =
   let pool = Helpers.get_pool ~__context in

ocaml/xapi/xapi_globs.ml

@@ -1388,12 +1388,12 @@ let citrix_patch_key =
 
 let trusted_patch_key = ref citrix_patch_key
 
+let fields_of = Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white)
+
 let gen_list_option name desc of_string string_of opt =
   let parse s =
     opt := [] ;
-    try
-      Xapi_stdext_std.Xstringext.String.(split_f isspace s)
-      |> List.iter (fun x -> opt := of_string x :: !opt)
+    try fields_of s |> List.iter (fun x -> opt := of_string x :: !opt)
     with e ->
       D.error "Unable to parse %s=%s (expected space-separated list) error: %s"
         name s (Printexc.to_string e)

ocaml/xapi/xapi_host_crashdump.ml

@@ -16,7 +16,6 @@
 *)
 
 module Listext = Xapi_stdext_std.Listext
-module Xstringext = Xapi_stdext_std.Xstringext
 module Date = Clock.Date
 open Xapi_stdext_pervasives.Pervasiveext
 open Xapi_support
@@ -50,6 +49,8 @@ let delete_crashdump_dir filename =
       (ExnHelper.string_of_exn e) ;
     raise e
 
+let fields_of = Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white)
+
 (* Called once on host boot to resync the crash directory with the database *)
 let resynchronise ~__context ~host =
   debug "Xapi_host_crashdump.resynchronise" ;
@@ -103,9 +104,7 @@ let resynchronise ~__context ~host =
       debug "Adding record corresponding to new crashdump %s" filename ;
       let cmd = Printf.sprintf "%s --bytes -s %s/%s" du crash_dir filename in
       let size =
-        match
-          Xstringext.String.(split_f isspace (Helpers.get_process_output cmd))
-        with
+        match fields_of (Helpers.get_process_output cmd) with
         | size :: _ ->
             Int64.of_string size
         | _ ->

ocaml/xapi/xapi_pif.ml

@@ -19,7 +19,6 @@ module L = Debug.Make (struct let name = "license" end)
 
 open Xapi_database.Db_filter_types
 module Listext = Xapi_stdext_std.Listext.List
-module Stringext = Xapi_stdext_std.Xstringext.String
 module Date = Clock.Date
 open Network
 
@@ -717,6 +716,8 @@ let forget ~__context ~self =
 
 let scan_m = Mutex.create ()
 
+let fields_of = Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white)
+
 let scan ~__context ~host =
   let dbg = Context.string_of_task __context in
   refresh_all ~__context ~host ;
@@ -732,9 +733,9 @@ let scan ~__context ~host =
             debug "No boot from SAN interface found" ;
             ([], [])
         | m :: u :: _ ->
-            Stringext.(split_f isspace m, split_f isspace u)
+            (fields_of m, fields_of u)
         | m :: _ ->
-            Stringext.(split_f isspace m, [])
+            (fields_of m, [])
       with e ->
         warn "Error when executing script %s: %s; ignoring"
           !Xapi_globs.non_managed_pifs

ocaml/xapi/xha_interface.ml

@@ -349,9 +349,10 @@ module LiveSetInformation = struct
             | Some u ->
                 u
           in
-          let set f x =
-            List.map f Xapi_stdext_std.Xstringext.String.(split_f isspace x)
+          let fields_of =
+            Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white)
           in
+          let set f x = List.map f (fields_of x) in
           Some
             {
               id= uuid (find "HostID")