xapi-stdext-std: remove most functions, optimize escaping functions (#6795)

The Listext module has a lot of baggage that can be replace with Stdlib,
Astring. And what cannot be replaced, it can be made better, especially
the escaping.

There are quite a few changes, so it's better to review
commit-by-commit.

I need to do some testing to make sure all changes here are safe and
undraft this

Author: psafont

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

@@ -80,11 +80,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-log.backtrace
   xapi-log
   xapi-stdext-pervasives
+  xapi-stdext-std
   xapi-stdext-threads
   xapi-stdext-unix))
 

ocaml/libs/http-lib/http_svr.ml

@@ -340,28 +340,22 @@ module Server = struct
       x.handlers []
 end
 
-let escape str =
-  (* 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 str =
+  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;")
-      ]
     str
 
 exception Generic_error of string
@@ -518,7 +512,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)
 
@@ -567,7 +561,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

@@ -49,8 +49,8 @@ end
 
 exception Generic_error of string
 
-val escape : string -> string
-(** [escape str] escapes HTML/XML special characters in [str] for safe inclusion in HTML/XML content. *)
+val escape_html : string -> string
+(** [escape_html str] escapes HTML/XML special characters in [str] for safe inclusion in HTML/XML content. *)
 
 type socket