add support for receiving/sending jsonrpc

diff --git a/xenvm/Makefile b/xenvm/Makefile
index 4bacb377d6af945b65a9a41cb6c39aec40396db1..1b52aea14528a30fb85a4beb59e58780526ce205 100644 (file)
--- 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 53827f50b78860ece6b0270d1303608d07e63487..e9cfc5ffdff7a470ca359bbd7b7ebb304f90fbe9 100644 (file)
--- 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;