From: Vincent Hanquez <vincent.hanquez@eu.citrix.com>
Date: Sun, 3 May 2009 23:30:28 +0000 (+0100)
Subject: add support for receiving/sending jsonrpc
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=0305851da0afe1da7dad701501b31aa98e7f8fc0;p=xenclient%2Ftoolstack.git

add support for receiving/sending jsonrpc
---

diff --git a/xenvm/Makefile b/xenvm/Makefile
index 4bacb37..1b52aea 100644
--- a/xenvm/Makefile
+++ b/xenvm/Makefile
@@ -5,6 +5,7 @@ OCAMLINCLUDE += \
 	-I $(TOPLEVEL)/libs/log -I $(TOPLEVEL)/libs/xb -I $(TOPLEVEL)/libs/xs \
 	-I $(TOPLEVEL)/libs/uuid -I $(TOPLEVEL)/libs/mmap -I $(TOPLEVEL)/libs/scsi \
 	-I $(TOPLEVEL)/libs/xc -I $(TOPLEVEL)/libs/eventchn \
+	-I $(TOPLEVEL)/libs/json -I $(TOPLEVEL)/libs/jsonrpc \
 	-I $(TOPLEVEL)/libs/netdev -I $(TOPLEVEL)/libs/stdext \
 	-I $(TOPLEVEL)/common -I $(TOPLEVEL)/xenops
 OCAMLOPTFLAGS += -thread
@@ -32,6 +33,8 @@ xenvm_LIBS = unix.cmxa threads.cmxa \
 	-ccopt -L -ccopt $(TOPLEVEL)/libs/xs $(TOPLEVEL)/libs/xs/xs.cmxa \
 	-ccopt -L -ccopt $(TOPLEVEL)/libs/stdext $(TOPLEVEL)/libs/stdext/stdext.cmxa \
 	-ccopt -L -ccopt $(TOPLEVEL)/libs/netdev $(TOPLEVEL)/libs/netdev/netdev.cmxa \
+	-ccopt -L -ccopt $(TOPLEVEL)/libs/json $(TOPLEVEL)/libs/json/json.cmxa \
+	-ccopt -L -ccopt $(TOPLEVEL)/libs/jsonrpc $(TOPLEVEL)/libs/jsonrpc/jsonrpc.cmxa \
 	-ccopt -L -ccopt $(TOPLEVEL)/libs/scsi $(TOPLEVEL)/libs/scsi/scsi.cmxa \
 	-ccopt -L -ccopt $(TOPLEVEL)/xenops $(TOPLEVEL)/xenops/xenops.cmxa
 
diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index 53827f5..e9cfc5f 100644
--- a/xenvm/xenvm.ml
+++ b/xenvm/xenvm.ml
@@ -218,6 +218,7 @@ type connection = {
 	mutable con_tasks: (Tasks.action * (Tasks.argval list)) Queue.t;
 	mutable con_replies: Xenvmlib.answer Queue.t;
 	mutable con_closing: bool;
+	mutable con_header: int * int;
 	con_legacy: bool;
 }
 
@@ -228,6 +229,7 @@ let con_new fd legacy =
 		con_tasks = Queue.create ();
 		con_replies = Queue.create ();
 		con_closing = false;
+		con_header = (4, 0);
 		con_legacy = legacy;
 	}
 let con_close con = Unix.close con.con_fd
@@ -502,6 +504,86 @@ let monitor_rpc legacy_socket json_socket state =
 	let quit = ref false in
 	let connections = ref [] in
 
+	let connection_do_task con =
+		let rpc =
+			try Right (Jsonrpc.request_of_string (Buffer.contents con.con_buf))
+			with exn -> Left (string_of_exn exn)
+			in
+		match rpc with
+		| Right rpc ->
+			thread_create (fun () ->
+				(* FIXME do proper parsing here *)
+				let task = Tasks.Quit in
+				let params = [] in
+				let reply_id = match rpc.Jsonrpc.request_id with Some id -> id | None -> Json.Int 0L in
+				let reply =
+					try
+						let r = do_task quit state (task, params) in
+						match r with
+						| Xenvmlib.Ok -> Jsonrpc.response_make_success reply_id Json.Null
+						| Xenvmlib.Msg msg -> Jsonrpc.response_make_success reply_id (Json.String msg)
+						| _ -> assert false
+					with exn ->
+						let err = string_of_exn exn in
+						Jsonrpc.response_make_error reply_id (Jsonrpc.code_error_invalid_params) err None
+					in
+				let s = Jsonrpc.response_to_string reply in
+				let len = String.length s in
+				let w = Unix.write con.con_fd s 0 len in
+				ignore w;
+				con_close con;
+			) ()
+		| Left err  ->
+			let error = Jsonrpc.response_make_error (Json.Int 0L) (Jsonrpc.code_error_invalid_params) err None in
+			let s = Jsonrpc.response_to_string error in
+			thread_create (fun () ->
+				let len = String.length s in
+				let w = Unix.write con.con_fd s 0 len in
+				ignore w;
+				con_close con;
+			) ();
+		in
+	(* process a jsonrpc type of connection *)
+	let connection_process con =
+		if con.con_header = (0, 0) then (
+			let htonl_of_chars a b c d =
+				((Char.code a) lsl 24) + ((Char.code b) lsl 16) +
+				((Char.code c) lsl 8) + (Char.code d)
+				in
+			let s = Buffer.contents con.con_buf in
+			Buffer.clear con.con_buf;
+			let len = htonl_of_chars s.[0] s.[1] s.[2] s.[3] in
+			con.con_header <- (0, len)
+		);
+		let (left, len) = con.con_header in
+		if left > 0 then (
+			let s = String.create left in
+			let r = Unix.read con.con_fd s 0 left in
+			if r = 0 then (
+				con.con_closing <- true;
+				con_close con
+			) else (
+				Buffer.add_substring con.con_buf s 0 r;
+				con.con_header <- (left - r, 0)
+			)
+		) else (
+			let clen = Buffer.length con.con_buf in
+			let to_read = min (len - clen) 4096 in
+			let s = String.create to_read in
+			let r = Unix.read con.con_fd s 0 to_read in
+			if r = 0 then (
+				con.con_closing <- true;
+				con_close con
+			) else (
+				Buffer.add_substring con.con_buf s 0 r;
+				if Buffer.length con.con_buf = len then (
+					con.con_closing <- true;
+					connection_do_task con
+				);
+			)
+		)
+		in
+
 	Sys.set_signal Sys.sigint (Sys.Signal_handle (fun i -> quit := true));
 	Sys.set_signal Sys.sighup (Sys.Signal_handle (fun i -> read_config_noexn state None));
 
@@ -518,6 +600,10 @@ let monitor_rpc legacy_socket json_socket state =
 			let (fd, _) = Unix.accept legacy_socket in
 			connections := (con_new fd true) :: !connections;
 		);
+		if List.mem json_socket r then (
+			let (fd, _) = Unix.accept json_socket in
+			connections := (con_new fd false) :: !connections;
+		);
 		List.iter (fun con ->
 			let fd = con_get_fd con in
 			if List.mem fd r then (
@@ -528,7 +614,9 @@ let monitor_rpc legacy_socket json_socket state =
 					) ();
 					connections := List.filter (fun c -> c <> con) !connections;
 				) else (
-					()
+					connection_process con;
+					if con.con_closing then
+						connections := List.filter (fun c -> c <> con) !connections;
 				)
 			)
 		) !connections;