Merge pull request xapi-project#1730 from djs55/pool.conf

pool.conf: always use the path from the config file

Author: djs55

ocaml/idl/ocaml_backend/OMakefile

@@ -103,7 +103,6 @@ SERVER_OBJS = ../../database/escaping locking_helpers \
 	../datamodel ../datamodel_utils ../datamodel_values \
 	gen_client ocaml_syntax ocaml_utils taskHelper exnHelper \
 	server_helpers session_check context \
-	../../pool_role_shared \
 	../../xapi/pool_role \
 	../../xapi/xapi_inventory \
 	../../xapi/hashtbl_xml \

ocaml/idl/ocaml_backend/context.ml

@@ -104,7 +104,7 @@ let preauth ~__context =
       Internal -> false
     | Http (req,s) -> is_unix_socket s
 
-let initial =
+let get_initial () =
   { session_id = None;
     task_id = Ref.of_string "initial_task";
     task_in_database = false;
@@ -161,7 +161,7 @@ let make_dbg http_other_config task_name task_id =
 
 (** constructors *)
 
-let from_forwarded_task ?(__context=initial) ?(http_other_config=[]) ?session_id ?(origin=Internal) task_id =
+let from_forwarded_task ?(__context=get_initial ()) ?(http_other_config=[]) ?session_id ?(origin=Internal) task_id =
   let task_name = 
     if Ref.is_dummy task_id 
     then Ref.name_of_dummy task_id
@@ -181,7 +181,7 @@ let from_forwarded_task ?(__context=initial) ?(http_other_config=[]) ?session_id
 		dbg = dbg;
 	  } 
 
-let make ?(__context=initial) ?(http_other_config=[]) ?(quiet=false) ?subtask_of ?session_id ?(database=default_database ()) ?(task_in_database=false) ?task_description ?(origin=Internal) task_name =
+let make ?(__context=get_initial ()) ?(http_other_config=[]) ?(quiet=false) ?subtask_of ?session_id ?(database=default_database ()) ?(task_in_database=false) ?task_description ?(origin=Internal) task_name =
   let task_id, task_uuid =
     if task_in_database 
     then !__make_task ~__context ~http_other_config ?description:task_description ?session_id ?subtask_of task_name

ocaml/idl/ocaml_backend/context.mli

@@ -21,9 +21,6 @@ type origin =
 
 (** {6 Constructors} *)
 
-(** [initial] is the initial context. *)
-val initial : t
-
 (** [make ~__context ~subtask_of ~database ~session_id ~task_in_database ~task_description ~origin name] creates a new context. 
     [__context] is the calling context,
     [http_other_config] are extra bits of context picked up from HTTP headers,

ocaml/pool_role_shared.ml

@@ -59,7 +59,7 @@ let start_server handlers =
 
 let harness_init () =
 	Printexc.record_backtrace true;
-	Pool_role_shared.set_pool_role_for_test ();
+	Pool_role.set_pool_role_for_test ();
 	Xapi.register_callback_fns ();
 	start_server handlers
 

ocaml/test/suite.ml

@@ -12,6 +12,7 @@
  * GNU Lesser General Public License for more details.
  *)
 open Stringext
+open Pervasiveext
 open Printf
 open Xenstore
 
@@ -38,3 +39,30 @@ let parse_proc_xen_balloon () =
 			  (key, Some (Int64.of_string stripped))) keys 
 
 
+let _proc_meminfo = "/proc/meminfo"
+ 
+let parse_meminfo () =
+	let ic = open_in _proc_meminfo in
+	finally
+		(fun () ->
+			let table = ref [] in
+			begin
+				try
+					while true do
+						let line = input_line ic in
+						match Stringext.String.split ' ' line with
+						| key :: value :: "kB" :: [] ->
+							table := (key, Int64.(mul (of_string value) 1024L)) :: !table
+						| _ -> ()
+					done
+				with End_of_file -> ()	
+			end;
+			!table
+		) (fun () -> close_in ic)
+
+let _memtotal = "MemTotal:"
+let get_memtotal () =
+	let table = parse_meminfo () in
+	if List.mem_assoc _memtotal table
+	then Some (List.assoc _memtotal table)
+	else None

ocaml/xapi/balloon.ml

@@ -16,3 +16,5 @@ val _current_allocation : string
 val _requested_target : string
 val _low_mem_balloon : string
 val _high_mem_balloon : string
+
+val get_memtotal: unit -> int64 option

ocaml/xapi/balloon.mli

@@ -44,19 +44,25 @@ type host_info = {
 }
 
 let read_localhost_info () =
-	let xen_verstring =
+	let xen_verstring, total_memory_mib =
 		try
 			let xc = Xenctrl.interface_open () in
 			let v = Xenctrl.version xc in
 			Xenctrl.interface_close xc;
 			let open Xenctrl in
-			Printf.sprintf "%d.%d%s" v.major v.minor v.extra
+			let xen_verstring = Printf.sprintf "%d.%d%s" v.major v.minor v.extra in
+			let total_memory_mib =
+				let open Xenops_client in
+				Client.HOST.get_total_memory_mib "read_localhost_info" in
+			xen_verstring, total_memory_mib
 		with e ->
 			if Pool_role.is_unit_test ()
-			then "0.0.0"
+			then "0.0.0", 0L
 			else begin
 			        warn "Failed to read xen version";
-                                "unknown"
+				match Balloon.get_memtotal () with
+				| None -> "unknown", 0L
+				| Some x -> "unknown", Int64.(div x (mul 1024L 1024L))
                         end
 	and linux_verstring =
 		let verstring = ref "" in
@@ -69,21 +75,21 @@ let read_localhost_info () =
 	let me = Helpers.get_localhost_uuid () in
 	let lookup_inventory_nofail k = try Some (Xapi_inventory.lookup k) with _ -> None in
 	let this_host_name = Helpers.get_hostname() in
-	let total_memory_mib =
-		let open Xenops_client in
-		Client.HOST.get_total_memory_mib "read_localhost_info" in
-
-	let dom0_static_max = 
-		(* Query the balloon driver to determine how much memory is available for domain 0. *)
-		(* We cannot ask XenControl for this information, since for domain 0, the value of  *)
-		(* max_memory_pages is hard-wired to the maximum native integer value ("infinity"). *)
-		let map = Balloon.parse_proc_xen_balloon () in
-		let lookup = fun x -> Opt.unbox (List.assoc x map) in
-		let keys = [Balloon._low_mem_balloon; Balloon._high_mem_balloon; Balloon._current_allocation] in
-		let values = List.map lookup keys in
-		let result = List.fold_left Int64.add 0L values in
-		Int64.mul 1024L result in
 
+	let dom0_static_max =
+		try
+			(* Query the balloon driver to determine how much memory is available for domain 0. *)
+			(* We cannot ask XenControl for this information, since for domain 0, the value of  *)
+			(* max_memory_pages is hard-wired to the maximum native integer value ("infinity"). *)
+			let map = Balloon.parse_proc_xen_balloon () in
+			let lookup = fun x -> Opt.unbox (List.assoc x map) in
+			let keys = [Balloon._low_mem_balloon; Balloon._high_mem_balloon; Balloon._current_allocation] in
+			let values = List.map lookup keys in
+			let result = List.fold_left Int64.add 0L values in
+			Int64.mul 1024L result
+		with e ->
+			info "Failed to query balloon driver, assuming target = static_max";
+			Int64.(mul total_memory_mib (mul 1024L 1024L)) in
 	{
 		name_label=this_host_name;
 		xen_verstring=xen_verstring;

ocaml/xapi/create_misc.ml

@@ -15,12 +15,79 @@
  * @group Pool Management
  *)
 
+open Stringext
 open Threadext
 
-include Pool_role_shared
+module D=Debug.Make(struct let name="pool_role" end)
+open D
+
+(** The role of this node *)
+type t =
+	| Master
+	| Slave of string (* IP address *)
+	| Broken
+
+let role = ref None
+let role_unit_tests = ref false
+let role_m = Mutex.create ()
+
+let set_pool_role_for_test () =
+	Mutex.execute role_m (fun _ -> role := Some Master;
+	                               role_unit_tests := true)
+
+let is_unit_test () =
+	Mutex.execute role_m (fun _ -> !role_unit_tests)
+
+let string_of = function
+	| Master -> "master"
+	| Slave x -> "slave:" ^ x
+	| Broken -> "broken"
+
+let read_pool_role () =
+	try
+		let s = String.strip String.isspace
+			(Unixext.string_of_file !Xapi_globs.pool_config_file) in
+		match String.split ~limit:2 ':' s with
+			| [ "master" ]      -> Master
+			| [ "slave"; m_ip ] -> Slave m_ip
+			| [ "broken" ]      -> Broken
+			| _ -> failwith "cannot parse pool_role from pool config file"
+	with _ ->
+		(* If exec name is suite.opt, we're running as unit tests *)
+		if "xapi" <> Filename.basename Sys.executable_name
+		then (debug "Executable name is not 'xapi', so we must be running \
+		             in unit-test mode; setting pool-role to 'Master'";
+		      Master)
+		else (error "Failed to read pool role from %s" !Xapi_globs.pool_config_file;
+		      Broken)
+
+let get_role () =
+	Mutex.execute role_m (fun _ ->
+		match !role with
+		| Some x -> x
+		| None ->
+			let r = read_pool_role () in
+			role := Some r;
+			r
+	)
+
+let is_master () = get_role () = Master
+
+let is_slave () = match get_role () with
+	| Slave _ -> true
+	| _ -> false
+
+let is_broken () = get_role () = Broken
+
+exception This_host_is_a_master
+exception This_host_is_broken
+
+let get_master_address () = match get_role () with
+	| Slave ip -> ip
+	| Master -> raise This_host_is_a_master
+	| Broken -> raise This_host_is_broken
 
 let set_role r =
-  filename := !Xapi_globs.pool_config_file;
   let old_role = get_role () in
   Mutex.execute role_m
     (fun () ->

ocaml/xapi/pool_role.ml

@@ -34,6 +34,8 @@ val is_broken: unit -> bool
 (** Returns true if this is a unit test *)
 val is_unit_test: unit -> bool
 
+val set_pool_role_for_test: unit -> unit
+
 exception This_host_is_a_master
 exception This_host_is_broken