Merge pull request xapi-project#5751 from last-genius/private/asultanov/opt-refactoring

IH-633: Transition away from exception-raising Hashtbl.find and Unix.getenv

Author: last-genius

configure.ml

@@ -84,11 +84,12 @@ let () =
   in
   List.iter print_endline lines ;
   (* Expand @LIBEXEC@ in udev rules *)
-  try
-    let xenopsd_libexecdir = Hashtbl.find config "XENOPSD_LIBEXECDIR" in
-    expand "@LIBEXEC@" xenopsd_libexecdir "ocaml/xenopsd/scripts/vif.in"
-      "ocaml/xenopsd/scripts/vif" ;
-    expand "@LIBEXEC@" xenopsd_libexecdir
-      "ocaml/xenopsd/scripts/xen-backend.rules.in"
-      "ocaml/xenopsd/scripts/xen-backend.rules"
-  with Not_found -> failwith "xenopsd_libexecdir not set"
+  match Hashtbl.find_opt config "XENOPSD_LIBEXECDIR" with
+  | Some xenopsd_libexecdir ->
+      expand "@LIBEXEC@" xenopsd_libexecdir "ocaml/xenopsd/scripts/vif.in"
+        "ocaml/xenopsd/scripts/vif" ;
+      expand "@LIBEXEC@" xenopsd_libexecdir
+        "ocaml/xenopsd/scripts/xen-backend.rules.in"
+        "ocaml/xenopsd/scripts/xen-backend.rules"
+  | None ->
+      failwith "xenopsd_libexecdir not set"

ocaml/database/db_backend.ml

@@ -104,8 +104,5 @@ let is_session_registered session =
 
 let get_registered_database session =
   with_lock db_registration_mutex (fun () ->
-      if Hashtbl.mem foreign_databases session then
-        Some (Hashtbl.find foreign_databases session)
-      else
-        None
+      Hashtbl.find_opt foreign_databases session
   )

ocaml/database/db_conn_store.ml

@@ -41,12 +41,14 @@ let read_db_connections () = !db_connections
 let with_db_conn_lock db_conn f =
   let db_conn_m =
     with_lock db_conn_locks_m (fun () ->
-        try Hashtbl.find db_conn_locks db_conn
-        with _ ->
-          (* If we don't have a lock already for this connection then go make one dynamically and use that from then on *)
-          let new_dbconn_mutex = Mutex.create () in
-          Hashtbl.replace db_conn_locks db_conn new_dbconn_mutex ;
-          new_dbconn_mutex
+        match Hashtbl.find_opt db_conn_locks db_conn with
+        | Some x ->
+            x
+        | None ->
+            (* If we don't have a lock already for this connection then go make one dynamically and use that from then on *)
+            let new_dbconn_mutex = Mutex.create () in
+            Hashtbl.replace db_conn_locks db_conn new_dbconn_mutex ;
+            new_dbconn_mutex
     )
   in
   with_lock db_conn_m (fun () -> f ())

ocaml/database/stats.ml

@@ -77,10 +77,9 @@ let sample (name : string) (x : float) : unit =
   let x' = log x in
   with_lock timings_m (fun () ->
       let p =
-        if Hashtbl.mem timings name then
-          Hashtbl.find timings name
-        else
-          Normal_population.empty
+        Option.value
+          (Hashtbl.find_opt timings name)
+          ~default:Normal_population.empty
       in
       let p' = Normal_population.sample p x' in
       Hashtbl.replace timings name p'

ocaml/idl/dtd_backend.ml

@@ -110,14 +110,13 @@ let rec strings_of_dtd_element known_els = function
 
 let element known_els name children atts =
   let existing_children =
-    if Hashtbl.mem known_els name then
-      match Hashtbl.find known_els name with
-      | Element (_, c, att) ->
-          (c, att)
-      | _ ->
-          assert false
-    else
-      ([], [])
+    match Hashtbl.find_opt known_els name with
+    | Some (Element (_, c, att)) ->
+        (c, att)
+    | None ->
+        ([], [])
+    | _ ->
+        assert false
   in
   let open Xapi_stdext_std.Listext in
   let el =

ocaml/libs/http-lib/http_svr.ml

@@ -660,8 +660,11 @@ exception Socket_not_found
 (* Stop an HTTP server running on a socket *)
 let stop (socket, _name) =
   let server =
-    try Hashtbl.find socket_table socket
-    with Not_found -> raise Socket_not_found
+    match Hashtbl.find_opt socket_table socket with
+    | Some x ->
+        x
+    | None ->
+        raise Socket_not_found
   in
   Hashtbl.remove socket_table socket ;
   server.Server_io.shutdown ()

ocaml/libs/http-lib/mime.ml

@@ -42,7 +42,7 @@ let default_mime = "text/plain"
 
 (** Map a file extension to a MIME type *)
 let mime_of_ext mime ext =
-  try Hashtbl.find mime (lowercase ext) with Not_found -> default_mime
+  Option.value (Hashtbl.find_opt mime (lowercase ext)) ~default:default_mime
 
 (** Figure out a mime type from a full filename *)
 let mime_of_file_name mime fname =

ocaml/libs/resources/table.ml

@@ -41,7 +41,7 @@ struct
         Hashtbl.remove t k
     )
 
-  let find (t, m) k = with_lock m (fun () -> Hashtbl.find t k)
+  let find (t, m) k = with_lock m (fun () -> Hashtbl.find_opt t k)
 
   let with_find_moved_exn (t, m) k =
     let v =

ocaml/libs/stunnel/stunnel.ml

@@ -35,27 +35,38 @@ let stunnel_logger = ref ignore
 let timeoutidle = ref None
 
 let init_stunnel_path () =
-  try cached_stunnel_path := Some (Unix.getenv "XE_STUNNEL")
-  with Not_found ->
-    let choices =
-      [
-        "/opt/xensource/libexec/stunnel/stunnel"
-      ; "/usr/sbin/stunnel4"
-      ; "/usr/sbin/stunnel"
-      ; "/usr/bin/stunnel4"
-      ; "/usr/bin/stunnel"
-      ]
-    in
-    let rec choose l =
-      match l with
-      | [] ->
-          raise Stunnel_binary_missing
-      | p :: ps -> (
-        try Unix.access p [Unix.X_OK] ; p with _ -> choose ps
+  cached_stunnel_path :=
+    Some
+      ( match Sys.getenv_opt "XE_STUNNEL" with
+      | Some x ->
+          x
+      | None ->
+          let choices =
+            [
+              "/opt/xensource/libexec/stunnel/stunnel"
+            ; "/usr/sbin/stunnel4"
+            ; "/usr/sbin/stunnel"
+            ; "/usr/bin/stunnel4"
+            ; "/usr/bin/stunnel"
+            ]
+          in
+
+          let choose l =
+            match
+              List.find_opt
+                (fun el ->
+                  try Unix.access el [Unix.X_OK] ; true with _ -> false
+                )
+                l
+            with
+            | Some p ->
+                p
+            | None ->
+                raise Stunnel_binary_missing
+          in
+          let path = choose choices in
+          path
       )
-    in
-    let path = choose choices in
-    cached_stunnel_path := Some path
 
 let stunnel_path () =
   if Option.is_none !cached_stunnel_path then
@@ -150,7 +161,8 @@ let debug_conf_of_bool verbose : string =
   if verbose then "debug=authpriv.7" else "debug=authpriv.5"
 
 let debug_conf_of_env () : string =
-  (try Unix.getenv "debug_stunnel" with _ -> "") |> String.lowercase_ascii
+  Option.value (Sys.getenv_opt "debug_stunnel") ~default:""
+  |> String.lowercase_ascii
   |> fun x -> List.mem x ["yes"; "true"; "1"] |> debug_conf_of_bool
 
 let config_file ?(accept = None) config host port =

ocaml/libs/stunnel/stunnel_cache.ml

@@ -74,10 +74,13 @@ let unlocked_gc () =
   ( if debug_enabled then
       let now = Unix.gettimeofday () in
       let string_of_id id =
-        let stunnel = Tbl.find !stunnels id in
-        Printf.sprintf "(id %s / idle %.2f age %.2f)" (id_of_stunnel stunnel)
-          (now -. Hashtbl.find !times id)
-          (now -. stunnel.Stunnel.connected_time)
+        match (Tbl.find !stunnels id, Hashtbl.find_opt !times id) with
+        | Some stunnel, Some stunnel_id ->
+            Printf.sprintf "(id %s / idle %.2f age %.2f)"
+              (id_of_stunnel stunnel) (now -. stunnel_id)
+              (now -. stunnel.Stunnel.connected_time)
+        | _ ->
+            Printf.sprintf "%s: found no entry for id=%d" __FUNCTION__ id
       in
       let string_of_endpoint ep = Printf.sprintf "%s:%d" ep.host ep.port in
       let string_of_index ep xs =
@@ -134,20 +137,24 @@ let unlocked_gc () =
     let oldest_ids = List.map fst oldest in
     List.iter
       (fun x ->
-        let stunnel = Tbl.find !stunnels x in
-        debug
-          "Expiring stunnel id %s since we have too many cached tunnels (limit \
-           is %d)"
-          (id_of_stunnel stunnel) max_stunnel
+        match Tbl.find !stunnels x with
+        | Some stunnel ->
+            debug
+              "Expiring stunnel id %s since we have too many cached tunnels \
+               (limit is %d)"
+              (id_of_stunnel stunnel) max_stunnel
+        | None ->
+            debug "%s: Couldn't find an expiring stunnel (id=%d) in the table"
+              __FUNCTION__ x
       )
       oldest_ids ;
     to_gc := !to_gc @ oldest_ids
   ) ;
   (* Disconnect all stunnels we wish to GC *)
   List.iter
     (fun id ->
-      let s = Tbl.find !stunnels id in
-      Stunnel.disconnect s
+      (* Only remove stunnel if we find it in the table *)
+      Option.iter (fun s -> Stunnel.disconnect s) (Tbl.find !stunnels id)
     )
     !to_gc ;
   (* Remove all reference to them from our cache hashtables *)
@@ -187,12 +194,7 @@ let add (x : Stunnel.t) =
         ; verified= x.Stunnel.verified
         }
       in
-      let existing =
-        if Hashtbl.mem !index ep then
-          Hashtbl.find !index ep
-        else
-          []
-      in
+      let existing = Option.value (Hashtbl.find_opt !index ep) ~default:[] in
       Hashtbl.replace !index ep (idx :: existing) ;
       debug "Adding stunnel id %s (idle %.2f) to the cache" (id_of_stunnel x) 0. ;
       unlocked_gc ()
@@ -206,23 +208,33 @@ let with_remove ~host ~port verified f =
   let get_id () =
     with_lock m (fun () ->
         unlocked_gc () ;
-        let ids = Hashtbl.find !index ep in
-        let table = List.map (fun id -> (id, Hashtbl.find !times id)) ids in
+        let ( let* ) = Option.bind in
+        let* ids = Hashtbl.find_opt !index ep in
+        let table =
+          List.filter_map
+            (fun id ->
+              Option.map (fun time -> (id, time)) (Hashtbl.find_opt !times id)
+            )
+            ids
+        in
         let sorted = List.sort (fun a b -> compare (snd a) (snd b)) table in
         match sorted with
         | (id, time) :: _ ->
-            let stunnel = Tbl.find !stunnels id in
-            debug "Removing stunnel id %s (idle %.2f) from the cache"
-              (id_of_stunnel stunnel)
-              (Unix.gettimeofday () -. time) ;
+            Option.iter
+              (fun stunnel ->
+                debug "Removing stunnel id %s (idle %.2f) from the cache"
+                  (id_of_stunnel stunnel)
+                  (Unix.gettimeofday () -. time)
+              )
+              (Tbl.find !stunnels id) ;
             Hashtbl.remove !times id ;
             Hashtbl.replace !index ep (List.filter (fun x -> x <> id) ids) ;
-            id
+            Some id
         | _ ->
-            raise Not_found
+            None
     )
   in
-  let id_opt = try Some (get_id ()) with Not_found -> None in
+  let id_opt = get_id () in
   id_opt
   |> Option.map @@ fun id ->
      (* cannot call while holding above mutex or we deadlock *)