xapi-stdext-std: remove most functions, optimize escaping functions

doc/content/xapi/cli/_index.md

@@ -156,7 +156,7 @@ So each function receives a printer for sending text output to the xe client, an
       let mac = List.assoc_default "mac" params "" in
       let network = Client.Network.get_by_uuid rpc session_id network in
       let pifs = List.assoc "pif-uuids" params in
-      let uuids = String.split ',' pifs in
+      let uuids = String.split_on_char ',' pifs in
       let pifs = List.map (fun uuid -> Client.PIF.get_by_uuid rpc session_id uuid) uuids in
       let mode = Record_util.bond_mode_of_string (List.assoc_default "mode" params "") in
       let properties = read_map_params "properties" params in

ocaml/database/parse_db_conf.ml

@@ -13,7 +13,6 @@
  *)
 (* !!! This needs to be moved out of xapi and into the database directory; probably being merged with db_connections !!! *)
 
-open Xapi_stdext_std.Xstringext
 open Xapi_stdext_unix
 
 module D = Debug.Make (struct let name = "parse_db_conf" end)
@@ -110,7 +109,7 @@ let parse_db_conf s =
     let conf = Unixext.string_of_file s in
     let lines : string list ref = ref [] in
     let consume_line () = lines := List.tl !lines in
-    lines := String.split '\n' conf ;
+    lines := String.split_on_char '\n' conf ;
     List.iter (fun line -> debug "%s" line) !lines ;
     let read_block () =
       let path_line = List.hd !lines in
@@ -120,7 +119,7 @@ let parse_db_conf s =
       while !lines <> [] && List.hd !lines <> "" do
         let line = List.hd !lines in
         key_values :=
-          ( match String.split ':' line with
+          ( match String.split_on_char ':' line with
           | k :: vs ->
               ( String.lowercase_ascii k
               , String.lowercase_ascii (String.concat ":" vs)

ocaml/database/redo_log.ml

@@ -12,7 +12,6 @@
  * GNU Lesser General Public License for more details.
  *)
 open Xapi_stdext_pervasives.Pervasiveext
-open Xapi_stdext_std.Xstringext
 open Xapi_stdext_unix
 
 let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute

ocaml/doc/dune

@@ -1,7 +1,7 @@
 (executable
   (modes exe)
   (name jsapi)
-  (libraries    
+  (libraries
     mustache
     rpclib.core
     rpclib.json
@@ -10,7 +10,6 @@
     xapi-consts
     xapi-datamodel
     xapi-stdext-pervasives
-    xapi-stdext-std
     xapi-stdext-unix
   )
   (preprocess (pps ppx_deriving_rpc))

ocaml/doc/jsapi.ml

@@ -12,7 +12,6 @@
  * GNU Lesser General Public License for more details.
  *)
 
-open Xapi_stdext_std.Xstringext
 open Xapi_stdext_pervasives.Pervasiveext
 module Unixext = Xapi_stdext_unix.Unixext
 open Datamodel_types

ocaml/idl/markdown_backend.ml

@@ -43,41 +43,41 @@ let compare_case_ins x y =
   compare (String.lowercase_ascii x) (String.lowercase_ascii y)
 
 let escape s =
-  let esc_char = function
+  let replace = function
     | '\\' ->
-        "\"
+        Some "\"
     | '*' ->
-        "*"
+        Some "*"
     | '_' ->
-        "_"
+        Some "_"
     | '{' ->
-        "{"
+        Some "{"
     | '}' ->
-        "}"
+        Some "}"
     | '[' ->
-        "["
+        Some "["
     | ']' ->
-        "]"
+        Some "]"
     | '(' ->
-        "("
+        Some "("
     | ')' ->
-        ")"
+        Some ")"
     | '>' ->
-        ">"
+        Some ">"
     | '<' ->
-        "&lt;"
+        Some "&lt;"
     | '#' ->
-        "&#35;"
+        Some "&#35;"
     | '+' ->
-        "&#43;"
+        Some "&#43;"
     | '-' ->
-        "&#45;"
+        Some "&#45;"
     | '!' ->
-        "&#33;"
-    | c ->
-        String.make 1 c
+        Some "&#33;"
+    | _ ->
+        None
   in
-  String.to_seq s |> Seq.map esc_char |> List.of_seq |> String.concat ""
+  Xapi_stdext_std.Xstringext.String.replaced ~replace s
 
 let rec of_ty_verbatim = function
   | SecretString | String ->

ocaml/idl/ocaml_backend/gen_rbac.ml

@@ -70,11 +70,10 @@ let role_uuid name = Option.get (hash2uuid name)
 let permission_description = "A basic permission"
 
 let permission_name wire_name =
-  let open Xapi_stdext_std in
   let s1 = replace_char (Printf.sprintf "permission_%s" wire_name) '.' '_' in
   let s2 = replace_char s1 '/' '_' in
-  let s3 = Xstringext.String.replace "*" "WILDCHAR" s2 in
-  Xstringext.String.replace ":" "_" s3
+  let s3 = Xapi_stdext_std.Xstringext.String.replace '*' ~by:"WILDCHAR" s2 in
+  replace_char s3 ':' '_'
 
 let permission_index = ref 0
 

ocaml/libs/http-lib/dune

@@ -63,6 +63,7 @@
   xapi-backtrace
   xapi-log
   xapi-stdext-pervasives
+  xapi-stdext-std
   xapi-stdext-threads
   xapi-stdext-unix))
 

ocaml/libs/http-lib/http_svr.ml

@@ -331,28 +331,22 @@ module Server = struct
       x.handlers []
 end
 
-let escape uri =
-  (* from xapi-stdext-std xstringext *)
-  let escaped ~rules string =
-    let aux h t =
-      ( if List.mem_assoc h rules then
-          List.assoc h rules
-        else
-          Astring.String.of_char h
+let escape_html uri =
+  Xapi_stdext_std.Xstringext.String.replaced
+    ~replace:(function
+      | '<' ->
+          Some "&lt;"
+      | '>' ->
+          Some "&gt;"
+      | '\'' ->
+          Some "&apos;"
+      | '"' ->
+          Some "&quot;"
+      | '&' ->
+          Some "&amp;"
+      | _ ->
+          None
       )
-      :: t
-    in
-    String.concat "" (Astring.String.fold_right aux string [])
-  in
-  escaped
-    ~rules:
-      [
-        ('<', "&lt;")
-      ; ('>', "&gt;")
-      ; ('\'', "&apos;")
-      ; ('"', "&quot;")
-      ; ('&', "&amp;")
-      ]
     uri
 
 exception Generic_error of string
@@ -508,7 +502,7 @@ let read_request ?proxy_seen ~read_timeout ~total_timeout ~max_length fd =
                 )
         | exc ->
             response_internal_error exc fd
-              ~extra:(escape (Printexc.to_string exc))
+              ~extra:(escape_html (Printexc.to_string exc))
     ) ;
     (None, None)
 
@@ -557,7 +551,7 @@ let handle_one (x : 'a Server.t) ss context req =
                 )
         | exc ->
             response_internal_error ~req exc ss
-              ~extra:(escape (Printexc.to_string exc))
+              ~extra:(escape_html (Printexc.to_string exc))
     ) ;
     !finished
 

ocaml/libs/http-lib/http_svr.mli

@@ -68,6 +68,9 @@ val start :
 
 val handle_one : 'a Server.t -> Unix.file_descr -> 'a -> Http.Request.t -> bool
 
+val escape_html : string -> string
+(** Escapes HTML: replaces characters with their character references *)
+
 exception Socket_not_found
 
 val stop : socket -> unit

ocaml/libs/sexpr/sExpr.ml

@@ -28,7 +28,7 @@ let is_escape_char = function '\\' | '\'' -> true | _ -> false
 (* XXX: This escapes "'c'" and "\'c\'" to "\\'c\\'".
  * They are both unescaped as "'c'". They have been ported
  * to make sure that this corner case is left unchanged.
- * It is worth investigating the use of 
+ * It is worth investigating the use of
  * - Astring.String.Ascii.escape_string
  * - Astring.String.Ascii.unescape
  * that have guaranteed invariants and optimised performances *)

ocaml/libs/tgroup/dune

@@ -2,7 +2,7 @@
  (name tgroup)
  (modules tgroup)
  (public_name tgroup)
- (libraries unix xapi-log xapi-stdext-unix xapi-stdext-std))
+ (libraries astring unix xapi-log xapi-stdext-unix))
 
 (test
  (name test_tgroup)

ocaml/libs/tgroup/tgroup.ml

@@ -70,8 +70,7 @@ module Group = struct
       | _ ->
           false
 
-    let sanitize s =
-      Xapi_stdext_std.Xstringext.String.filter_chars s is_alphanum
+    let sanitize s = Astring.String.filter is_alphanum s
 
     let make ?user_agent subject_sid =
       let user_agent =

ocaml/libs/xapi-stdext/lib/xapi-stdext-std/bench/bench_xstringext.ml

@@ -8,36 +8,42 @@ let make_string len = String.init len (fun i -> Char.chr (33 + (i mod 94)))
 let escape_rules =
   [('a', "[A]"); ('e', "[E]"); ('i', "[I]"); ('o', "[O]"); ('u', "[U]")]
 
-(* Reference implementation from xstringext_test.ml *)
-let escaped_spec ?rules string =
-  match rules with
-  | None ->
-      String.escaped string
-  | Some rules ->
-      let apply_rules char =
-        match List.assoc_opt char rules with
-        | None ->
-            Seq.return char
-        | Some replacement ->
-            String.to_seq replacement
-      in
-      string |> String.to_seq |> Seq.concat_map apply_rules |> String.of_seq
+let replace = function
+  | 'a' ->
+      Some "[A]"
+  | 'e' ->
+      Some "[E]"
+  | 'i' ->
+      Some "[I]"
+  | 'o' ->
+      Some "[O]"
+  | 'u' ->
+      Some "[U]"
+  | _ ->
+      None
+
+(* Reference implementation using lists *)
+let replaced_spec ~rules string =
+  let apply_rules char = List.assoc_opt char rules in
+  XString.replaced ~replace:apply_rules string
 
-let escaped_benchmark n =
+let replaced ~rules string = XString.replaced ~replace:rules string
+
+let replaced_benchmark n =
   let s = make_string n in
-  Staged.stage @@ fun () -> ignore (XString.escaped ~rules:escape_rules s)
+  Staged.stage @@ fun () -> ignore (replaced ~rules:replace s)
 
-let escaped_spec_benchmark n =
+let replaced_spec_benchmark n =
   let s = make_string n in
-  Staged.stage @@ fun () -> ignore (escaped_spec ~rules:escape_rules s)
+  Staged.stage @@ fun () -> ignore (replaced_spec ~rules:escape_rules s)
 
-let test_escaped =
-  Test.make_indexed ~name:"escaped" ~fmt:"%s %d" ~args:[100; 500; 1000]
-    escaped_benchmark
+let test_replaced =
+  Test.make_indexed ~name:"replaced" ~fmt:"%s %d" ~args:[100; 500; 1000]
+    replaced_benchmark
 
-let test_escaped_spec =
-  Test.make_indexed ~name:"escaped-spec" ~fmt:"%s %d" ~args:[100; 500; 1000]
-    escaped_spec_benchmark
+let test_replaced_spec =
+  Test.make_indexed ~name:"replaced-spec" ~fmt:"%s %d" ~args:[100; 500; 1000]
+    replaced_spec_benchmark
 
 let benchmark () =
   let ols =
@@ -50,8 +56,8 @@ let benchmark () =
     Benchmark.cfg ~limit:2000 ~quota:(Time.second 0.5) ~kde:(Some 1000) ()
   in
   let test =
-    Test.make_grouped ~name:"escaped-comparison"
-      [test_escaped; test_escaped_spec]
+    Test.make_grouped ~name:"replaced-comparison"
+      [test_replaced; test_replaced_spec]
   in
   let raw_results = Benchmark.all cfg instances test in
   let results =
@@ -97,8 +103,10 @@ let () =
   List.iter
     (fun size ->
       Printf.printf "String size %s:\n" size ;
-      let opt_test = Printf.sprintf "escaped-comparison/escaped %s" size in
-      let ref_test = Printf.sprintf "escaped-comparison/escaped-spec %s" size in
+      let opt_test = Printf.sprintf "replaced-comparison/replaced %s" size in
+      let ref_test =
+        Printf.sprintf "replaced-comparison/replaced-spec %s" size
+      in
       match (get_timing opt_test, get_timing ref_test) with
       | Some opt_time, Some ref_time ->
           let improvement = (ref_time -. opt_time) /. ref_time *. 100.0 in