diff --git a/tools/ocaml/xenstored/connection.ml b/tools/ocaml/xenstored/connection.ml
index 0a2c481ee6..b18336f8cd 100644
--- a/tools/ocaml/xenstored/connection.ml
+++ b/tools/ocaml/xenstored/connection.ml
@@ -233,7 +233,10 @@ let end_transaction con tid commit =
 	let trans = Hashtbl.find con.transactions tid in
 	Hashtbl.remove con.transactions tid;
 	Logging.end_transaction ~tid ~con:(get_domstr con);
-	if commit then Transaction.commit ~con:(get_domstr con) trans else true
+	match commit with
+	| None -> true
+	| Some transaction_replay_f ->
+		Transaction.commit ~con:(get_domstr con) trans || transaction_replay_f con trans
 
 let get_transaction con tid =
 	Hashtbl.find con.transactions tid
diff --git a/tools/ocaml/xenstored/packet.ml b/tools/ocaml/xenstored/packet.ml
index 22cae1d329..aeae0a4f57 100644
--- a/tools/ocaml/xenstored/packet.ml
+++ b/tools/ocaml/xenstored/packet.ml
@@ -9,3 +9,8 @@ type response =
 	| Ack of (unit -> unit)  (* function is the action to execute after sending the ack *)
 	| Reply of string
 	| Error of string
+
+let response_equal a b =
+	match (a, b) with
+	| (Ack _, Ack _) -> true (* just consider the response, not the post-response action *)
+	| (x, y) -> x = y
diff --git a/tools/ocaml/xenstored/process.ml b/tools/ocaml/xenstored/process.ml
index 39ae71b86f..6d1f551ce7 100644
--- a/tools/ocaml/xenstored/process.ml
+++ b/tools/ocaml/xenstored/process.ml
@@ -281,6 +281,38 @@ let input_handle_error ~cons ~doms ~fct ~con ~t ~req =
 	| (Failure "int_of_string")    -> reply_error "EINVAL"
 	| Define.Unknown_operation     -> reply_error "ENOSYS"
 
+(* Replay a stored transaction against a fresh store, check the responses are
+   all equivalent: if so, commit the transaction. Otherwise send the abort to
+   the client. *)
+let transaction_replay c t doms cons =
+	match t.Transaction.ty with
+	| Transaction.No ->
+		error "attempted to replay a non-full transaction";
+		false
+	| Transaction.Full(id, oldroot, cstore) ->
+		let tid = Connection.start_transaction c cstore in
+		let new_t = Transaction.make tid cstore in
+		let con = sprintf "r(%d):%s" id (Connection.get_domstr c) in
+		let perform_exn (request, response) =
+			let fct = function_of_type_simple_op request.Packet.ty in
+			let response' = input_handle_error ~cons ~doms ~fct ~con:c ~t:new_t ~req:request in
+			if not(Packet.response_equal response response') then raise Transaction_again in
+		finally
+		(fun () ->
+			try
+				Logging.start_transaction ~con ~tid;
+				List.iter perform_exn (Transaction.get_operations t);
+				Logging.end_transaction ~con ~tid;
+
+				Transaction.commit ~con new_t
+			with e ->
+				info "transaction_replay %d caught: %s" tid (Printexc.to_string e);
+				false
+			)
+		(fun () ->
+			Connection.end_transaction c tid None
+		)
+
 let do_watch con t domains cons data =
 	let (node, token) = 
 		match (split None '\000' data) with
@@ -313,6 +345,7 @@ let do_transaction_end con t domains cons data =
 		| _        -> raise Invalid_Cmd_Args
 		in
 	let success =
+		let commit = if commit then Some (fun con trans -> transaction_replay con trans domains cons) else None in
 		Connection.end_transaction con (Transaction.get_id t) commit in
 	if not success then
 		raise Transaction_again;