tools/ocaml: Fix oxenstored build warning

OCaml, in preparation for a renaming of the error string associated with
conversion failure in 'int_of_string' functions, started to issue this
warning:

  File "process.ml", line 440, characters 13-28:
  440 |   | (Failure "int_of_string")    -> reply_error "EINVAL"
                     ^^^^^^^^^^^^^^^
  Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
  this constructor's arguments. They are only for information
  and may change in future versions. (See manual section 11.5)

Deal with this at the source, and instead create our own stable
ConversionFailure exception that's raised on the None case in
'int_of_string_opt'.

'c_int_of_string' is safe and does not raise such exceptions.

Signed-off-by: Andrii Sultanov <andrii.sultanov@cloud.com>
Acked-by: Christian Lindig <christian.lindig@cloud.com>
Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com>
master commit: c11772277f
master date: 2025-02-25 13:30:55 +0000

tools/ocaml/xenstored/Makefile

@@ -53,6 +53,7 @@ OBJS = paths \
 	history \
 	parse_arg \
 	process \
+	poll \
 	xenstored
 
 INTF = symbol.cmi trie.cmi syslog.cmi systemd.cmi poll.cmi

tools/ocaml/xenstored/perms.ml

@@ -70,7 +70,7 @@ struct
 
   let perm_of_string s =
     let ty = permty_of_char s.[0]
-    and id = int_of_string (String.sub s 1 (String.length s - 1)) in
+    and id = Utils.int_of_string_exn (String.sub s 1 (String.length s - 1)) in
     (id, ty)
 
   let of_strings ls =

tools/ocaml/xenstored/poll.ml

@@ -30,7 +30,7 @@ external set_fd_limit: int -> unit = "stub_set_fd_limit"
 let get_sys_fs_nr_open () =
   try
     let ch = open_in "/proc/sys/fs/nr_open" in
-    let v = int_of_string (input_line ch) in
+    let v = Utils.int_of_string_exn (input_line ch) in
     close_in_noerr ch; v
   with _ -> 1024 * 1024
 

tools/ocaml/xenstored/process.ml

@@ -229,7 +229,7 @@ let do_debug con t _domains cons data =
       Logging.xb_op ~tid:0 ~ty:Xenbus.Xb.Op.Debug ~con:"=======>" msg;
       None
     | "quota" :: domid :: _ ->
-      let domid = int_of_string domid in
+      let domid = Utils.int_of_string_exn domid in
       let quota = (Store.get_quota t.Transaction.store) in
       Some (Quota.to_string quota domid ^ "\000")
     | "watches" :: _ ->
@@ -242,7 +242,7 @@ let do_debug con t _domains cons data =
       History.trim ();
       Some "trimmed"
     | "txn" :: domid :: _ ->
-      let domid = int_of_string domid in
+      let domid = Utils.int_of_string_exn domid in
       let con = Connections.find_domain cons domid in
       let b = Buffer.create 128 in
       let () = con.transactions |> Hashtbl.iter @@ fun id tx ->
@@ -253,7 +253,7 @@ let do_debug con t _domains cons data =
       in
       Some (Buffer.contents b)
     | "xenbus" :: domid :: _ ->
-      let domid = int_of_string domid in
+      let domid = Utils.int_of_string_exn domid in
       let con = Connections.find_domain cons domid in
       let s = Printf.sprintf "xenbus: %s; overflow queue length: %d, can_input: %b, has_more_input: %b, has_old_output: %b, has_new_output: %b, has_more_work: %b. pending: %s"
           (Xenbus.Xb.debug con.xb)
@@ -267,7 +267,7 @@ let do_debug con t _domains cons data =
       in
       Some s
     | "mfn" :: domid :: _ ->
-      let domid = int_of_string domid in
+      let domid = Utils.int_of_string_exn domid in
       let con = Connections.find_domain cons domid in
       may (fun dom -> Printf.sprintf "%nd\000" (Domain.get_mfn dom)) (Connection.get_domain con)
     | _ -> None
@@ -340,7 +340,7 @@ let do_isintroduced con _t domains _cons data =
   then raise Define.Permission_denied;
   let domid =
     match (split None '\000' data) with
-    | domid :: _ -> int_of_string domid
+    | domid :: _ -> Utils.int_of_string_exn domid
     | _          -> raise Invalid_Cmd_Args
   in
   if domid = Define.domid_self || Domains.exist domains domid then "T\000" else "F\000"
@@ -437,7 +437,7 @@ let input_handle_error ~cons ~doms ~fct ~con ~t ~req =
   | Quota.Limit_reached          -> reply_error "EQUOTA"
   | Quota.Data_too_big           -> reply_error "E2BIG"
   | Quota.Transaction_opened     -> reply_error "EQUOTA"
-  | (Failure "int_of_string")    -> reply_error "EINVAL"
+  | Utils.ConversionFailed s     -> reply_error "EINVAL"
   | Define.Unknown_operation     -> reply_error "ENOSYS"
 
 let write_access_log ~ty ~tid ~con ~data =
@@ -578,7 +578,7 @@ let do_introduce con t domains cons data =
   let (domid, mfn, remote_port) =
     match (split None '\000' data) with
     | domid :: mfn :: remote_port :: _ ->
-      int_of_string domid, Nativeint.of_string mfn, int_of_string remote_port
+      Utils.int_of_string_exn domid, Nativeint.of_string mfn, Utils.int_of_string_exn remote_port
     | _                         -> raise Invalid_Cmd_Args;
   in
   let dom =
@@ -604,7 +604,7 @@ let do_release con t domains cons data =
   then raise Define.Permission_denied;
   let domid =
     match (split None '\000' data) with
-    | [domid;""] -> int_of_string domid
+    | [domid;""] -> Utils.int_of_string_exn domid
     | _          -> raise Invalid_Cmd_Args
   in
   let fire_spec_watches = Domains.exist domains domid in
@@ -620,7 +620,7 @@ let do_resume con _t domains _cons data =
   then raise Define.Permission_denied;
   let domid =
     match (split None '\000' data) with
-    | domid :: _ -> int_of_string domid
+    | domid :: _ -> Utils.int_of_string_exn domid
     | _          -> raise Invalid_Cmd_Args
   in
   if Domains.exist domains domid

tools/ocaml/xenstored/utils.ml

@@ -53,8 +53,14 @@ let hexify s =
     ) s;
   Bytes.unsafe_to_string hs
 
+exception ConversionFailed of string
+let int_of_string_exn s =
+  match int_of_string_opt s with
+  | Some x -> x
+  | None -> raise (ConversionFailed s)
+
 let unhexify hs =
-  let char_of_hexseq seq0 seq1 = Char.chr (int_of_string (sprintf "0x%c%c" seq0 seq1)) in
+  let char_of_hexseq seq0 seq1 = Char.chr (int_of_string_exn (sprintf "0x%c%c" seq0 seq1)) in
   let b = Bytes.create (String.length hs / 2) in
   for i = 0 to Bytes.length b - 1
   do
@@ -86,7 +92,7 @@ let read_file_single_integer filename =
   let buf = Bytes.make 20 '\000' in
   let sz = Unix.read fd buf 0 20 in
   Unix.close fd;
-  int_of_string (Bytes.sub_string buf 0 sz)
+  int_of_string_exn (Bytes.sub_string buf 0 sz)
 
 (* @path may be guest data and needs its length validating.  @connection_path
  * is generated locally in xenstored and always of the form "/local/domain/$N/" *)

tools/ocaml/xenstored/xenstored.ml

@@ -167,20 +167,20 @@ module DB = struct
                					   e.g. a RO socket from a previous version: ignore it *)
             global_f ~rw
           | "evtchn-dev" :: fd :: domexc_port :: [] ->
-            evtchn_f ~fd:(int_of_string fd)
-              ~domexc_port:(int_of_string domexc_port)
+            evtchn_f ~fd:(Utils.int_of_string_exn fd)
+              ~domexc_port:(Utils.int_of_string_exn domexc_port)
           | "socket" :: fd :: [] ->
-            socket_f ~fd:(int_of_string fd)
+            socket_f ~fd:(Utils.int_of_string_exn fd)
           | "dom" :: domid :: mfn :: remote_port :: rest ->
             let local_port = match rest with
               | [] -> None (* backward compat: old version didn't have it *)
-              | local_port :: _ -> Some (int_of_string local_port) in
+              | local_port :: _ -> Some (Utils.int_of_string_exn local_port) in
             domain_f ?local_port
-              ~remote_port:(int_of_string remote_port)
-              (int_of_string domid)
+              ~remote_port:(Utils.int_of_string_exn remote_port)
+              (Utils.int_of_string_exn domid)
               (Nativeint.of_string mfn)
           | "watch" :: domid :: path :: token :: [] ->
-            watch_f (int_of_string domid)
+            watch_f (Utils.int_of_string_exn domid)
               (unhexify path) (unhexify token)
           | "store" :: path :: perms :: value :: [] ->
             store_f (getpath path)
@@ -214,7 +214,7 @@ module DB = struct
     in
     let global_f ~rw =
       let get_listen_sock sockfd =
-        let fd = sockfd |> int_of_string |> Utils.FD.of_int in
+        let fd = sockfd |> Utils.int_of_string_exn |> Utils.FD.of_int in
         Unix.listen fd 1;
         Some fd
       in