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: c11772277fe5f1b0874141a24554c2e3da2d9a6e
master date: 2025-02-25 13:30:55 +0000

diff --git a/tools/ocaml/xenstored/Makefile b/tools/ocaml/xenstored/Makefile
index 5e8210a906499b425ad12a91299ed4d6376defae..c333394a34070a913caef3f0f075fba8832ce350 100644 (file)
--- a/tools/ocaml/xenstored/Makefile
+++ b/tools/ocaml/xenstored/Makefile
@@ -54,6 +54,7 @@ OBJS = paths \
        history \
        parse_arg \
        process \
+       poll \
        xenstored
 
 INTF = symbol.cmi trie.cmi syslog.cmi systemd.cmi poll.cmi

diff --git a/tools/ocaml/xenstored/perms.ml b/tools/ocaml/xenstored/perms.ml
index 14f8e334fe1bbf91c31475dcaab2d41acab3d804..2c4ee9e61737e1d0c138dcb2c02a883b54118217 100644 (file)
--- a/tools/ocaml/xenstored/perms.ml
+++ b/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 =

diff --git a/tools/ocaml/xenstored/poll.ml b/tools/ocaml/xenstored/poll.ml
index fefaa6e74cb28a06b41a0f8a1b1b4db49d44a098..f8571e45900d907d931e7771a43375c9616880bb 100644 (file)
--- a/tools/ocaml/xenstored/poll.ml
+++ b/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
 

diff --git a/tools/ocaml/xenstored/process.ml b/tools/ocaml/xenstored/process.ml
index 432d66321cbbccec660d3ffdefabc88ebf2e5151..0c9c460a991555f2f17910c28855524a92874aa1 100644 (file)
--- a/tools/ocaml/xenstored/process.ml
+++ b/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

diff --git a/tools/ocaml/xenstored/utils.ml b/tools/ocaml/xenstored/utils.ml
index 48d84ef7d314ebf6a0d347ddbead96602be3255f..7a556bce7573e2f0305ad8b20c2d54bb061130d8 100644 (file)
--- a/tools/ocaml/xenstored/utils.ml
+++ b/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/" *)

diff --git a/tools/ocaml/xenstored/xenstored.ml b/tools/ocaml/xenstored/xenstored.ml
index 1aaa3e995e1f4e08e04d80c01ca466d55311968d..84dee622eaecc0a0664f58705b208e2873cea40b 100644 (file)
--- a/tools/ocaml/xenstored/xenstored.ml
+++ b/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