localdb: expose option-based get functions

Allows callers to avoid exceptions, the previous get is now called
get_exn so it's clear which users have to be have to be mindful of
exceptions.

Not all get_exn were converted to get, previous behaviour was
widespread, and doing the change without changing behaviour is not
trivial, better to do it only once its detected.

Signed-off-by: Pau Ruiz Safont <pau.safont@vates.tech>

Author: psafont

ocaml/xapi/localdb.ml

@@ -64,17 +64,27 @@ exception Missing_key of string
 let m = Mutex.create ()
 
 let get (key : string) =
+  let __FUN = __FUNCTION__ in
+  let ( let* ) = Option.bind in
   with_lock m (fun () ->
-      assert_loaded () ;
-      match Hashtbl.find_opt db key with
-      | Some x ->
-          x
-      | None ->
-          raise (Missing_key key)
+      let* () =
+        try assert_loaded () ; Some ()
+        with e ->
+          warn "%s: unexpected error, ignoring it: %s" __FUN
+            (Printexc.to_string e) ;
+          None
+      in
+      Hashtbl.find_opt db key
   )
 
-let get_with_default (key : string) (default : string) =
-  try get key with Missing_key _ -> default
+let get_exn key =
+  match get key with Some x -> x | None -> raise (Missing_key key)
+
+let get_of_string of_string key = Option.bind (get key) of_string
+
+let get_bool key = get_of_string bool_of_string_opt key
+
+let get_int key = get_of_string int_of_string_opt key
 
 (* Returns true if a change was made and should be flushed *)
 let put_one (key : string) (v : string) =

ocaml/xapi/localdb.mli

@@ -18,12 +18,24 @@
 (** Thrown when a particular named key could not be found. *)
 exception Missing_key of string
 
-val get : string -> string
+val get : string -> string option
 (** Retrieves a value *)
 
-val get_with_default : string -> string -> string
-(** [get_with_default key default] returns the value associated with [key],
-    	or [default] if the key is missing. *)
+val get_exn : string -> string
+(** Retrieves the value for the key, raises Missing_key when the key is not
+    present *)
+
+val get_bool : string -> bool option
+(** Retrieves the value for the key, returns a value when it's found and is a
+    valid boolean, otherwise is [None] *)
+
+val get_int : string -> int option
+(** Retrieves the value for the key, returns a value when it's found and is a
+    valid int, otherwise is [None] *)
+
+val get_of_string : (string -> 'a option) -> string -> 'a option
+(** [get_of_string of_string key] retrieves the value for [key], and if it
+    exists, processes it with [of_string], otherwise it's [None] *)
 
 val put : string -> string -> unit
 (** Inserts a value into the database, only returns when the insertion has

ocaml/xapi/xapi.ml

@@ -288,12 +288,9 @@ let synchronize_certificates_with_coordinator ~__context =
 
 (* Make sure the local database can be read *)
 let init_local_database () =
-  ( try
-      let (_ : string) = Localdb.get Constants.ha_armed in
-      ()
-    with Localdb.Missing_key _ ->
-      Localdb.put Constants.ha_armed "false" ;
-      debug "%s = 'false' (by default)" Constants.ha_armed
+  if Option.is_none (Localdb.get_bool Constants.ha_armed) then (
+    Localdb.put Constants.ha_armed "false" ;
+    debug "%s = 'false' (by default)" Constants.ha_armed
   ) ;
   (* Add the local session check hook *)
   Session_check.check_local_session_hook :=
@@ -519,13 +516,14 @@ let start_ha () =
 (** Enable and load the redo log if we are the master, the local-DB flag is set
  * and HA is disabled *)
 let start_redo_log () =
+  let redo_log_enabled () =
+    Localdb.get_bool Constants.redo_log_enabled |> Option.value ~default:false
+  in
+  let ha_armed () =
+    Localdb.get_bool Constants.ha_armed |> Option.value ~default:false
+  in
   try
-    if
-      Pool_role.is_master ()
-      && bool_of_string
-           (Localdb.get_with_default Constants.redo_log_enabled "false")
-      && not (bool_of_string (Localdb.get Constants.ha_armed))
-    then (
+    if Pool_role.is_master () && redo_log_enabled () && not (ha_armed ()) then (
       debug "Redo log was enabled when shutting down, so restarting it" ;
       Static_vdis.reattempt_on_boot_attach () ;
       (* enable the use of the redo log *)
@@ -610,7 +608,7 @@ let resynchronise_ha_state () =
         let pool = Helpers.get_pool ~__context in
         let pool_ha_enabled = Db.Pool.get_ha_enabled ~__context ~self:pool in
         let local_ha_enabled =
-          bool_of_string (Localdb.get Constants.ha_armed)
+          Localdb.get_bool Constants.ha_armed |> Option.value ~default:false
         in
         match (local_ha_enabled, pool_ha_enabled) with
         | true, true ->

ocaml/xapi/xapi_ha.ml

@@ -76,8 +76,11 @@ let propose_master () =
 
 (** Returns true if local failover decisions have not been disabled on this node *)
 let local_failover_decisions_are_ok () =
-  try not (bool_of_string (Localdb.get Constants.ha_disable_failover_decisions))
-  with _ -> true
+  let disabled =
+    Localdb.get_bool Constants.ha_disable_failover_decisions
+    |> Option.value ~default:false
+  in
+  not disabled
 
 (** Since the liveset info doesn't include the host IP address, we persist these ourselves *)
 let write_uuid_to_ip_mapping ~__context =
@@ -91,8 +94,11 @@ let write_uuid_to_ip_mapping ~__context =
 
 (** Since the liveset info doesn't include the host IP address, we persist these ourselves *)
 let get_uuid_to_ip_mapping () =
-  let v = Localdb.get Constants.ha_peers in
-  String_unmarshall_helper.map (fun x -> x) (fun x -> x) v
+  match Localdb.get Constants.ha_peers with
+  | Some peers ->
+      String_unmarshall_helper.map (fun k -> k) (fun v -> v) peers
+  | None ->
+      []
 
 (** Without using the Pool's database, returns the IP address of a particular host
     named by UUID. *)
@@ -303,7 +309,7 @@ module Monitor = struct
             let statefiles = Xha_statefile.list_existing_statefiles () in
             debug "HA background thread starting" ;
             (* Grab the base timeout value so we can cook the reported latencies *)
-            let base_t = int_of_string (Localdb.get Constants.ha_base_t) in
+            let base_t = int_of_string (Localdb.get_exn Constants.ha_base_t) in
             let timeouts = Timeouts.derive base_t in
             (* Set up our per-host alert triggers *)
             let localhost_uuid = Helpers.get_localhost_uuid () in
@@ -501,8 +507,6 @@ module Monitor = struct
                   )
               in
 
-              (* let planned_for = Int64.to_int (Db.Pool.get_ha_plan_exists_for ~__context ~self:pool) in *)
-
               (* First consider whether VM failover actions need to happen.
                  Convert the liveset into a list of Host references used by the VM failover code *)
               let liveset_uuids =
@@ -629,11 +633,9 @@ module Monitor = struct
                 (* and yet has no statefile access *)
               in
               let all_live_nodes_lost_statefile =
-                List.fold_left ( && ) true
-                  (List.map
-                     (fun (_, xha_host) -> relying_on_rule_2 xha_host)
-                     host_host_table
-                  )
+                List.for_all
+                  (fun (_, xha_host) -> relying_on_rule_2 xha_host)
+                  host_host_table
               in
               warning_all_live_nodes_lost_statefile
                 all_live_nodes_lost_statefile ;
@@ -971,6 +973,7 @@ let update_ha_firewalld_service status =
      need. *)
   if
     Localdb.get Constants.ha_cluster_stack
+    |> Option.value ~default:!Xapi_globs.cluster_stack_default
     = Constants.Ha_cluster_stack.(to_string Xhad)
   then
     let module Fw =
@@ -986,19 +989,18 @@ let ha_start_daemon () =
   ()
 
 let on_server_restart () =
-  let armed = bool_of_string (Localdb.get Constants.ha_armed) in
-  if armed then (
+  let armed () =
+    Localdb.get_bool Constants.ha_armed |> Option.value ~default:false
+  in
+  if armed () then (
     debug "HA is supposed to be armed" ;
     (* Make sure daemons are up *)
     let finished = ref false in
     (* Do not proceed any further until the situation is resolved.
        XXX we might need some kind of user-override *)
     while not !finished do
       (* If someone has called Host.emergency_ha_disable in the background then we notice the change here *)
-      if
-        not
-          (try bool_of_string (Localdb.get Constants.ha_armed) with _ -> false)
-      then (
+      if not (armed ()) then (
         warn
           "ha_start_daemon aborted because someone has called \
            Host.emergency_ha_disable" ;
@@ -1149,7 +1151,7 @@ let ha_stop_daemon __context _localhost =
 
 let emergency_ha_disable __context soft =
   let ha_armed =
-    try bool_of_string (Localdb.get Constants.ha_armed) with _ -> false
+    Localdb.get_bool Constants.ha_armed |> Option.value ~default:false
   in
   if not ha_armed then
     if soft then

ocaml/xapi/xapi_host.ml

@@ -79,16 +79,16 @@ let assert_safe_to_reenable ~__context ~self ~user_request =
   Repository_helpers.assert_no_host_pending_mandatory_guidance ~__context
     ~host:self ;
   let host_disabled_until_reboot =
-    try bool_of_string (Localdb.get Constants.host_disabled_until_reboot)
-    with _ -> false
+    Localdb.get_bool Constants.host_disabled_until_reboot
+    |> Option.value ~default:false
   in
   if host_disabled_until_reboot then
     raise
       (Api_errors.Server_error
          (Api_errors.host_disabled_until_reboot, [Ref.string_of self])
       ) ;
   let host_auto_enable =
-    try bool_of_string (Localdb.get Constants.host_auto_enable) with _ -> true
+    Localdb.get_bool Constants.host_auto_enable |> Option.value ~default:true
   in
   if (not host_auto_enable) && not user_request then
     raise
@@ -3417,9 +3417,12 @@ let update_firewalld_service_status ~__context =
         | Xenha ->
             (* Only xha needs to enable firewalld service. Other HA cluster
                stacks don't need. *)
-            let is_armed () = bool_of_string (Localdb.get Constants.ha_armed) in
+            let is_armed () =
+              Localdb.get_bool Constants.ha_armed |> Option.value ~default:false
+            in
             let uses_xhad () =
               Localdb.get Constants.ha_cluster_stack
+              |> Option.value ~default:!Xapi_globs.cluster_stack_default
               = Constants.Ha_cluster_stack.(to_string Xhad)
             in
             is_armed () && uses_xhad ()

ocaml/xapi/xapi_host_crashdump.ml

@@ -71,8 +71,8 @@ let resynchronise ~__context ~host =
   let gone_away = Listext.List.set_difference db_filenames real_filenames
   and arrived = Listext.List.set_difference real_filenames db_filenames in
   let was_shutdown_cleanly =
-    try bool_of_string (Localdb.get Constants.host_restarted_cleanly)
-    with _ -> false
+    Localdb.get_bool Constants.host_restarted_cleanly
+    |> Option.value ~default:false
   in
   Localdb.put Constants.host_restarted_cleanly "false" ;
   (* If HA is enabled AND no crashdump appeared AND we weren't shutdown cleanly then assume it was a fence. *)

ocaml/xapi/xapi_host_helpers.ml

@@ -380,7 +380,7 @@ let consider_enabling_host_nolock ~__context =
         Disabled hosts are excluded from the HA planning calculations. Otherwise a host may boot,
         fail to plug in a PBD and cause all protected VMs to suddenly become non-agile. *)
   let ha_enabled =
-    try bool_of_string (Localdb.get Constants.ha_armed) with _ -> false
+    Localdb.get_bool Constants.ha_armed |> Option.value ~default:false
   in
   let localhost = Helpers.get_localhost ~__context in
   let pbds = Db.Host.get_PBDs ~__context ~self:localhost in
@@ -423,8 +423,7 @@ let consider_enabling_host_nolock ~__context =
         f ()
     in
     let host_auto_enable =
-      try bool_of_string (Localdb.get Constants.host_auto_enable)
-      with _ -> true
+      Localdb.get_bool Constants.host_auto_enable |> Option.value ~default:true
     in
     if !Xapi_globs.on_system_boot then (
       debug "Host.enabled: system has just restarted" ;
@@ -451,8 +450,8 @@ let consider_enabling_host_nolock ~__context =
                until manually re-enabled by the user"
       )
     ) else if
-        try bool_of_string (Localdb.get Constants.host_disabled_until_reboot)
-        with _ -> false
+        Localdb.get_bool Constants.host_disabled_until_reboot
+        |> Option.value ~default:false
       then
       debug
         "Host.enabled: system not just rebooted but host_disabled_until_reboot \

ocaml/xapi/xapi_pool.ml

@@ -1880,15 +1880,14 @@ let exchange_ca_certificates_on_join ~__context ~import ~export :
   in
   Cert_distrib.exchange_ca_certificates_with_joiner ~__context ~import ~export
 
-(* Assume that db backed up from master will be there and ready to go... *)
 let emergency_transition_to_master ~__context =
-  if Localdb.get Constants.ha_armed = "true" then
-    raise (Api_errors.Server_error (Api_errors.ha_is_enabled, [])) ;
+  if Localdb.get_bool Constants.ha_armed |> Option.value ~default:false then
+    raise Api_errors.(Server_error (ha_is_enabled, [])) ;
   Xapi_pool_transition.become_master ()
 
 let emergency_reset_master ~__context ~master_address =
-  if Localdb.get Constants.ha_armed = "true" then
-    raise (Api_errors.Server_error (Api_errors.ha_is_enabled, [])) ;
+  if Localdb.get_bool Constants.ha_armed |> Option.value ~default:false then
+    raise Api_errors.(Server_error (ha_is_enabled, [])) ;
   let master_address = Helpers.gethostbyname master_address in
   Xapi_pool_transition.become_another_masters_slave master_address
 

ocaml/xapi/xapi_pool_transition.ml

@@ -62,7 +62,7 @@ let run_external_scripts becoming_master =
       order
   in
   let already_run =
-    try bool_of_string (Localdb.get Constants.master_scripts) with _ -> false
+    Localdb.get_bool Constants.master_scripts |> Option.value ~default:false
   in
   (* Only do anything if we're switching mode *)
   if already_run <> becoming_master then (
@@ -228,8 +228,8 @@ let become_another_masters_slave master_address =
 (** If we just transitioned slave -> master (as indicated by the localdb flag) then generate a single alert *)
 let consider_sending_alert __context () =
   if
-    try bool_of_string (Localdb.get Constants.this_node_just_became_master)
-    with _ -> false
+    Localdb.get_bool Constants.this_node_just_became_master
+    |> Option.value ~default:false
   then
     let obj_uuid = Helpers.get_localhost_uuid () in
     let name, priority = Api_messages.pool_master_transition in

ocaml/xapi/xha_scripts.ml

@@ -17,7 +17,7 @@ module D = Debug.Make (struct let name = "xapi_ha" end)
 open D
 
 let ha_dir () =
-  let stack = Localdb.get Constants.ha_cluster_stack in
+  let stack = Localdb.get_exn Constants.ha_cluster_stack in
   Filename.concat !Xapi_globs.cluster_stack_root stack
 
 let ha_set_pool_state = "ha_set_pool_state"