EA-1110/CI-18: make some global variables configurable via config file

Their default values are not changed. We'll do the value tweaking in the coming checkins.

Signed-off-by: Zheng Li <[email protected]>

Author: zli

ocaml/database/block_device_io.ml

@@ -691,7 +691,7 @@ let _ =
 
   if !dump then begin
     (* Open the block device *)
-    let block_dev_fd = open_block_device !block_dev (Unix.gettimeofday() +. Xapi_globs.redo_log_max_startup_time) in
+    let block_dev_fd = open_block_device !block_dev (Unix.gettimeofday() +. !Xapi_globs.redo_log_max_startup_time) in
     R.info "Opened block device.";
 
     let target_response_time = Unix.gettimeofday() +. 3600. in
@@ -745,7 +745,7 @@ let _ =
 
   if !empty then begin
     (* Open the block device *)
-    let block_dev_fd = open_block_device !block_dev (Unix.gettimeofday() +. Xapi_globs.redo_log_max_startup_time) in
+    let block_dev_fd = open_block_device !block_dev (Unix.gettimeofday() +. !Xapi_globs.redo_log_max_startup_time) in
     R.info "Opened block device.";
 
     let target_response_time = Unix.gettimeofday() +. 3600. in
@@ -762,7 +762,7 @@ let _ =
     (* Main loop: accept a new client, communicate with it until it stops sending commands, repeat. *)
     while true do
       let start_of_startup = Unix.gettimeofday() in
-      let target_startup_response_time = start_of_startup +. Xapi_globs.redo_log_max_startup_time in
+      let target_startup_response_time = start_of_startup +. !Xapi_globs.redo_log_max_startup_time in
 
       R.debug "Awaiting incoming connections on %s..." !ctrlsock;
       let client = accept_conn s target_startup_response_time in
@@ -788,10 +788,10 @@ let _ =
 
                 (* Note: none of the action functions throw any exceptions; they report errors directly to the client. *)
                 let (action_fn, block_time) = match str with
-                  | "writedelta" -> action_writedelta, Xapi_globs.redo_log_max_block_time_writedelta
-                  | "writedb___" -> action_writedb,    Xapi_globs.redo_log_max_block_time_writedb
-                  | "read______" -> action_read,       Xapi_globs.redo_log_max_block_time_read
-                  | "empty_____" -> action_empty,      Xapi_globs.redo_log_max_block_time_empty
+                  | "writedelta" -> action_writedelta, !Xapi_globs.redo_log_max_block_time_writedelta
+                  | "writedb___" -> action_writedb,    !Xapi_globs.redo_log_max_block_time_writedb
+                  | "read______" -> action_read,       !Xapi_globs.redo_log_max_block_time_read
+                  | "empty_____" -> action_empty,      !Xapi_globs.redo_log_max_block_time_empty
                   | _ -> (fun _ _ _ _ -> send_failure client (str^"|nack") ("Unknown command "^str)), 0.
                 in
                 (* "Start the clock!" -- set the latest time by which we need to have responded to the client. *)

ocaml/database/master_connection.ml

@@ -61,7 +61,6 @@ let with_timestamp f =
    One common way this can happen is if we end up blocked waiting for a TCP timeout when the
    master goes away unexpectedly... *)
 let start_master_connection_watchdog() =
-  let connection_reset_timeout = 2. *. 60. in
   Thread.create
     (fun () ->
        while (true)
@@ -73,7 +72,7 @@ let start_master_connection_watchdog() =
 	     | Some t ->
 		 let now = Unix.gettimeofday() in
 		 let since_last_call = now -. t in
-		 if since_last_call > connection_reset_timeout then
+		 if since_last_call > !Xapi_globs.master_connection_reset_timeout then
 		   begin
 		     debug "Master connection timeout: forcibly resetting master connection";
 		     force_connection_reset()
@@ -104,7 +103,7 @@ let open_secure_connection () =
 (* Do a db xml_rpc request, catching exception and trying to reopen the connection if it
    fails *)
 exception Goto_handler
-let connection_timeout = ref 10. (* -ve means retry forever *)
+let connection_timeout = ref !Xapi_globs.master_connection_default_timeout
 
 (* if this is true then xapi will restart if retries exceeded [and enter emergency mode if still
    can't reconnect after reboot]. if this is false then xapi will just throw exception if retries
@@ -154,8 +153,8 @@ let do_db_xml_rpc_persistent_with_reopen ~host ~path (req: string) : string =
       with
       (* TODO: This http exception handler caused CA-36936 and can probably be removed now that there's backoff delay in the generic handler _ below *)
       | Http_client.Http_error (http_code,err_msg) ->
-	  error "Received HTTP error %s (%s) from master. This suggests our master address is wrong. Sleeping for %.0fs and then restarting." http_code err_msg Xapi_globs.permanent_master_failure_retry_timeout;
-	  Thread.delay Xapi_globs.permanent_master_failure_retry_timeout;
+	  error "Received HTTP error %s (%s) from master. This suggests our master address is wrong. Sleeping for %.0fs and then restarting." http_code err_msg !Xapi_globs.permanent_master_failure_retry_interval;
+	  Thread.delay !Xapi_globs.permanent_master_failure_retry_interval;
 	  exit Xapi_globs.restart_return_code
       |	e ->
 	  begin
@@ -180,7 +179,7 @@ let do_db_xml_rpc_persistent_with_reopen ~host ~path (req: string) : string =
 	      end
 	    else
 	      debug "Connection to master died: time taken so far in this call '%f'; will %s"
-		time_sofar (if !connection_timeout < 0. 
+		time_sofar (if !connection_timeout < 0.
 			    then "never timeout" 
 			    else Printf.sprintf "timeout after '%f'" !connection_timeout);
 	    if time_sofar > !connection_timeout && !connection_timeout >= 0. then

ocaml/database/redo_log.ml

@@ -230,7 +230,7 @@ let connect sockpath latest_response_time =
       (* It's probably the case that the process hasn't started yet. *)
       (* See if we can afford to wait and try again *)
       Unix.close s;
-      let attempt_delay = Xapi_globs.redo_log_connect_delay in
+      let attempt_delay = !Xapi_globs.redo_log_connect_delay in
       let now = Unix.gettimeofday() in
       let remaining = latest_response_time -. now in
       if attempt_delay < remaining then begin
@@ -326,7 +326,7 @@ let rec read_read_response sock fn_db fn_delta expected_gen_count latest_respons
 let action_empty sock datasockpath =
   R.debug "Performing empty";
   (* Compute desired response time *)
-  let latest_response_time = get_latest_response_time Xapi_globs.redo_log_max_block_time_empty in
+  let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_empty in
   (* Empty *)
   let str = "empty_____" in
   Unixext.time_limited_write sock (String.length str) str latest_response_time;
@@ -346,7 +346,7 @@ let action_empty sock datasockpath =
 let action_read fn_db fn_delta sock datasockpath =
   R.debug "Performing read";
   (* Compute desired response time *)
-  let latest_response_time = get_latest_response_time Xapi_globs.redo_log_max_block_time_read in
+  let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_read in
   (* Write *)
   let str = "read______" in
   Unixext.time_limited_write sock (String.length str) str latest_response_time;
@@ -356,7 +356,7 @@ let action_read fn_db fn_delta sock datasockpath =
 let action_write_db marker generation_count write_fn sock datasockpath =
   R.debug "Performing writedb (generation %Ld)" generation_count;
   (* Compute desired response time *)
-  let latest_response_time = get_latest_response_time Xapi_globs.redo_log_max_block_time_writedb in
+  let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_writedb in
   (* Send write command down control channel *)
   let str = Printf.sprintf "writedb___|%s|%016Ld" marker generation_count in
   Unixext.time_limited_write sock (String.length str) str latest_response_time;
@@ -413,7 +413,7 @@ let action_write_db marker generation_count write_fn sock datasockpath =
 let action_write_delta marker generation_count data flush_db_fn sock datasockpath =
   R.debug "Performing writedelta (generation %Ld)" generation_count;
   (* Compute desired response time *)
-  let latest_response_time = get_latest_response_time Xapi_globs.redo_log_max_block_time_writedelta in
+  let latest_response_time = get_latest_response_time !Xapi_globs.redo_log_max_block_time_writedelta in
   (* Write *)
   let str = Printf.sprintf "writedelta|%s|%016Ld|%016d|%s" marker generation_count (String.length data) data in
   Unixext.time_limited_write sock (String.length str) str latest_response_time;
@@ -569,7 +569,7 @@ let startup log =
           match !(log.sock) with
           | Some _ -> () (* We're already connected *)
           | None ->
-            let latest_connect_time = get_latest_response_time Xapi_globs.redo_log_max_startup_time in
+            let latest_connect_time = get_latest_response_time !Xapi_globs.redo_log_max_startup_time in
 
             (* Now connect to the process via the socket *)
             let s = connect ctrlsockpath latest_connect_time in

ocaml/xapi/cli_operations.ml

@@ -899,7 +899,7 @@ let pool_join printer rpc session_id params =
 				~master_address:(List.assoc "master-address" params)
 				~master_username:(List.assoc "master-username" params)
 				~master_password:(List.assoc "master-password" params);
-		printer (Cli_printer.PList ["Host agent will restart and attempt to join pool in "^(string_of_int Xapi_globs.fuse_time)^" seconds..."])
+		printer (Cli_printer.PList ["Host agent will restart and attempt to join pool in "^(string_of_float !Xapi_globs.fuse_time)^" seconds..."])
 	with
 		| Api_errors.Server_error(code, params) when code=Api_errors.pool_joining_host_connection_failed ->
 			printer (Cli_printer.PList ["Host cannot contact destination host: connection refused.";
@@ -913,7 +913,7 @@ let pool_eject fd printer rpc session_id params =
 
 	let go () =
 		Client.Pool.eject ~rpc ~session_id ~host;
-		printer (Cli_printer.PList ["Specified host will attempt to restart as a master of a new pool in "^(string_of_int Xapi_globs.fuse_time)^" seconds..."]) in
+		printer (Cli_printer.PList ["Specified host will attempt to restart as a master of a new pool in "^(string_of_float !Xapi_globs.fuse_time)^" seconds..."]) in
 
 	if force
 	then go ()
@@ -969,11 +969,11 @@ let pool_eject fd printer rpc session_id params =
 let pool_emergency_reset_master printer rpc session_id params =
 	let master_address = List.assoc "master-address" params in
 	Client.Pool.emergency_reset_master ~rpc ~session_id ~master_address;
-	printer (Cli_printer.PList ["Host agent will restart and become slave of "^master_address^" in "^(string_of_int Xapi_globs.fuse_time)^" seconds..."])
+	printer (Cli_printer.PList ["Host agent will restart and become slave of "^master_address^" in "^(string_of_float !Xapi_globs.fuse_time)^" seconds..."])
 
 let pool_emergency_transition_to_master printer rpc session_id params =
 	Client.Pool.emergency_transition_to_master ~rpc ~session_id;
-	printer (Cli_printer.PList ["Host agent will restart and transition to master in "^(string_of_int Xapi_globs.fuse_time)^" seconds..."])
+	printer (Cli_printer.PList ["Host agent will restart and transition to master in "^(string_of_float !Xapi_globs.fuse_time)^" seconds..."])
 
 let pool_recover_slaves printer rpc session_id params =
 	let hosts = Client.Pool.recover_slaves ~rpc ~session_id in
@@ -3590,7 +3590,7 @@ let pool_restore_db fd printer rpc session_id params =
 	ignore(track_http_operation fd rpc session_id make_command "restore database");
 	if dry_run
 	then printer (Cli_printer.PList [ "Dry-run backup restore successful" ])
-	else printer (Cli_printer.PList ["Host will reboot with restored database in "^(string_of_int Xapi_globs.db_restore_fuse_time)^" seconds..."])
+	else printer (Cli_printer.PList ["Host will reboot with restored database in "^(string_of_float !Xapi_globs.db_restore_fuse_time)^" seconds..."])
 
 
 let pool_enable_external_auth printer rpc session_id params =

ocaml/xapi/db_gc.ml

@@ -194,7 +194,7 @@ let check_host_liveness ~__context =
 	let now = Unix.gettimeofday () in
 	(* we can now compare 'host_time' with 'now' *) 
 
-	if now -. host_time < Xapi_globs.host_assumed_dead_interval then begin
+	if now -. host_time < !Xapi_globs.host_assumed_dead_interval then begin
 	  (* From the heartbeat PoV the host looks alive. We try to (i) minimise database sets; and (ii) 
 	     avoid toggling the host back to live if it has been marked as shutting_down. *)
 	  Mutex.execute Xapi_globs.hosts_which_are_shutting_down_m
@@ -252,7 +252,7 @@ let timeout_sessions_common ~__context sessions =
   (* Only keep a list of (ref, last_active, uuid) *)
   let disposable_sessions = List.map (fun (x, y) -> x, Date.to_float y.Db_actions.session_last_active, y.Db_actions.session_uuid) disposable_sessions in
   (* Definitely invalidate sessions last used long ago *)
-  let threshold_time = Unix.time () -. Xapi_globs.inactive_session_timeout in
+  let threshold_time = Unix.time () -. !Xapi_globs.inactive_session_timeout in
   let young, old = List.partition (fun (_, y, _) -> y > threshold_time) disposable_sessions in
   (* If there are too many young sessions then we need to delete the oldest *)
   let lucky, unlucky = 
@@ -286,8 +286,8 @@ let timeout_sessions ~__context =
 
 let timeout_tasks ~__context =
   let all_tasks = Db.Task.get_internal_records_where ~__context ~expr:Db_filter_types.True in
-  let oldest_completed_time = Unix.time() -. Xapi_globs.completed_task_timeout (* time out completed tasks after 65 minutes *) in
-  let oldest_pending_time   = Unix.time() -. Xapi_globs.pending_task_timeout   (* time out pending tasks after 24 hours *) in
+  let oldest_completed_time = Unix.time() -. !Xapi_globs.completed_task_timeout (* time out completed tasks after 65 minutes *) in
+  let oldest_pending_time   = Unix.time() -. !Xapi_globs.pending_task_timeout   (* time out pending tasks after 24 hours *) in
 
   let should_delete_task (_, t) = 
     if task_status_is_completed t.Db_actions.task_status
@@ -533,7 +533,7 @@ let start_heartbeat_thread() =
 
 	    while(true) do
 	      try
-		Thread.delay Xapi_globs.host_heartbeat_interval;
+		Thread.delay !Xapi_globs.host_heartbeat_interval;
 		send_one_heartbeat ~__context rpc session_id
 	      with 
 		| (Api_errors.Server_error (x,y)) as e ->
@@ -549,6 +549,6 @@ let start_heartbeat_thread() =
 	    exit Xapi_globs.restart_return_code
 	| e -> 
 	  debug "Caught %s - logging in again" (ExnHelper.string_of_exn e);
-	  Thread.delay Xapi_globs.host_heartbeat_interval;
+	  Thread.delay !Xapi_globs.host_heartbeat_interval;
       done
       end)

ocaml/xapi/events.ml

@@ -125,7 +125,7 @@ module Domain_shutdown = struct
 	  if Xapi_fist.disable_reboot_delay () then begin
 		debug "FIST: disable_reboot_delay";
 		0, 0
-	  end else if time_vm_ran_for ~__context ~vm < Xapi_globs.minimum_time_between_reboot_with_no_added_delay then begin
+	  end else if time_vm_ran_for ~__context ~vm < !Xapi_globs.minimum_time_between_reboot_with_no_added_delay then begin
 		calculate_reboot_delay ~__context ~vm domid
 	  end else 0, 0 in
 	if delay <> 0 then begin
@@ -189,9 +189,9 @@ module Domain_shutdown = struct
     (* Perform bounce-suppression to prevent fast crash loops *)
     let action = 
       let t = time_vm_ran_for ~__context ~vm in
-      if t < Xapi_globs.minimum_time_between_bounces then begin
+      if t < !Xapi_globs.minimum_time_between_bounces then begin
 	let msg = Printf.sprintf "VM (%s) domid %d crashed too soon after start (ran for %f; minimum time %f)" 
-	  (Db.VM.get_name_label ~__context ~self:vm) domid t Xapi_globs.minimum_time_between_bounces in
+	  (Db.VM.get_name_label ~__context ~self:vm) domid t !Xapi_globs.minimum_time_between_bounces in
 	match action with
 	| `coredump_and_restart -> 
 	    debug "%s: converting coredump_and_restart -> coredump_and_destroy" msg;

ocaml/xapi/message_forwarding.ml

@@ -2682,17 +2682,15 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
 					let (_: Thread.t) = Thread.create (fun () ->
 						Client.PIF.reconfigure_ip rpc session_id self mode iP netmask gateway dNS) () in
 					let task_id = Context.get_task_id __context in
-					let rec poll i =
-						if i>300 then failwith "Failed to see host on network after timeout expired";
+					let start_time = Unix.gettimeofday () in
+					let progress = ref 0.0 in
+					while !progress = 0.0 do
+						if Unix.gettimeofday () -. start_time < !Xapi_globs.pif_reconfigure_ip_timeout then
+							failwith "Failed to see host on network after timeout expired";
 						Thread.delay 1.0;
-						debug "Polling task %s progress" (Ref.string_of task_id);
-						let progress = Db.Task.get_progress ~__context ~self:task_id in
-						debug "progress=%f" progress;
-						if progress=0.0
-						then poll (i+1)
-						else ()
-					in
-					poll 0)
+						progress := Db.Task.get_progress ~__context ~self:task_id;
+						debug "Polling task %s progress" (Ref.string_of task_id)
+					done)
 
 		let scan ~__context ~host =
 			info "PIF.scan: host = '%s'" (host_uuid ~__context host);

ocaml/xapi/pool_db_backup.ml

@@ -23,8 +23,6 @@ open Db_cache_types
 module D = Debug.Debugger(struct let name="pool_db_sync" end)
 open D
 
-let pool_db_sync_timer = 60.0 *. 5. (* CA-16878: 5 minutes, same as the local database flush *)
-
 let octet_stream = Http.Hdr.content_type ^": application/octet-stream"
 
 (* CA-18377: The smallest database that is compatible with the Miami database schema. *)
@@ -203,8 +201,8 @@ let push_database_restore_handler (req: Http.Request.t) s _ =
 
 	(* now restart *)
 	debug "xapi has received new database via xml; will reboot and use that db...";
-	info "Rebooting to use restored database after delay of: %d" Xapi_globs.db_restore_fuse_time;
-	Xapi_fuse.light_fuse_and_reboot ~fuse_length:Xapi_globs.db_restore_fuse_time ();
+	info "Rebooting to use restored database after delay of: %f" !Xapi_globs.db_restore_fuse_time;
+	Xapi_fuse.light_fuse_and_reboot ~fuse_length:!Xapi_globs.db_restore_fuse_time ();
       end
     ) 
 
@@ -263,7 +261,7 @@ let pool_db_backup_thread () =
 	let generation = Db_lock.with_lock (fun () -> Manifest.generation (Database.manifest (Db_ref.get_database (Context.database_of __context)))) in
 	let dohost host =
 	  try
-	    Thread.delay pool_db_sync_timer;
+	    Thread.delay !Xapi_globs.pool_db_sync_interval;
 	    debug "Starting DB synchronise with host %s" (Ref.string_of host);
 	    Helpers.call_api_functions ~__context
 	      (fun rpc session_id -> Client.Host.request_backup rpc session_id host generation false);
@@ -274,7 +272,7 @@ let pool_db_backup_thread () =
 	      log_backtrace () in
 
 	(* since thread.delay is inside dohost fn make sure we don't spin if hosts=[]: *)
-	if hosts=[] then Thread.delay pool_db_sync_timer
+	if hosts=[] then Thread.delay !Xapi_globs.pool_db_sync_interval
 	else List.iter dohost hosts;
       end
     with e -> debug "Exception in DB synchronise thread: %s" (ExnHelper.string_of_exn e)