CA-101580: rrdd: watch xenstore instead of polling

xcp-rrdd is interested in domains' data/meminfo_free values. In one example, polling xenstore for these values took about 30 seconds for 700 VMs. Instead of polling, use watches.

ocaml/rrdd/OMakefile

@@ -10,7 +10,7 @@ OCAMLINCLUDES = \
 	interface
 # ocaml/xapi only needed for xapi_fist : should move xapi_first to libs
 OCAMLPACKS = oclock xml-light2 stunnel http-svr xenctrl xenctrlext xenstore
-OCAML_LIBS = $(ROOT)/ocaml/fhs ../idl/ocaml_backend/xapi_client
+OCAML_LIBS = $(ROOT)/ocaml/fhs ../idl/ocaml_backend/xapi_client ../xenops/xenstore_watch
 # ../xenops/xenops_client
 
 UseCamlp4(rpc-light.syntax, rrdd_server)

ocaml/rrdd/rrdd_main.ml

@@ -124,6 +124,48 @@ let uuid_of_domid domains domid =
 	with Not_found ->
 		failwith (Printf.sprintf "Failed to find uuid corresponding to domid: %d" domid)
 
+(*****************************************************)
+(* xenstore related code                             *)
+(*****************************************************)
+
+open Xenstore_watch
+
+(* Map from domid to the latest seen meminfo_free value *)
+let current_meminfofree_values = ref IntMap.empty
+
+let meminfo_path domid = Printf.sprintf "/local/domain/%d/data/meminfo_free" domid
+
+module Meminfo = struct
+	let interesting_paths_for_domain domid uuid = [ meminfo_path domid ]
+
+        let domain_appeared _ _ _ = ()
+        let domain_disappeared _ _ _ = ()
+	let unmanaged_domain domid id = false
+	let found_running_domain domid id = ()
+
+	let fire_event_on_vm xs domid domains =
+		let d = int_of_string domid in
+		if not(IntMap.mem d domains)
+		then debug "Ignoring watch on shutdown domain %d" d
+		else
+			let path = meminfo_path d in
+			try
+				let meminfo_free = Int64.of_string (xs.Xs.read path) in
+				debug "memfree has changed to %Ld in domain %d" meminfo_free d;
+				current_meminfofree_values := IntMap.add d meminfo_free !current_meminfofree_values
+			with Xenbus.Xb.Noent ->
+				debug "Couldn't read path %s; forgetting last known memfree value for domain %d" path d;
+				current_meminfofree_values := IntMap.remove d !current_meminfofree_values
+
+	let watch_fired xc xs path domains _ =
+		match List.filter (fun x -> x <> "") (Stringext.String.split '/' path) with
+			| "local" :: "domain" :: domid :: "data" :: "meminfo_free" :: [] ->
+				fire_event_on_vm xs domid domains
+			| _  -> debug "Ignoring unexpected watch: %s" path
+end
+
+module Watcher = WatchXenstore(Meminfo)
+
 (*****************************************************)
 (* cpu related code                                  *)
 (*****************************************************)
@@ -243,8 +285,7 @@ let update_memory xc doms =
 			if domid = 0 then None
 			else begin
 			try
-				let memfree_xs_key = Printf.sprintf "/local/domain/%d/data/meminfo_free" domid in
-				let mem_free = with_xs (fun xs -> Int64.of_string (xs.Xs.read memfree_xs_key)) in
+				let mem_free = IntMap.find domid !current_meminfofree_values in
 				Some (
 					VM uuid,
 					ds_make ~name:"memory_internal_free" ~units:"B"
@@ -642,6 +683,9 @@ let _ =
 	debug "Starting the HTTP server ..";
 	start (Rrdd_interface.xmlrpc_path, Rrdd_interface.http_fwd_path) Server.process;
 
+	debug "Starting xenstore-watching thread ..";
+        let (_: Thread.t) = Watcher.create_watcher_thread () in
+
 	debug "Creating monitoring loop thread ..";
 	Debug.with_thread_associated "main" monitor_loop ();