Switch to newer ocaml-rpc library

jonludlam · lindig · commit 3be6afb6466b · 2017-02-14T16:07:29.000Z
Signed-off-by: Jon Ludlam &lt;jonathan.ludlam@citrix.com&gt;
diff --git a/.gitignore b/.gitignore
@@ -98,7 +98,7 @@ ocaml/templates/templateLexer.ml
 ocaml/templates/templateParser.ml
 ocaml/templates/templateParser.mli
 ocaml/xapi/storage_impl_test
-ocaml/util/version.ml
+ocaml/util/xapi_version.ml
 
 stunnel-4.15/Makefile
 stunnel-4.15/config.status
diff --git a/Makefile b/Makefile
@@ -90,7 +90,7 @@ clean:
 	omake clean
 	omake lib-uninstall
 	rm -rf dist/staging
-	rm -f .omakedb .omakedb.lock xapi.spec version.ml
+	rm -f .omakedb .omakedb.lock xapi.spec xapi_version.ml
 	find -name '*.omc' -delete
 
 .PHONY: otags
@@ -129,7 +129,7 @@ version:
 	let build_number () = Inventory.lookup ~default:\"$(BUILD_NUMBER)\" \"BUILD_NUMBER\" \n \
 	let xapi_version_major = $(shell cut -d. -f1 VERSION) \n \
 	let xapi_version_minor = $(shell cut -d. -f2 VERSION) \n" \
-	> ocaml/util/version.ml
+	> ocaml/util/xapi_version.ml
 
 .PHONY: clean
  clean:
@@ -146,7 +146,7 @@ srpm: xapi.spec
 	cp $(JQUERY) $(JQUERY_TREEVIEW) $(RPM_SOURCESDIR)
 	make -C $(REPO) version
 	rm -f $(RPM_SOURCESDIR)/xapi-version.patch
-	(cd $(REPO); diff -u /dev/null ocaml/util/version.ml > $(RPM_SOURCESDIR)/xapi-version.patch) || true
+	(cd $(REPO); diff -u /dev/null ocaml/util/xapi_version.ml > $(RPM_SOURCESDIR)/xapi-version.patch) || true
 	rm -f $(RPM_SOURCESDIR)/0001-Workaround-for-NVIDIA-330.patch
 	cp scripts/0001-Workaround-for-NVIDIA-330.patch $(RPM_SOURCESDIR)/0001-Workaround-for-NVIDIA-330.patch
 	cp -f xapi.spec $(RPM_SPECSDIR)/
diff --git a/ocaml/database/OMakefile b/ocaml/database/OMakefile
@@ -1,12 +1,9 @@
 
 OCAMLINCLUDES = ../idl/ocaml_backend ../xapi ../idl ../util ../autogen ..
-OCAMLPACKS    = xml-light2 stdext stunnel http-svr xcp sexpr rpclib uuid gzip xcp-inventory oUnit
-#OCAMLPPFLAGS  = -pp "camlp4o" 
+OCAMLPACKS    = xml-light2 stdext stunnel http-svr xcp sexpr rpclib uuid gzip xcp-inventory oUnit ppx_sexp_conv ppx_deriving_rpc
+#OCAMLPPFLAGS  = -pp "camlp4o"
 #OCAMLDEPFLAGS = -pp "camlp4o"
 
-UseCamlp4(rpclib.syntax, db_rpc_common_v2 db_cache_types db_filter_types)
-UseCamlp4(sexplib.syntax, schema)
-
 OCamlGeneratedFiles(db_filter_parse.ml db_filter_parse.mli db_filter_lex.ml)
 
 OCamlProgram(unit_test_sql, unit_test_sql)
@@ -19,7 +16,7 @@ BLOCK_DEVICE_IO_FILES = \
 
 OCamlProgram(block_device_io, $(BLOCK_DEVICE_IO_FILES))
 
-DATABASE_SERVER_FILES = database_server_main test_schemas ../autogen/db_actions 
+DATABASE_SERVER_FILES = database_server_main test_schemas ../autogen/db_actions
 DATABASE_TEST_FILES = db_cache_test test_schemas
 section:
 	#XXX there are lots of interdependencies which we should be aim to remove
@@ -43,4 +40,3 @@ sdk-install: install
 clean:
 	rm -f $(CLEAN_OBJS) xenEnterpriseAPI* gen gen.opt db_filter_parse.ml db_filter_parse.mli db_filter_lex.ml
 	rm -f block_device_io unit_test_marshall block_device_io.opt unit_test_marshall.opt database_test
-
diff --git a/ocaml/database/db_cache_types.ml b/ocaml/database/db_cache_types.ml
@@ -493,11 +493,11 @@ type where_record = {
   return: string;      (** we'd like to return this field... *)
   where_field: string; (** where this other field... *)
   where_value: string; (** contains this value *)
-} with rpc
+} [@@deriving rpc]
 
 type structured_op_t =
   | AddSet
   | RemoveSet
   | AddMap
   | RemoveMap
-with rpc
+[@@deriving rpc]
diff --git a/ocaml/database/db_filter_types.ml b/ocaml/database/db_filter_types.ml
@@ -15,7 +15,7 @@
 type _val =
   | Field of string
   | Literal of string
-with rpc
+[@@deriving rpc]
 
 (** Represent a predicate: table row -> bool *)
 type expr =
@@ -25,4 +25,4 @@ type expr =
   | Eq of _val * _val
   | And of expr * expr
   | Or of expr * expr
-with rpc
+[@@deriving rpc]
diff --git a/ocaml/database/db_rpc_common_v2.ml b/ocaml/database/db_rpc_common_v2.ml
@@ -33,7 +33,7 @@ module Request = struct
     | Read_record of string * string
     | Read_records_where of string * Db_filter_types.expr
     | Process_structured_field of (string * string) * string * string * string * Db_cache_types.structured_op_t
-  with rpc
+  [@@deriving rpc]
 end
 
 module Response = struct
@@ -61,6 +61,5 @@ module Response = struct
     | Uniqueness_constraint_violation of string * string * string
     | Read_missing_uuid of string * string * string
     | Too_many_values of string * string * string
-  with rpc
+  [@@deriving rpc]
 end
-
diff --git a/ocaml/database/schema.ml b/ocaml/database/schema.ml
@@ -18,7 +18,7 @@ module Type = struct
     | String
     | Set (* of strings *)
     | Pairs (* of string * string *)
-  with sexp
+  [@@deriving sexp]
 
   exception Error of t * t
   let _ = Printexc.register_printer (function
@@ -35,7 +35,7 @@ module Value = struct
     | String of string
     | Set of string list
     | Pairs of (string * string) list
-  with sexp
+  [@@deriving sexp]
 
   let marshal = function
     | String x -> x
@@ -73,33 +73,33 @@ module Column = struct
     default: Value.t option;  (** if column is missing, this is default value is used *)
     ty: Type.t;               (** the type of the value in the column *)
     issetref: bool;           (** only so we can special case set refs in the interface *)
-  } with sexp
+  } [@@deriving sexp]
 end
 
 module Table = struct
   type t = {
     name: string;
     columns: Column.t list;
     persistent: bool;
-  } with sexp
+  } [@@deriving sexp]
   let find name t = List.find (fun col -> col.Column.name = name) t.columns
 end
 
 type relationship =
   | OneToMany of string * string * string * string
-with sexp
+[@@deriving sexp]
 
 module Database = struct
   type t = {
     tables: Table.t list;
-  } with sexp
+  } [@@deriving sexp]
 
   let find name t = List.find (fun tbl -> tbl.Table.name = name) t.tables
 end
 
 (** indexed by table name, a list of (this field, foreign table, foreign field) *)
 type foreign = (string * string * string) list
-with sexp
+[@@deriving sexp]
 
 module ForeignMap = struct
   include Map.Make(struct
@@ -108,7 +108,7 @@ module ForeignMap = struct
     end)
 
   type t' = (string * foreign) list
-  with sexp
+  [@@deriving sexp]
 
   type m = foreign t
   let sexp_of_m t : Sexplib.Sexp.t =
@@ -127,7 +127,7 @@ type t = {
   (** indexed by table name, a list of (this field, foreign table, foreign field) *)
   one_to_many: ForeignMap.m;
   many_to_many: ForeignMap.m;
-} with sexp
+} [@@deriving sexp]
 
 let database x = x.database
 
@@ -170,4 +170,3 @@ let many_to_many tblname schema =
   try
     ForeignMap.find tblname schema.many_to_many
   with Not_found -> []
-
diff --git a/ocaml/idl/ocaml_backend/OMakefile b/ocaml/idl/ocaml_backend/OMakefile
@@ -117,7 +117,7 @@ SERVER_OBJS = ../../database/escaping locking_helpers \
 	../../xapi/xapi_extensions
 
 XAPI_CLIENT_OBJS = \
-	../../util/version \
+	../../util/xapi_version \
 	../../xapi/xapi_inventory \
 	../../xapi/xapi_fist \
 	../../xapi/features \
diff --git a/ocaml/util/OMakefile b/ocaml/util/OMakefile
@@ -1,7 +1,7 @@
 OCAMLPACKS    = http-svr xcp uuid xcp-inventory
 
 #OCamlLibrary(util_globs_inventory, util_globs_inventory)
-OCamlLibrary(version,        version)
+OCamlLibrary(xapi_version,        xapi_version)
 
 OCamlLibrary(sanitycheck, sanitycheck)
 OCamlLibrary(stats, stats)
@@ -22,7 +22,7 @@ OCamlLibrary(encodings, encodings)
 .PHONY: clean
 clean:
 	rm -f $(CLEAN_OBJS)
-	rm -f version.ml
+	rm -f xapi_version.ml
 
 .PHONY: install
 install:
diff --git a/ocaml/util/xapi_version.mli b/ocaml/util/xapi_version.mli
diff --git a/ocaml/xapi/db_gc.ml b/ocaml/xapi/db_gc.ml
@@ -260,7 +260,7 @@ let check_host_liveness ~__context =
           with _ -> 0.0 (* never *)
         in
         let old_heartbeat_time =
-          if rum && (Version.platform_version () <> (Helpers.version_string_of ~__context (Helpers.LocalObject host))) then
+          if rum && (Xapi_version.platform_version () <> (Helpers.version_string_of ~__context (Helpers.LocalObject host))) then
             (debug "Host %s considering using metrics last update time as heartbeat" (Ref.string_of host);
              Date.to_float (Db.Host_metrics.get_last_updated ~__context ~self:hmetric))
           else 0.0 in
@@ -498,7 +498,7 @@ let detect_rolling_upgrade ~__context =
       if actually_in_progress <> pool_says_in_progress then begin
         let platform_versions = List.map (fun host -> Helpers.version_string_of ~__context (Helpers.LocalObject host)) (Db.Host.get_all ~__context) in
         debug "xapi platform version = %s; host platform versions = [ %s ]"
-          (Version.platform_version ()) (String.concat "; " platform_versions);
+          (Xapi_version.platform_version ()) (String.concat "; " platform_versions);
 
         warn "Pool thinks rolling upgrade%s in progress but Host version numbers indicate otherwise; correcting"
           (if pool_says_in_progress then "" else " not");
diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml
@@ -709,7 +709,7 @@ let assert_host_has_highest_version_in_pool : __context:Context.t -> host:API.re
 let pool_has_different_host_platform_versions ~__context =
   let all_hosts = Db.Host.get_all ~__context in
   let platform_versions = List.map (fun host -> version_string_of ~__context (LocalObject host)) all_hosts in
-  let is_different_to_me platform_version = platform_version <> Version.platform_version () in
+  let is_different_to_me platform_version = platform_version <> Xapi_version.platform_version () in
   List.fold_left (||) false (List.map is_different_to_me platform_versions)
 
 let get_vm_metrics ~__context ~self =
diff --git a/ocaml/xapi/importexport.ml b/ocaml/xapi/importexport.ml
@@ -67,11 +67,11 @@ let obj_of_xmlrpc x =
 let this_version __context =
   let host = Helpers.get_localhost ~__context in
   let (_: API.host_t) = Db.Host.get_record ~__context ~self:host in
-  { hostname = Version.hostname;
-    date = Version.date;
-    product_version = Version.product_version ();
-    product_brand = Version.product_brand ();
-    build_number = Version.build_number ();
+  { hostname = Xapi_version.hostname;
+    date = Xapi_version.date;
+    product_version = Xapi_version.product_version ();
+    product_brand = Xapi_version.product_brand ();
+    build_number = Xapi_version.build_number ();
     xapi_vsn_major = Xapi_globs.version_major;
     xapi_vsn_minor = Xapi_globs.version_minor;
     export_vsn = Xapi_globs.export_vsn;
diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml
@@ -171,12 +171,12 @@ let debug_dummy_data = ref false
 
 let show_version () =
   List.iter (fun (x, y) -> printf "%s=%s\n" x y)
-    [ "git_id", Version.git_id;
-      "hostname", Version.hostname;
-      "date", Version.date;
-      "PRODUCT_VERSION", Version.product_version ();
-      "PRODUCT_BRAND", Version.product_brand ();
-      "BUILD_NUMBER", Version.build_number ()];
+    [ "git_id", Xapi_version.git_id;
+      "hostname", Xapi_version.hostname;
+      "date", Xapi_version.date;
+      "PRODUCT_VERSION", Xapi_version.product_version ();
+      "PRODUCT_BRAND", Xapi_version.product_brand ();
+      "BUILD_NUMBER", Xapi_version.build_number ()];
   exit 0
 
 let init_args() =
diff --git a/ocaml/xapi/xapi_config.ml b/ocaml/xapi/xapi_config.ml
@@ -25,11 +25,11 @@ let log_if_not_empty format_string value =
 
 let dump_config () =
   debug "Server configuration:";
-  log_if_not_empty "product_version: %s" (Version.product_version ());
-  log_if_not_empty "product_brand: %s" (Version.product_brand ());
-  debug "platform_version: %s" (Version.platform_version ());
-  debug "platform_name: %s" (Version.platform_name ());
-  debug "build_number: %s" (Version.build_number ());
-  debug "git changeset: %s" Version.git_id;
+  log_if_not_empty "product_version: %s" (Xapi_version.product_version ());
+  log_if_not_empty "product_brand: %s" (Xapi_version.product_brand ());
+  debug "platform_version: %s" (Xapi_version.platform_version ());
+  debug "platform_name: %s" (Xapi_version.platform_name ());
+  debug "build_number: %s" (Xapi_version.build_number ());
+  debug "git changeset: %s" Xapi_version.git_id;
   debug "version: %d.%d" version_major version_minor;
   (* debug "License filename: %s" !License_file.filename *)
diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml
@@ -31,8 +31,8 @@ let pool_secret = ref ""
 let localhost_ref : [`host] Ref.t ref = ref Ref.null
 
 (* xapi version *)
-let version_major = Version.xapi_version_major
-let version_minor = Version.xapi_version_minor
+let version_major = Xapi_version.xapi_version_major
+let version_minor = Xapi_version.xapi_version_minor
 let xapi_user_agent = "xapi/"^(string_of_int version_major)^"."^(string_of_int version_minor)
 
 (* api version *)
@@ -140,16 +140,16 @@ let export_vsn = 2
 let software_version () =
   (* In the case of XCP, all product_* fields will be blank. *)
   List.filter (fun (_, value) -> value <> "")
-    [_product_version, Version.product_version ();
-     _product_version_text,       Version.product_version_text ();
-     _product_version_text_short, Version.product_version_text_short ();
-     _platform_name, Version.platform_name ();
-     _platform_version, Version.platform_version ();
-     _product_brand,   Version.product_brand ();
-     _build_number,    Version.build_number ();
-     _git_id,           Version.git_id;
-     _hostname,        Version.hostname;
-     _date,            Version.date]
+    [_product_version, Xapi_version.product_version ();
+     _product_version_text,       Xapi_version.product_version_text ();
+     _product_version_text_short, Xapi_version.product_version_text_short ();
+     _platform_name, Xapi_version.platform_name ();
+     _platform_version, Xapi_version.platform_version ();
+     _product_brand,   Xapi_version.product_brand ();
+     _build_number,    Xapi_version.build_number ();
+     _git_id,           Xapi_version.git_id;
+     _hostname,        Xapi_version.hostname;
+     _date,            Xapi_version.date]
 
 let pygrub_path = "/usr/bin/pygrub"
 let eliloader_path = "/usr/bin/eliloader"
@@ -201,7 +201,7 @@ let grant_api_access = "grant_api_access"
 (* other-config key for backwards compat. *)
 let tools_sr_tag = "xenserver_tools_sr"
 
-let tools_sr_name () = Version.product_brand () ^ " Tools"
+let tools_sr_name () = Xapi_version.product_brand () ^ " Tools"
 let tools_sr_description () = tools_sr_name () ^ " ISOs"
 
 let tools_sr_dir = ref "/opt/xensource/packages/iso"
