From: Jonathan Davies <jonathan.davies@citrix.com>
Date: Thu, 17 Mar 2016 17:51:09 +0000 (+0000)
Subject: oxenstored: refactor putting response on wire
X-Git-Tag: archive/raspbian/4.8.0-1+rpi1~1^2~1508
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=a2c5046db9cdb80454dd545b6b907294d8f2f98e;p=xen.git

oxenstored: refactor putting response on wire

Previously, the functions reply_{ack,data,data_or_ack} and input_handle_error
put the response on the wire by invoking Connection.send_{ack,reply,error}.

Instead, these functions now return a value indicating what needs to be put on
the wire, and that action is done by a send_response function called
afterwards.

This refactoring gives us a chance to store the value of the response, useful
for replaying transactions.

Signed-off-by: Jonathan Davies <jonathan.davies@citrix.com>
Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com>
Reviewed-by: Jon Ludlam <jonathan.ludlam@citrix.com>
Reviewed-by: Euan Harris <euan.harris@citrix.com>
Acked-by: David Scott <dave@recoil.org>
---

diff --git a/tools/ocaml/xenstored/Makefile b/tools/ocaml/xenstored/Makefile
index 59875f7086..dce9e7014d 100644
--- a/tools/ocaml/xenstored/Makefile
+++ b/tools/ocaml/xenstored/Makefile
@@ -36,6 +36,7 @@ OBJS = define \
 	stdext \
 	trie \
 	config \
+	packet \
 	logging \
 	quota \
 	perms \
diff --git a/tools/ocaml/xenstored/packet.ml b/tools/ocaml/xenstored/packet.ml
new file mode 100644
index 0000000000..c8ecfe55c2
--- /dev/null
+++ b/tools/ocaml/xenstored/packet.ml
@@ -0,0 +1,4 @@
+type response =
+	| Ack of (unit -> unit)  (* function is the action to execute after sending the ack *)
+	| Reply of string
+	| Error of string
diff --git a/tools/ocaml/xenstored/process.ml b/tools/ocaml/xenstored/process.ml
index e8276787b8..337796687d 100644
--- a/tools/ocaml/xenstored/process.ml
+++ b/tools/ocaml/xenstored/process.ml
@@ -126,8 +126,7 @@ let do_watch con t rid domains cons data =
 		| _                   -> raise Invalid_Cmd_Args
 		in
 	let watch = Connections.add_watch cons con node token in
-	Connection.send_ack con (Transaction.get_id t) rid Xenbus.Xb.Op.Watch;
-	Connection.fire_single_watch watch
+	Packet.Ack (fun () -> Connection.fire_single_watch watch)
 
 let do_unwatch con t domains cons data =
 	let (node, token) =
@@ -289,20 +288,32 @@ let do_set_target con t domains cons data =
 		| _                           -> raise Invalid_Cmd_Args
 
 (*------------- Generic handling of ty ------------------*)
+let send_response ty con t rid response =
+	match response with
+	| Packet.Ack f ->
+		Connection.send_ack con (Transaction.get_id t) rid ty;
+		(* Now do any necessary follow-up actions *)
+		f ()
+	| Packet.Reply ret ->
+		Connection.send_reply con (Transaction.get_id t) rid ty ret
+	| Packet.Error e ->
+		Connection.send_error con (Transaction.get_id t) rid e
+
 let reply_ack fct ty con t rid doms cons data =
 	fct con t doms cons data;
-	Connection.send_ack con (Transaction.get_id t) rid ty;
-	if Transaction.get_id t = Transaction.none then
-		process_watch (Transaction.get_ops t) cons
+	Packet.Ack (fun () ->
+		if Transaction.get_id t = Transaction.none then
+			process_watch (Transaction.get_ops t) cons
+	)
 
 let reply_data fct ty con t rid doms cons data =
 	let ret = fct con t doms cons data in
-	Connection.send_reply con (Transaction.get_id t) rid ty ret
+	Packet.Reply ret
 
 let reply_data_or_ack fct ty con t rid doms cons data =
 	match fct con t doms cons data with
-		| Some ret -> Connection.send_reply con (Transaction.get_id t) rid ty ret
-		| None -> Connection.send_ack con (Transaction.get_id t) rid ty
+		| Some ret -> Packet.Reply ret
+		| None -> Packet.Ack (fun () -> ())
 
 let reply_none fct ty con t rid doms cons data =
 	(* let the function reply *)
@@ -335,7 +346,7 @@ let function_of_type ty =
 
 let input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data =
 	let reply_error e =
-		Connection.send_error con (Transaction.get_id t) rid e in
+		Packet.Error e in
 	try
 		fct ty con t rid doms cons data
 	with
@@ -368,7 +379,10 @@ let process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data =
 			else
 				Connection.get_transaction con tid
 			in
-		input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data;
+		let response = input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data in
+
+		(* Put the response on the wire *)
+		send_response ty con t rid response
 	with exn ->
 		error "process packet: %s" (Printexc.to_string exn);
 		Connection.send_error con tid rid "EIO"