WARNING - OLD ARCHIVES

This is an archived copy of the Xen.org mailing list, which we have preserved to ensure that existing links to archives are not broken. The live archive, which contains the latest emails, can be found at http://lists.xen.org/
   
 
 
Xen 
 
Home Products Support Community News
 
   
 

xen-api

[Xen-API] [PATCH 09 of 17] CP-2137: Use rpc-light to implement the xapi<

To: xen-api@xxxxxxxxxxxxxxxxxxx
Subject: [Xen-API] [PATCH 09 of 17] CP-2137: Use rpc-light to implement the xapi<->v6d XMLRPC interface
From: Rob Hoes <rob.hoes@xxxxxxxxxx>
Date: Fri, 7 Jan 2011 16:57:52 +0000
Delivery-date: Fri, 07 Jan 2011 09:05:50 -0800
Envelope-to: www-data@xxxxxxxxxxxxxxxxxxx
In-reply-to: <patchbomb.1294419463@xxxxxxxxxxxxxxxxxxxxxxx>
List-help: <mailto:xen-api-request@lists.xensource.com?subject=help>
List-id: Discussion of API issues surrounding Xen <xen-api.lists.xensource.com>
List-post: <mailto:xen-api@lists.xensource.com>
List-subscribe: <http://lists.xensource.com/mailman/listinfo/xen-api>, <mailto:xen-api-request@lists.xensource.com?subject=subscribe>
List-unsubscribe: <http://lists.xensource.com/mailman/listinfo/xen-api>, <mailto:xen-api-request@lists.xensource.com?subject=unsubscribe>
References: <patchbomb.1294419463@xxxxxxxxxxxxxxxxxxxxxxx>
Sender: xen-api-bounces@xxxxxxxxxxxxxxxxxxx
User-agent: Mercurial-patchbomb/1.6.3
Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>


# HG changeset patch
# User Rob Hoes <rob.hoes@xxxxxxxxxx>
# Date 1294419411 0
# Node ID 7b6fef2813f75a20b5eb877aad11e9657bc38f97
# Parent  bd7e14b4c9e36e5616530a2f14d130845edd3b07
CP-2137: Use rpc-light to implement the xapi<->v6d XMLRPC interface

Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>

diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/idl/ocaml_backend/OMakefile
--- a/ocaml/idl/ocaml_backend/OMakefile
+++ b/ocaml/idl/ocaml_backend/OMakefile
@@ -112,7 +112,7 @@
        ../../util/util_inventory \
        ../../util/version \
        ../../xapi/xapi_inventory \
-       ../../license/v6xmlrpc \
+       ../../license/v6rpc \
        ../../license/v6daemon \
        $(COMMON_OBJS) \
        $(CLIENT_OBJS)
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/OMakefile
--- a/ocaml/license/OMakefile
+++ b/ocaml/license/OMakefile
@@ -1,12 +1,12 @@
-OCAML_LIBS    = ../util/version ../idl/ocaml_backend/common 
../idl/ocaml_backend/client
+OCAML_LIBS    = ../util/version ../idl/ocaml_backend/xapi_client
 OCAMLINCLUDES = ../idl/ocaml_backend ../idl ../autogen ../xapi ../gpg ../util
-OCAMLPACKS    = xml-light2 stdext stunnel http-svr log
+OCAMLPACKS    = xml-light2 stdext stunnel http-svr log rpc-light
 
-IEXE=install -m 755 -o root -g root
+UseCamlp4(rpc-light.syntax, v6rpc)
 
 V6FILES = \
        fakev6 \
-       v6xmlrpc \
+       v6rpc \
        v6daemon
 
 # Name of daemon to install in dom0:
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6client.ml
--- a/ocaml/license/v6client.ml
+++ b/ocaml/license/v6client.ml
@@ -12,6 +12,7 @@
  * GNU Lesser General Public License for more details.
  *)
 
+open V6rpc
 module D=Debug.Debugger(struct let name="v6client" end)
 open D
 
@@ -31,7 +32,7 @@
 let socket = "/var/xapi/v6"
 
 (* RPC function for communication with the v6 daemon *)
-let v6rpc xml = Xmlrpcclient.do_xml_rpc_unix ~version:"1.0" ~filename:socket 
~path:"/" xml
+let v6rpc call = Rpc_client.do_rpc_unix ~version:"1.0" ~filename:socket 
~path:"/" call
 
 (* conversion to v6 edition codes *)
 let editions = [Edition.Free, "FREE"]
@@ -47,21 +48,22 @@
        if !connected then begin
                debug "release license";
                try
-                       let request = XMLRPC.To.methodCall "shutdown" [] in
-                       let response = v6rpc request in
-                       debug "response: %s" (Xml.to_string response);
-                       match XMLRPC.From.methodResponse response with
-                       | XMLRPC.Success [r] ->
-                               let success = XMLRPC.From.boolean r in
-                               debug "success: %b" success;
-                               if success then begin
-                                       match !licensed with
+                       let success =
+                               let call = Rpc.call "shutdown" [] in
+                               let response = v6rpc call in
+                               try Rpc.bool_of_rpc response.Rpc.contents
+                               with e ->
+                                       error "Got error %s" 
(Printexc.to_string e);
+                                       raise V6DaemonFailure in
+                       debug "success: %b" success;
+                       if success then begin
+                               match !licensed with
                                        | None -> ()
                                        | Some edition ->
                                                info "Checked %s license back 
in to license server." (Edition.to_string edition);
                                                reset_state ()
                                end
-                       | _ -> 
+                       else
                                raise V6DaemonFailure
                with
                | Unix.Unix_error(a, b, c) ->
@@ -86,59 +88,48 @@
                debug "invalid edition!"
        else begin
                try
-                       let myassoc key args =
-                               try List.assoc key args
-                               with Not_found ->
-                                       error "key %s not found in v6d's 
response" key;
-                                       raise V6DaemonFailure
-                       in
-                       let get_named_string name args = XMLRPC.From.string 
(myassoc name args) in
-                       let get_named_int name args = XMLRPC.From.int (myassoc 
name args) in
-                       let v6_edition = List.assoc edition editions in
-                       let fields = ["address", XMLRPC.To.string address; 
"port", XMLRPC.To.int (Int32.of_int port); "edition", XMLRPC.To.string 
v6_edition] in
-                       let params = XMLRPC.To.structure fields in
-                       let request = XMLRPC.To.methodCall "initialise" 
[params] in
-                       let response = v6rpc request in
-                       debug "response: %s" (Xml.to_string response);
-                       match XMLRPC.From.methodResponse response with
-                       | XMLRPC.Success [r] ->
-                               let str = XMLRPC.From.structure r in
-                               let license = get_named_string "license" str in
-                               let days_to_expire = Int32.to_int 
(get_named_int "days_to_expire" str) in
-                               debug "license: %s; days-to-expire: %d" license 
days_to_expire;
-                               connected := true;
-                               (* set expiry date *)
-                               let now = Unix.time () in
-                               if days_to_expire > -1 then
-                                       expires := now +. (float_of_int 
(days_to_expire * 24 * 3600))
+                       let edition' = List.assoc edition editions in
+                       let params = rpc_of_initialise_in { address = address; 
port = port; edition = edition' } in
+                       let call = Rpc.call "initialise" [ params ] in
+                       let response = v6rpc call in
+                       debug "response: %s" (Rpc.to_string 
response.Rpc.contents);
+                       let license, days_to_expire =
+                               if response.Rpc.success then
+                                       let r = initialise_out_of_rpc 
response.Rpc.contents in r.license, r.days_to_expire
                                else
-                                       expires := never;
-                               (* check fist point *)
-                               (* CA-33155: FIST point may only set an expiry 
date earlier than the actual one *)
-                               begin match Xapi_fist.set_expiry_date () with
+                                       raise V6DaemonFailure in
+                       debug "license: %s; days-to-expire: %ld" license 
days_to_expire;
+                       connected := true;
+                       (* set expiry date *)
+                       let now = Unix.time () in
+                       if days_to_expire > -1l then
+                               expires := now +. (Int32.to_float 
days_to_expire *. 24. *. 3600.)
+                       else
+                               expires := never;
+                       (* check fist point *)
+                       (* CA-33155: FIST point may only set an expiry date 
earlier than the actual one *)
+                       begin match Xapi_fist.set_expiry_date () with
                                | None -> ()
                                | Some d ->
                                        let fist_date = Date.to_float 
(Date.of_string d) in
                                        if fist_date < !expires then expires := 
fist_date
-                               end;
-                               (* check return status *)
-                               if license = "real" then begin
-                                       info "Checked out %s license from 
license server." (Edition.to_string edition);
-                                       licensed := Some edition;
-                                       grace := false
-                               end else if license = "grace" then begin
-                                       info "Obtained %s grace license." 
(Edition.to_string edition);
-                                       licensed := Some edition;
-                                       grace := true;
-                                       if Xapi_fist.reduce_grace_period () then
-                                               expires := now +. (15. *. 60.)
-                               end else begin
-                                       info "License check out failed.";
-                                       licensed := None;
-                                       grace := false
-                               end
-                       | _ -> 
-                               raise V6DaemonFailure
+                       end;
+                       (* check return status *)
+                       if license = "real" then begin
+                               info "Checked out %s license from license 
server." (Edition.to_string edition);
+                               licensed := Some edition;
+                               grace := false
+                       end else if license = "grace" then begin
+                               info "Obtained %s grace license." 
(Edition.to_string edition);
+                               licensed := Some edition;
+                               grace := true;
+                               if Xapi_fist.reduce_grace_period () then
+                                       expires := now +. (15. *. 60.)
+                       end else begin
+                               info "License check out failed.";
+                               licensed := None;
+                               grace := false
+                       end
                with
                | Unix.Unix_error(a, b, c) ->
                        error "Problem while initialising (%s): %s" b 
(Unix.error_message a);
@@ -152,8 +143,8 @@
        try
                let ls = Db.Host.get_license_server ~__context ~self:host in
                let address = List.assoc "address" ls in
-               let port = int_of_string (List.assoc "port" ls) in
-               debug "obtaining %s v6 license; license server address: %s; 
port: %d" (Edition.to_string edition) address port;
+               let port = Int32.of_string (List.assoc "port" ls) in
+               debug "obtaining %s v6 license; license server address: %s; 
port: %ld" (Edition.to_string edition) address port;
                (* obtain v6 license *)
                connect_and_get_license edition address port
        with
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6daemon.ml
--- a/ocaml/license/v6daemon.ml
+++ b/ocaml/license/v6daemon.ml
@@ -30,9 +30,9 @@
        let body = Http_svr.read_body req bio in
        debug "Request: %s" body;
        let s = Buf_io.fd_of bio in
-       let xml = Xml.parse_string body in
-       let result = process xml in
-       let str = Xml.to_string result in
+       let rpc = Xmlrpc.call_of_string body in
+       let result = process rpc in
+       let str = Xmlrpc.string_of_response result in
        debug "Response: %s" str;
        Http_svr.response_str req s str
        
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6daemon.mli
--- a/ocaml/license/v6daemon.mli
+++ b/ocaml/license/v6daemon.mli
@@ -15,4 +15,4 @@
 (** Licensing daemon creation module *)
 
 (** Create and start up the licensing daemon *)
-val startup : (unit -> 'a) -> (Xml.xml -> Xml.xml) -> unit
+val startup : (unit -> 'a) -> (Rpc.call -> Rpc.response) -> unit
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6rpc.ml
--- /dev/null
+++ b/ocaml/license/v6rpc.ml
@@ -0,0 +1,65 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module D = Debug.Debugger(struct let name="v6xmlrpc" end)
+open D
+
+exception Unmarshalling_error of string
+
+type initialise_in = {
+       address: string;
+       port: int32;
+       edition: string;
+} with rpc
+
+type initialise_out = {
+       license: string;
+       days_to_expire: int32;
+} with rpc
+
+type failure = string * (string list) with rpc
+let response_of_failure code params =
+       Rpc.failure (rpc_of_failure (code, params))
+let response_of_fault code =
+       Rpc.failure (rpc_of_failure ("Fault", [code]))
+
+module type V6api = sig
+       val initialise : string -> int32 -> string -> string * int32
+       val shutdown : unit -> bool
+       val reopen_logs : unit -> bool
+end
+
+module V6process = functor(V: V6api) -> struct
+       let process call =
+               let response =
+                       try match call.Rpc.name with
+                       | "initialise" -> 
+                               let arg_rpc = match call.Rpc.params with [a] -> 
a | _ -> raise (Unmarshalling_error "initialise") in
+                               let arg = initialise_in_of_rpc arg_rpc in
+                               let l,d = V.initialise arg.address arg.port 
arg.edition in
+                               let response = rpc_of_initialise_out { license 
= l; days_to_expire = d } in 
+                               Rpc.success response
+                       | "shutdown" ->
+                               let response = Rpc.rpc_of_bool (V.shutdown ()) 
in
+                               Rpc.success response
+                       | "reopen-logs" ->
+                               let response = Rpc.rpc_of_bool (V.reopen_logs 
()) in
+                               Rpc.success response
+                       | x -> response_of_fault ("unknown RPC: " ^ x)
+                       with e ->
+                               log_backtrace ();
+                               response_of_failure "INTERNAL_ERROR" 
[Printexc.to_string e] in
+               response
+end
+
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6rpc.mli
--- /dev/null
+++ b/ocaml/license/v6rpc.mli
@@ -0,0 +1,47 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** XML/RPC handler for the licensing daemon *)
+
+(** The XML/RPC interface of the licensing daemon *)
+module type V6api =
+       sig
+               val initialise : string -> int32 -> string -> string * int32
+               val shutdown : unit -> bool
+               val reopen_logs : unit -> bool
+       end
+  
+(** XML/RPC handler *)
+module V6process : functor (V : V6api) ->
+       sig
+               (** Process an XML/RPC call *)
+               val process : Rpc.call -> Rpc.response
+       end
+
+(** {2 Marshaling functions} *)
+
+type initialise_in = {
+       address: string;
+       port: int32;
+       edition: string;
+}
+
+val rpc_of_initialise_in : initialise_in -> Rpc.t
+
+type initialise_out = {
+       license: string;
+       days_to_expire: int32;
+}
+
+val initialise_out_of_rpc : Rpc.t -> initialise_out
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6testd.ml
--- a/ocaml/license/v6testd.ml
+++ b/ocaml/license/v6testd.ml
@@ -12,7 +12,7 @@
  * GNU Lesser General Public License for more details.
  *)
 
-module P = V6xmlrpc.V6process(Fakev6)
+module P = V6rpc.V6process(Fakev6)
 
 let _ =
        Logs.reset_all [ "file:/var/log/v6d.log" ];
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6testd.mli
--- a/ocaml/license/v6testd.mli
+++ b/ocaml/license/v6testd.mli
@@ -17,5 +17,5 @@
 (** Instatiate licensing daemon XML/RPC handler *)
 module P : sig 
        (** Process an XML/RPC call *)
-       val process : XMLRPC.xmlrpc -> XMLRPC.xmlrpc
+       val process : Rpc.call -> Rpc.response
 end
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6xmlrpc.ml
--- a/ocaml/license/v6xmlrpc.ml
+++ /dev/null
@@ -1,62 +0,0 @@
-(*
- * Copyright (C) 2006-2009 Citrix Systems Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published
- * by the Free Software Foundation; version 2.1 only. with the special
- * exception on linking described in file LICENSE.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *)
-
-module D = Debug.Debugger(struct let name="v6xmlrpc" end)
-open D
-
-exception Unmarshalling_error of string
-
-module type V6api = sig
-       val initialise : string -> int32 -> string -> string * int32
-       val shutdown : unit -> bool
-       val reopen_logs : unit -> bool
-end
-
-module V6process = functor(V: V6api) -> struct
-       let myassoc key args =
-               try List.assoc key args with Not_found -> raise 
(Unmarshalling_error key)
-
-       let get_named_string name args =
-               XMLRPC.From.string (myassoc name args)
-       
-       let get_named_int name args =
-               XMLRPC.From.int (myassoc name args)
-
-       let process xml =
-               let call,args = XMLRPC.From.methodCall xml in
-               let args = try XMLRPC.From.structure (List.hd args) with _ -> 
[] in
-               let response = 
-                       try match call with
-                       | "initialise" -> 
-                               let address = get_named_string "address" args in
-                               let port = get_named_int "port" args in
-                               let edition = get_named_string "edition" args in
-                               let response = match (V.initialise address port 
edition) with
-                               | l, d -> XMLRPC.To.structure 
-                                       ["license", XMLRPC.To.string l; 
"days_to_expire", XMLRPC.To.int d] in
-                               XMLRPC.Success [response]
-                       | "shutdown" ->
-                               let response = XMLRPC.To.boolean (V.shutdown 
()) in
-                               XMLRPC.Success [response]
-                       | "reopen-logs" ->
-                               let response = XMLRPC.To.boolean (V.reopen_logs 
()) in
-                               XMLRPC.Success [response]
-                       | x -> XMLRPC.Fault (Int32.of_int 0, "unknown RPC: " ^ 
x)
-                       with e ->
-                               log_backtrace ();
-                               XMLRPC.Failure 
("INTERNAL_ERROR",[Printexc.to_string e])
-               in
-               XMLRPC.To.methodResponse response
-end
-
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6xmlrpc.mli
--- a/ocaml/license/v6xmlrpc.mli
+++ /dev/null
@@ -1,30 +0,0 @@
-(*
- * Copyright (C) 2006-2009 Citrix Systems Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published
- * by the Free Software Foundation; version 2.1 only. with the special
- * exception on linking described in file LICENSE.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *)
-
-(** XML/RPC handler for the licensing daemon *)
-
-(** The XML/RPC interface of the licensing daemon *)
-module type V6api =
-       sig
-               val initialise : string -> int32 -> string -> string * int32
-               val shutdown : unit -> bool
-               val reopen_logs : unit -> bool
-       end
-  
-(** XML/RPC handler *)
-module V6process : functor (V : V6api) ->
-       sig
-               (** Process an XML/RPC call *)
-               val process : XMLRPC.xmlrpc -> XMLRPC.xmlrpc
-       end
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/xapi/OMakefile
--- a/ocaml/xapi/OMakefile
+++ b/ocaml/xapi/OMakefile
@@ -234,6 +234,7 @@
        ../database/db_hiupgrade \
        certificates \
        ../license/v6client \
+       ../license/v6rpc \
        bios_strings \
        xapi_config \
        ../license/grace_retry \

Attachment: xen-api.hg-09.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api