diff --git a/dune-project b/dune-project index 20058ef9e72..0d402cd7a9d 100644 --- a/dune-project +++ b/dune-project @@ -3,6 +3,7 @@ (generate_opam_files true) +(name "xapi") (source (github xapi-project/xen-api)) (license "LGPL-2.1-only WITH OCaml-LGPL-linking-exception") (authors "xen-api@lists.xen.org") diff --git a/ocaml/database/block_device_io.ml b/ocaml/database/block_device_io.ml index 3d4e10288b4..7587a34d5d5 100644 --- a/ocaml/database/block_device_io.ml +++ b/ocaml/database/block_device_io.ml @@ -90,6 +90,8 @@ open Xapi_stdext_pervasives.Pervasiveext open Xapi_stdext_unix +module Db_globs = Xapi_database.Db_globs +module Block_device_io_errors = Xapi_database.Block_device_io_errors let name = "block_device_io" diff --git a/ocaml/database/database_server_main.ml b/ocaml/database/database_server_main.ml index 4809bc7fd16..1dc59284263 100644 --- a/ocaml/database/database_server_main.ml +++ b/ocaml/database/database_server_main.ml @@ -17,7 +17,7 @@ let c = Condition.create () (** Handler for the remote database access URL *) let remote_database_access_handler_v1 req bio = - try Db_remote_cache_access_v1.handler req bio + try Xapi_database.Db_remote_cache_access_v1.handler req bio with e -> Printf.printf "Caught: %s\n" (Printexc.to_string e) ; Printexc.print_backtrace stdout ; @@ -26,14 +26,15 @@ let remote_database_access_handler_v1 req bio = (** Handler for the remote database access URL *) let remote_database_access_handler_v2 req bio = - try Db_remote_cache_access_v2.handler req bio + try Xapi_database.Db_remote_cache_access_v2.handler req bio with e -> Printf.printf "Caught: %s\n" (Printexc.to_string e) ; Printexc.print_backtrace stdout ; flush stdout ; raise e -module Local_tests = Database_test.Tests (Db_cache_impl) +module Local_tests = + Xapi_database.Database_test.Tests (Xapi_database.Db_cache_impl) let schema = Test_schemas.schema @@ -67,6 +68,7 @@ let _ = | Slave _ -> failwith "unimplemented" | Master db_filename -> + let open Xapi_database in Printf.printf "Database path: %s\n%!" db_filename ; let db = Parse_db_conf.make db_filename in Db_conn_store.initialise_db_connections [db] ; diff --git a/ocaml/database/db_cache_test.ml b/ocaml/database/db_cache_test.ml index 7fd7b0a5006..ed2a3296940 100644 --- a/ocaml/database/db_cache_test.ml +++ b/ocaml/database/db_cache_test.ml @@ -12,7 +12,8 @@ * GNU Lesser General Public License for more details. *) -open Db_cache_types +open Xapi_database +open Xapi_database.Db_cache_types let create_test_db () = let schema = Test_schemas.many_to_many in diff --git a/ocaml/database/dune b/ocaml/database/dune index 0b0c71425ff..e135f3d7e63 100644 --- a/ocaml/database/dune +++ b/ocaml/database/dune @@ -21,6 +21,7 @@ (library (name xapi_database) + (modes best) (modules (:standard \ database_server_main db_cache_test db_names db_exn block_device_io string_marshall_helper string_unmarshall_helper schema @@ -48,7 +49,6 @@ xml-light2 xmlm ) - (wrapped false) (preprocess (pps ppx_deriving_rpc)) ) diff --git a/ocaml/database/unit_test_marshall.ml b/ocaml/database/unit_test_marshall.ml index c751646097c..a9a77a11560 100644 --- a/ocaml/database/unit_test_marshall.ml +++ b/ocaml/database/unit_test_marshall.ml @@ -11,9 +11,9 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) -open Db_rpc_common_v1 -open Db_cache_types -open Db_filter_types +open Xapi_database.Db_rpc_common_v1 +open Xapi_database.Db_cache_types +open Xapi_database.Db_filter_types (* Check, for randomly chosen x's, that (unmarshall (marshall x)) = x *) diff --git a/ocaml/db_process/xapi_db_process.ml b/ocaml/db_process/xapi_db_process.ml index 633e2c14e30..fe5e509645e 100644 --- a/ocaml/db_process/xapi_db_process.ml +++ b/ocaml/db_process/xapi_db_process.ml @@ -14,7 +14,8 @@ module D = Debug.Make (struct let name = "xapi-db-process" end) open D -open Db_cache_types +open Xapi_database +open Xapi_database.Db_cache_types let compress = ref false diff --git a/ocaml/idl/ocaml_backend/gen_db_actions.ml b/ocaml/idl/ocaml_backend/gen_db_actions.ml index db222970b92..13bc14a1f4b 100644 --- a/ocaml/idl/ocaml_backend/gen_db_actions.ml +++ b/ocaml/idl/ocaml_backend/gen_db_actions.ml @@ -271,13 +271,14 @@ let ocaml_of_tbl_fields xs = let open_db_module = [ "let __t = Context.database_of __context in" - ; "let module DB = (val (Db_cache.get __t) : Db_interface.DB_ACCESS) in" + ; "let module DB = (val (Xapi_database.Db_cache.get __t) : \ + Xapi_database.Db_interface.DB_ACCESS) in" ] let db_action api : O.Module.t = let api = make_db_api api in let expr = "expr" in - let expr_arg = O.Named (expr, "Db_filter_types.expr") in + let expr_arg = O.Named (expr, "Xapi_database.Db_filter_types.expr") in let get_refs_where (obj : obj) = let tbl = Escaping.escape_obj obj.DT.name in let body = @@ -526,13 +527,13 @@ let db_action api : O.Module.t = | FromObject GetAllRecords -> String.concat "\n" [ - "let expr' = Db_filter_types.True in" + "let expr' = Xapi_database.Db_filter_types.True in" ; "get_records_where ~" ^ Gen_common.context ^ " ~expr:expr'" ] | FromObject GetAllRecordsWhere -> String.concat "\n" [ - "let expr' = Db_filter.expr_of_string expr in" + "let expr' = Xapi_database.Db_filter.expr_of_string expr in" ; "get_records_where ~" ^ Gen_common.context ^ " ~expr:expr'" ] | _ -> @@ -577,7 +578,7 @@ let db_action api : O.Module.t = O.Module.make ~name:_db_action ~preamble: [ - "open Db_cache_types" + "open Xapi_database.Db_cache_types" ; "module D=Debug.Make(struct let name=\"db\" end)" ; "open D" ] diff --git a/ocaml/libs/ezxenstore/core/dune b/ocaml/libs/ezxenstore/core/dune index 2eabd6bea12..b1b11e8b6a0 100644 --- a/ocaml/libs/ezxenstore/core/dune +++ b/ocaml/libs/ezxenstore/core/dune @@ -1,7 +1,6 @@ (library (name ezxenstore_core) (public_name ezxenstore.core) - (wrapped false) (libraries cmdliner logs diff --git a/ocaml/libs/ezxenstore/lib_test/main.ml b/ocaml/libs/ezxenstore/lib_test/main.ml index 1605fc2ba08..5226f5240aa 100644 --- a/ocaml/libs/ezxenstore/lib_test/main.ml +++ b/ocaml/libs/ezxenstore/lib_test/main.ml @@ -6,7 +6,7 @@ let set_socket_path path = Xs_transport.xenstored_socket := path let test socket = set_socket_path socket ; - let open Xenstore in + let open Ezxenstore_core.Xenstore in if Unix.geteuid () <> 0 then (* non-root won't have access to xenstore *) `Ok 0 else diff --git a/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml b/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml index d65bc43d466..e552ecb1e5a 100644 --- a/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml +++ b/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml @@ -19,7 +19,7 @@ end module Make (Debug : DEBUG) = struct open Debug - open Xenstore + open Ezxenstore_core.Xenstore exception Watch_overflow @@ -46,7 +46,7 @@ module Make (Debug : DEBUG) = struct val watch_fired : Xenctrl.handle - -> Xenstore.Xs.xsh + -> Ezxenstore_core.Xenstore.Xs.xsh -> string -> Xenctrl.domaininfo IntMap.t -> IntSet.t @@ -56,9 +56,11 @@ module Make (Debug : DEBUG) = struct val found_running_domain : int -> string -> unit - val domain_appeared : Xenctrl.handle -> Xenstore.Xs.xsh -> int -> unit + val domain_appeared : + Xenctrl.handle -> Ezxenstore_core.Xenstore.Xs.xsh -> int -> unit - val domain_disappeared : Xenctrl.handle -> Xenstore.Xs.xsh -> int -> unit + val domain_disappeared : + Xenctrl.handle -> Ezxenstore_core.Xenstore.Xs.xsh -> int -> unit end let watch ~xs token path = diff --git a/ocaml/libs/http-lib/dune b/ocaml/libs/http-lib/dune index dfc10dccb15..efa34f0bddd 100644 --- a/ocaml/libs/http-lib/dune +++ b/ocaml/libs/http-lib/dune @@ -35,6 +35,7 @@ (library (name httpsvr) (wrapped false) + (modes best) (modules http_svr http_proxy server_io) (libraries astring @@ -51,6 +52,7 @@ (tests (names http_test radix_tree_test) (package http-lib) + (modes (best exe)) (modules http_test radix_tree_test) (libraries alcotest diff --git a/ocaml/nbd/lib/local_xapi_session.ml b/ocaml/nbd/lib/local_xapi_session.ml index ccc71e2d9c2..08167ad6e1a 100644 --- a/ocaml/nbd/lib/local_xapi_session.ml +++ b/ocaml/nbd/lib/local_xapi_session.ml @@ -13,7 +13,7 @@ *) open Lwt.Infix -module Xen_api = Xen_api_lwt_unix +module Xen_api = Xen_api_client_lwt.Xen_api_lwt_unix let wait_for_xapi_and_login () = let rpc = Xen_api.make Consts.xapi_unix_domain_socket_uri in diff --git a/ocaml/nbd/src/cleanup.ml b/ocaml/nbd/src/cleanup.ml index 213933fa56b..a3c0fd60d35 100644 --- a/ocaml/nbd/src/cleanup.ml +++ b/ocaml/nbd/src/cleanup.ml @@ -13,7 +13,7 @@ *) open Lwt.Infix -module Xen_api = Xen_api_lwt_unix +module Xen_api = Xen_api_client_lwt.Xen_api_lwt_unix let ignore_exn_log_error msg t = Lwt.catch t (fun e -> Lwt_log.error (msg ^ ": " ^ Printexc.to_string e)) diff --git a/ocaml/nbd/src/main.ml b/ocaml/nbd/src/main.ml index 21c48b5acac..d8f67a8c49a 100644 --- a/ocaml/nbd/src/main.ml +++ b/ocaml/nbd/src/main.ml @@ -15,7 +15,7 @@ open Lwt.Infix (* Xapi external interfaces: *) -module Xen_api = Xen_api_lwt_unix +module Xen_api = Xen_api_client_lwt.Xen_api_lwt_unix let ignore_exn_delayed t () = Lwt.catch t (fun _ -> Lwt.return_unit) diff --git a/ocaml/tests/common/alcotest_comparators.ml b/ocaml/tests/common/alcotest_comparators.ml index 7dce3faa85a..21f596875ea 100644 --- a/ocaml/tests/common/alcotest_comparators.ml +++ b/ocaml/tests/common/alcotest_comparators.ml @@ -31,9 +31,11 @@ let vdi_nbd_server_info_set = let vdi_type : API.vdi_type Alcotest.testable = from_rpc_of_t API.rpc_of_vdi_type -let db_cache_structured_op = from_rpc_of_t Db_cache_types.rpc_of_structured_op_t +let db_cache_structured_op = + from_rpc_of_t Xapi_database.Db_cache_types.rpc_of_structured_op_t -let db_rpc_request = from_rpc_of_t Db_rpc_common_v2.Request.rpc_of_t +let db_rpc_request = + from_rpc_of_t Xapi_database.Db_rpc_common_v2.Request.rpc_of_t let ref () = from_to_string Ref.string_of diff --git a/ocaml/tests/common/dune b/ocaml/tests/common/dune index fdc6fbd9a6c..c578f5f9785 100644 --- a/ocaml/tests/common/dune +++ b/ocaml/tests/common/dune @@ -1,6 +1,7 @@ (library (name tests_common) (modules :standard) + (modes best) (wrapped false) (libraries alcotest diff --git a/ocaml/tests/common/mock.ml b/ocaml/tests/common/mock.ml index e27f3b78e0e..ec6cb44a8a7 100644 --- a/ocaml/tests/common/mock.ml +++ b/ocaml/tests/common/mock.ml @@ -13,6 +13,8 @@ *) module Database = struct + open Xapi_database + let _schema = Datamodel_schema.of_datamodel () let conn = [Parse_db_conf.make "./xapi-db.xml"] diff --git a/ocaml/tests/dune b/ocaml/tests/dune index 93bf4b66ddf..126b522e151 100644 --- a/ocaml/tests/dune +++ b/ocaml/tests/dune @@ -1,6 +1,6 @@ (test (name suite_alcotest) - (modes exe) + (modes (best exe)) (package xapi) (modules (:standard \ test_daemon_manager test_vdi_cbt test_event test_clustering @@ -121,6 +121,7 @@ (name test_observer) (package xapi) (modules test_observer) +(modes (best exe)) (libraries alcotest tracing xapi_internal tests_common yojson)) (rule diff --git a/ocaml/tests/test_db_lowlevel.ml b/ocaml/tests/test_db_lowlevel.ml index 7745f8e7cdc..fb3a3ce9da5 100644 --- a/ocaml/tests/test_db_lowlevel.ml +++ b/ocaml/tests/test_db_lowlevel.ml @@ -13,6 +13,7 @@ *) open Test_common +open Xapi_database (* If we delete a record after making a Db.get_all_records call, but before the * call returns, then Db.get_all_records should return successfully (not throw diff --git a/ocaml/tests/test_ha_vm_failover.ml b/ocaml/tests/test_ha_vm_failover.ml index 1c4cf79e6ea..4ab377870ab 100644 --- a/ocaml/tests/test_ha_vm_failover.ml +++ b/ocaml/tests/test_ha_vm_failover.ml @@ -384,7 +384,7 @@ module AssertNewVMPreservesHAPlan = Generic.MakeStateful (struct let load_input __context (pool, _) = setup ~__context pool let extract_output __context (_pool, vm) = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let local_sr = Db.SR.get_refs_where ~__context ~expr:(Eq (Field "shared", Literal "false")) diff --git a/ocaml/tests/test_helpers.ml b/ocaml/tests/test_helpers.ml index c3b86bbff82..42028c0d072 100644 --- a/ocaml/tests/test_helpers.ml +++ b/ocaml/tests/test_helpers.ml @@ -62,7 +62,7 @@ module DetermineGateway = Generic.MakeStateful (struct let management_interface = Option.map (fun device -> - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let pifs = Db.PIF.get_refs_where ~__context ~expr:(Eq (Field "device", Literal device)) diff --git a/ocaml/xapi-cli-server/cli_util.ml b/ocaml/xapi-cli-server/cli_util.ml index 86e3401b57a..be9ad66839c 100644 --- a/ocaml/xapi-cli-server/cli_util.ml +++ b/ocaml/xapi-cli-server/cli_util.ml @@ -242,6 +242,7 @@ let get_default_sr_uuid rpc session_id = (* Given a string that might be a ref, lookup ref in cache and print uuid/name-label where possible *) let ref_convert x = + let module Ref_index = Xapi_database.Ref_index in match Ref_index.lookup x with | None -> x diff --git a/ocaml/xapi-cli-server/dune b/ocaml/xapi-cli-server/dune index 6814d74fd56..e10c76ea4c3 100644 --- a/ocaml/xapi-cli-server/dune +++ b/ocaml/xapi-cli-server/dune @@ -1,5 +1,6 @@ (library (name xapi_cli_server) + (modes best) (libraries astring base64 diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 91374487259..516f4c56763 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -139,6 +139,8 @@ let safe_get_field x = | e -> raise e +module Ref_index = Xapi_database.Ref_index + let get_uuid_from_ref r = try match Ref_index.lookup (Ref.string_of r) with diff --git a/ocaml/xapi-guard/lib/server_interface.ml b/ocaml/xapi-guard/lib/server_interface.ml index 0884c2bf1b2..d58a934f5f2 100644 --- a/ocaml/xapi-guard/lib/server_interface.ml +++ b/ocaml/xapi-guard/lib/server_interface.ml @@ -32,7 +32,7 @@ type session = [`session] Ref.t type rpc = call -> response Lwt.t -open Xen_api_lwt_unix +open Xen_api_client_lwt.Xen_api_lwt_unix let shutdown = Lwt_switch.create () @@ -102,10 +102,8 @@ let serve_forever_lwt_callback rpc_fn path _ req body = let with_xapi_vtpm ~cache vm_uuid = let vm_uuid_str = Uuidm.to_string vm_uuid in - let* vm = - with_xapi ~cache @@ Xen_api_lwt_unix.VM.get_by_uuid ~uuid:vm_uuid_str - in - let* vTPMs = with_xapi ~cache @@ Xen_api_lwt_unix.VM.get_VTPMs ~self:vm in + let* vm = with_xapi ~cache @@ VM.get_by_uuid ~uuid:vm_uuid_str in + let* vTPMs = with_xapi ~cache @@ VM.get_VTPMs ~self:vm in match vTPMs with | [] -> D.warn diff --git a/ocaml/xapi-guard/src/main.ml b/ocaml/xapi-guard/src/main.ml index 9fb40aa038b..67e0b7f1d0b 100644 --- a/ocaml/xapi-guard/src/main.ml +++ b/ocaml/xapi-guard/src/main.ml @@ -16,7 +16,7 @@ open Lwt.Syntax open Xapi_guard_server module Types = Xapi_guard.Types -module SessionCache = Xen_api_lwt_unix.SessionCache +module SessionCache = Xen_api_client_lwt.Xen_api_lwt_unix.SessionCache let ( let@ ) f x = f x @@ -87,16 +87,15 @@ let safe_unlink path = ) let cache = - Xen_api_lwt_unix.( - SessionCache.create_uri ~switch:Server_interface.shutdown - ~target:uri_local_json ~uname:"root" ~pwd:"" ~version:Xapi_version.version - ~originator:Server_interface.originator () - ) + let target = Xen_api_client_lwt.Xen_api_lwt_unix.uri_local_json in + SessionCache.create_uri ~switch:Server_interface.shutdown ~target + ~uname:"root" ~pwd:"" ~version:Xapi_version.version + ~originator:Server_interface.originator () let () = Lwt_switch.add_hook (Some Server_interface.shutdown) (fun () -> D.debug "Cleaning up cache at exit" ; - Xen_api_lwt_unix.SessionCache.destroy cache + SessionCache.destroy cache ) let listen_for_vm read_write {Persistent.vm_uuid; path; gid; typ} = @@ -214,7 +213,7 @@ let depriv_swtpm_destroy dbg gid path = it's OK to assume it's available. *) let vtpm_set_contents dbg vtpm_uuid contents = - let open Xen_api_lwt_unix in + let open Xen_api_client_lwt.Xen_api_lwt_unix in let open Lwt.Syntax in let uuid = Uuidm.to_string vtpm_uuid in D.debug "[%s] saving vTPM contents for %s" dbg uuid ; @@ -223,7 +222,7 @@ let vtpm_set_contents dbg vtpm_uuid contents = Server_interface.with_xapi ~cache @@ VTPM.set_contents ~self ~contents let vtpm_get_contents _dbg vtpm_uuid = - let open Xen_api_lwt_unix in + let open Xen_api_client_lwt.Xen_api_lwt_unix in let open Lwt.Syntax in let uuid = Uuidm.to_string vtpm_uuid in ret diff --git a/ocaml/xapi-guard/test/xapi_guard_test.ml b/ocaml/xapi-guard/test/xapi_guard_test.ml index 86efb713d29..b9e6fea2c9b 100644 --- a/ocaml/xapi-guard/test/xapi_guard_test.ml +++ b/ocaml/xapi-guard/test/xapi_guard_test.ml @@ -1,8 +1,8 @@ open Xapi_guard_server -module SessionCache = Xen_api_lwt_unix.SessionCache +module SessionCache = Xen_api_client_lwt.Xen_api_lwt_unix.SessionCache open Alcotest_lwt open Lwt.Syntax -open Xen_api_lwt_unix +open Xen_api_client_lwt.Xen_api_lwt_unix module D = Debug.Make (struct let name = "xapi-guard-test" end) @@ -88,7 +88,7 @@ let with_rpc f switch () = (* rpc simulates what varstored would do *) let uri = Uri.make ~scheme:"file" ~path () |> Uri.to_string in D.debug "Connecting to %s" uri ; - let rpc = Xen_api_lwt_unix.make uri in + let rpc = make uri in Lwt.finalize (fun () -> (* not strictly necessary to login/logout here - since we only get dummy sessions *) diff --git a/ocaml/xapi-idl/lib/debuginfo.ml b/ocaml/xapi-idl/lib/debug_info.ml similarity index 100% rename from ocaml/xapi-idl/lib/debuginfo.ml rename to ocaml/xapi-idl/lib/debug_info.ml diff --git a/ocaml/xapi-idl/lib/debuginfo.mli b/ocaml/xapi-idl/lib/debug_info.mli similarity index 100% rename from ocaml/xapi-idl/lib/debuginfo.mli rename to ocaml/xapi-idl/lib/debug_info.mli diff --git a/ocaml/xapi-idl/lib/task_server.ml b/ocaml/xapi-idl/lib/task_server.ml index e963e42687f..a4c675e7d04 100644 --- a/ocaml/xapi-idl/lib/task_server.ml +++ b/ocaml/xapi-idl/lib/task_server.ml @@ -128,16 +128,16 @@ functor (* [add dbg f] creates a fresh [t], registers and returns it *) let add ?traceparent tasks dbg (f : task_handle -> Interface.Task.async_result option) = - let dbg' = Debuginfo.of_string dbg in + let dbg' = Debug_info.of_string dbg in let tracing = - match (dbg'.Debuginfo.tracing, traceparent) with + match (dbg'.Debug_info.tracing, traceparent) with | Some t, _ -> Some t | None, Some traceparent -> let spancontext = Tracing.SpanContext.of_traceparent traceparent in Option.map (fun tp -> - Tracing.Tracer.span_of_span_context tp dbg'.Debuginfo.log + Tracing.Tracer.span_of_span_context tp dbg'.Debug_info.log ) spancontext | _ -> @@ -148,7 +148,7 @@ functor tasks ; id= next_task_id () ; ctime= Unix.gettimeofday () - ; dbg= dbg'.Debuginfo.log + ; dbg= dbg'.Debug_info.log ; tracing ; state= Interface.Task.Pending 0. ; subtasks= [] diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml index b7209ec323e..a6016b5805b 100644 --- a/ocaml/xapi/api_server.ml +++ b/ocaml/xapi/api_server.ml @@ -320,7 +320,8 @@ let jsoncallback req bio _ = let fd = Buf_io.fd_of bio in (* fd only used for writing *) let body = - Http_svr.read_body ~limit:Db_globs.http_limit_max_rpc_size req bio + Http_svr.read_body ~limit:Xapi_database.Db_globs.http_limit_max_rpc_size req + bio in try let json_rpc_version, id, rpc = diff --git a/ocaml/xapi/cancel_tasks.ml b/ocaml/xapi/cancel_tasks.ml index 3a61fa26bca..690cd1026b1 100644 --- a/ocaml/xapi/cancel_tasks.ml +++ b/ocaml/xapi/cancel_tasks.ml @@ -26,7 +26,7 @@ let safe_wrapper n f x = Debug.log_backtrace e (Backtrace.get e) let update_all_allowed_operations ~__context = - let open Stats in + let time_this = Xapi_database.Stats.time_this in let all_vms = Db.VM.get_all ~__context and all_vbds = Db.VBD.get_all ~__context and all_vifs = Db.VIF.get_all ~__context diff --git a/ocaml/xapi/certificates.ml b/ocaml/xapi/certificates.ml index 6b871e686c5..0204b7b064a 100644 --- a/ocaml/xapi/certificates.ml +++ b/ocaml/xapi/certificates.ml @@ -179,7 +179,7 @@ end = struct let get_ca_certs ~__context name = let expr = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let type' = Eq (Field "type", Literal "ca") in let name' = Eq (Field "name", Literal name) in And (type', name') @@ -187,7 +187,7 @@ end = struct Db.Certificate.get_refs_where ~__context ~expr let get_host_certs ~__context ~type' ~host = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let type' = Eq (Field "type", Literal (Record_util.certificate_type_to_string type')) in @@ -251,7 +251,7 @@ end = struct let get_ca_certs ~__context = let expr = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in Eq (Field "type", Literal "ca") in Db.Certificate.get_refs_where ~__context ~expr diff --git a/ocaml/xapi/cluster_stack_constraints.ml b/ocaml/xapi/cluster_stack_constraints.ml index d6689085173..8efa8bc4cab 100644 --- a/ocaml/xapi/cluster_stack_constraints.ml +++ b/ocaml/xapi/cluster_stack_constraints.ml @@ -1,4 +1,4 @@ -open Db_filter_types +open Xapi_database.Db_filter_types module Listext = Xapi_stdext_std.Listext.List module D = Debug.Make (struct let name = "cluster_stack_constraints" end) diff --git a/ocaml/xapi/console.ml b/ocaml/xapi/console.ml index f682289163d..03cb4bf9559 100644 --- a/ocaml/xapi/console.ml +++ b/ocaml/xapi/console.ml @@ -184,7 +184,9 @@ let console_of_request __context req = go for that. *) let db = Context.database_of __context in let is_vm, _ = - let module DB = (val Db_cache.get db : Db_interface.DB_ACCESS) in + let module DB = + (val Xapi_database.Db_cache.get db : Xapi_database.Db_interface.DB_ACCESS) + in match DB.get_table_from_ref db _ref with | Some c when c = Db_names.vm -> (true, false) diff --git a/ocaml/xapi/context.ml b/ocaml/xapi/context.ml index dce55ca4d40..080bab8fcad 100644 --- a/ocaml/xapi/context.ml +++ b/ocaml/xapi/context.ml @@ -42,7 +42,7 @@ type t = { ; task_id: API.ref_task ; forwarded_task: bool ; origin: origin - ; database: Db_ref.t + ; database: Xapi_database.Db_ref.t ; dbg: string ; mutable tracing: Tracing.Span.t option ; client: Http_svr.client option @@ -99,9 +99,9 @@ let is_unix_socket s = let default_database () = if Pool_role.is_master () then - Db_backend.make () + Xapi_database.Db_backend.make () else - Db_ref.Remote + Xapi_database.Db_ref.Remote let preauth ~__context = match __context.origin with @@ -154,17 +154,19 @@ let __destroy_task : (__context:t -> API.ref_task -> unit) ref = let string_of_task __context = __context.dbg let string_of_task_and_tracing __context = - Debuginfo.make ~log:__context.dbg ~tracing:__context.tracing - |> Debuginfo.to_string + Debug_info.make ~log:__context.dbg ~tracing:__context.tracing + |> Debug_info.to_string let tracing_of_dbg s = - let dbg = Debuginfo.of_string s in + let dbg = Debug_info.of_string s in (dbg.log, dbg.tracing) let check_for_foreign_database ~__context = match __context.session_id with | Some sid -> ( - match Db_backend.get_registered_database (Ref.string_of sid) with + match + Xapi_database.Db_backend.get_registered_database (Ref.string_of sid) + with | Some database -> {__context with database} | None -> diff --git a/ocaml/xapi/context.mli b/ocaml/xapi/context.mli index 7b2ece18c2c..07e5cb6ea29 100644 --- a/ocaml/xapi/context.mli +++ b/ocaml/xapi/context.mli @@ -25,7 +25,7 @@ val make : -> ?quiet:bool -> ?subtask_of:API.ref_task -> ?session_id:API.ref_session - -> ?database:Db_ref.t + -> ?database:Xapi_database.Db_ref.t -> ?task_in_database:bool -> ?task_description:string -> ?origin:origin @@ -87,7 +87,7 @@ val task_in_database : t -> bool val get_origin : t -> string (** [get_origin __context] returns a string containing the origin of [__context]. *) -val database_of : t -> Db_ref.t +val database_of : t -> Xapi_database.Db_ref.t (** [database_of __context] returns a database handle, which can be used by Db.* *) (** {6 Destructors} *) diff --git a/ocaml/xapi/create_misc.ml b/ocaml/xapi/create_misc.ml index 7a2630ea57f..546b3cc24d1 100644 --- a/ocaml/xapi/create_misc.ml +++ b/ocaml/xapi/create_misc.ml @@ -20,7 +20,7 @@ module Unixext = Xapi_stdext_unix.Unixext module Date = Xapi_stdext_date.Date open Xapi_vm_memory_constraints open Vm_memory_constraints -open Db_filter_types +open Xapi_database.Db_filter_types open Network module XenAPI = Client.Client diff --git a/ocaml/xapi/db.ml b/ocaml/xapi/db.ml index 0ceecb1d459..4b4b6c2deea 100644 --- a/ocaml/xapi/db.ml +++ b/ocaml/xapi/db.ml @@ -16,6 +16,7 @@ *) include Db_actions.DB_Action +open Xapi_database let is_valid_ref __context r = if r = Ref.null then diff --git a/ocaml/xapi/db_gc.ml b/ocaml/xapi/db_gc.ml index e0d79a5bc8e..c7fb5d93373 100644 --- a/ocaml/xapi/db_gc.ml +++ b/ocaml/xapi/db_gc.ml @@ -270,10 +270,10 @@ let tickle_heartbeat ~__context host stuff = let single_pass () = Server_helpers.exec_with_new_task "DB GC" (fun __context -> - Db_lock.with_lock (fun () -> + Xapi_database.Db_lock.with_lock (fun () -> let time_one (name, f) = - Stats.time_this (Printf.sprintf "Db_gc: %s" name) (fun () -> - f ~__context + Xapi_database.Stats.time_this (Printf.sprintf "Db_gc: %s" name) + (fun () -> f ~__context ) in List.iter time_one Db_gc_util.gc_subtask_list diff --git a/ocaml/xapi/db_gc_util.ml b/ocaml/xapi/db_gc_util.ml index 3a9d8f74856..eb86d981291 100644 --- a/ocaml/xapi/db_gc_util.ml +++ b/ocaml/xapi/db_gc_util.ml @@ -27,7 +27,9 @@ let valid_ref x = Db.is_valid_ref x let gc_connector ~__context get_all get_record valid_ref1 valid_ref2 delete_record = let db = Context.database_of __context in - let module DB = (val Db_cache.get db : Db_interface.DB_ACCESS) in + let module DB = + (val Xapi_database.Db_cache.get db : Xapi_database.Db_interface.DB_ACCESS) + in let all_refs = get_all ~__context in let do_gc ref = let print_valid b = if b then "valid" else "INVALID" in @@ -188,7 +190,7 @@ let gc_PGPUs ~__context = let gc_VGPU_types ~__context = (* We delete a VGPU_type iff it does not appear in the supported_VGPU_types of any PGPU _and_ there doesn't exist a VGPU with this VGPU_type *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let garbage = Db.VGPU_type.get_records_where ~__context ~expr: @@ -272,7 +274,8 @@ let probation_pending_tasks = Hashtbl.create 53 let timeout_tasks ~__context = let all_tasks = - Db.Task.get_internal_records_where ~__context ~expr:Db_filter_types.True + Db.Task.get_internal_records_where ~__context + ~expr:Xapi_database.Db_filter_types.True in let oldest_completed_time = Unix.time () -. !Xapi_globs.completed_task_timeout @@ -474,7 +477,8 @@ let last_session_log_time = ref None let timeout_sessions ~__context = let all_sessions = - Db.Session.get_internal_records_where ~__context ~expr:Db_filter_types.True + Db.Session.get_internal_records_where ~__context + ~expr:Xapi_database.Db_filter_types.True in let pool_sessions, nonpool_sessions = List.partition (fun (_, s) -> s.Db_actions.session_pool) all_sessions diff --git a/ocaml/xapi/dune b/ocaml/xapi/dune index fe161e0dd5f..6575b66aea5 100644 --- a/ocaml/xapi/dune +++ b/ocaml/xapi/dune @@ -57,6 +57,7 @@ (library (name xapi_internal) (wrapped false) + (modes best) (modules (:standard \ xapi_main)) (libraries angstrom diff --git a/ocaml/xapi/eventgen.ml b/ocaml/xapi/eventgen.ml index a3ef6e60608..274e74abb78 100644 --- a/ocaml/xapi/eventgen.ml +++ b/ocaml/xapi/eventgen.ml @@ -92,8 +92,8 @@ let events_of_other_tbl_refs other_tbl_refs = other_tbl_refs ) -open Db_cache_types -open Db_action_helper +open Xapi_database.Db_cache_types +open Xapi_database.Db_action_helper let database_callback_inner event db context = let other_tbl_refs tblname = follow_references tblname in diff --git a/ocaml/xapi/exnHelper.ml b/ocaml/xapi/exnHelper.ml index 84dbf269bfc..af5458e7839 100644 --- a/ocaml/xapi/exnHelper.ml +++ b/ocaml/xapi/exnHelper.ml @@ -68,7 +68,7 @@ let error_of_exn e = ) | Invalid_argument x -> (internal_error, [Printf.sprintf "Invalid argument: %s" x]) - | Db_filter.Expression_error (expr, exc) -> + | Xapi_database.Db_filter.Expression_error (expr, exc) -> (invalid_value, [expr; Printexc.to_string exc]) | Forkhelpers.Subprocess_failed n -> ( internal_error diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index bed75da7b0a..d8366e00a9a 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -23,7 +23,7 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute open Xapi_globs -open Db_filter_types +open Xapi_database.Db_filter_types include Helper_process open Network @@ -1292,7 +1292,9 @@ let vm_to_string __context vm = if not (Db.is_valid_ref __context vm) then raise (Api_errors.Server_error (Api_errors.invalid_value, [str])) ; let t = Context.database_of __context in - let module DB = (val Db_cache.get t : Db_interface.DB_ACCESS) in + let module DB = + (val Xapi_database.Db_cache.get t : Xapi_database.Db_interface.DB_ACCESS) + in let fields = fst (DB.read_record t Db_names.vm str) in let sexpr = SExpr.Node @@ -1966,7 +1968,7 @@ end = struct in Xapi_globs.pool_secrets := [ps] ; Db_globs.pool_secret := - ps |> SecretString.rpc_of_t |> Db_secret_string.t_of_rpc ; + ps |> SecretString.rpc_of_t |> Xapi_database.Db_secret_string.t_of_rpc ; SecretString.write_to_file !Xapi_globs.pool_secret_path ps ; Xapi_psr_util.load_psr_pool_secrets () end diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index 763d043511b..372cdb7fa20 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -287,7 +287,7 @@ let assert_can_live_import_vgpu ~__context vgpu_record = let local_pgpus = Db.PGPU.get_refs_where ~__context ~expr: - Db_filter_types.( + Xapi_database.Db_filter_types.( And ( Eq ( Field "GPU_group" diff --git a/ocaml/xapi/memory_check.ml b/ocaml/xapi/memory_check.ml index 51bc945904a..4d537aec2ca 100644 --- a/ocaml/xapi/memory_check.ml +++ b/ocaml/xapi/memory_check.ml @@ -128,7 +128,7 @@ type host_memory_summary = { (** list of VMs which are in the process of having a domain created here *) } -open Db_filter_types +open Xapi_database.Db_filter_types (** Return a host's memory summary from live database contents. *) let get_host_memory_summary ~__context ~host = diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 5caa4609ec4..bfaa69592d2 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -5351,15 +5351,14 @@ functor let pool_migrate ~__context ~vdi ~sr ~options = let vbds = - Db.VBD.get_records_where ~__context - ~expr: - (Db_filter_types.Eq - ( Db_filter_types.Field "VDI" - , Db_filter_types.Literal (Ref.string_of vdi) - ) - ) + let expr = + Xapi_database.Db_filter_types.( + Eq (Field "VDI", Literal (Ref.string_of vdi)) + ) + in + Db.VBD.get_records_where ~__context ~expr in - if List.length vbds < 1 then + if vbds = [] then raise (Api_errors.Server_error (Api_errors.vdi_needs_vm_for_migrate, [Ref.string_of vdi]) diff --git a/ocaml/xapi/monitor_dbcalls.ml b/ocaml/xapi/monitor_dbcalls.ml index 32cba8c2cd1..ab521155d2c 100644 --- a/ocaml/xapi/monitor_dbcalls.ml +++ b/ocaml/xapi/monitor_dbcalls.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Db_filter_types +open Xapi_database.Db_filter_types open Monitor_types open Monitor_dbcalls_cache diff --git a/ocaml/xapi/monitor_master.ml b/ocaml/xapi/monitor_master.ml index e65b4b5beca..bb4e6cf2e5b 100644 --- a/ocaml/xapi/monitor_master.ml +++ b/ocaml/xapi/monitor_master.ml @@ -15,7 +15,7 @@ module Rrdd = Rrd_client.Client module Date = Xapi_stdext_date.Date open Monitor_types -open Db_filter_types +open Xapi_database.Db_filter_types open Network module D = Debug.Make (struct let name = "monitor_master" end) @@ -128,12 +128,10 @@ let update_pifs ~__context host pifs = in let set_carrier (domid, devid) = let expr = - Db_filter_types.( - And - ( Eq (Field "resident_on", Literal (Ref.string_of host)) - , Eq (Field "domid", Literal (string_of_int domid)) - ) - ) + And + ( Eq (Field "resident_on", Literal (Ref.string_of host)) + , Eq (Field "domid", Literal (string_of_int domid)) + ) in match Db.VM.get_refs_where ~__context ~expr with | [] -> diff --git a/ocaml/xapi/network_event_loop.ml b/ocaml/xapi/network_event_loop.ml index 8e4b39cdbf7..4967e7f369e 100644 --- a/ocaml/xapi/network_event_loop.ml +++ b/ocaml/xapi/network_event_loop.ml @@ -26,7 +26,9 @@ let _watch_networks_for_nbd_changes __context ~update_firewall let allowed_interfaces = None in let api_timeout = 60. in let timeout = - 30. +. api_timeout +. !Db_globs.master_connection_reset_timeout + 30. + +. api_timeout + +. !Xapi_database.Db_globs.master_connection_reset_timeout in let wait_for_network_change ~token = let from = diff --git a/ocaml/xapi/nm.ml b/ocaml/xapi/nm.ml index 5129b01b389..5db9cb9a29f 100644 --- a/ocaml/xapi/nm.ml +++ b/ocaml/xapi/nm.ml @@ -16,7 +16,7 @@ module D = Debug.Make (struct let name = "nm" end) open D open Xapi_stdext_std.Xstringext module Listext = Xapi_stdext_std.Listext.List -open Db_filter_types +open Xapi_database.Db_filter_types open Network open Network_interface @@ -725,7 +725,7 @@ let bring_pif_up ~__context ?(management_interface = false) (pif : API.ref_PIF) (* The master_connection would otherwise try to take a broken stunnel from the cache *) Stunnel_cache.flush () ; warn "About to forcibly reset the master connection" ; - Master_connection.force_connection_reset () + Xapi_database.Master_connection.force_connection_reset () ) ; if rc.API.pIF_currently_attached = false || management_interface then ( if management_interface then ( diff --git a/ocaml/xapi/pool_db_backup.ml b/ocaml/xapi/pool_db_backup.ml index 3a6207ab63e..2a0ab1eae21 100644 --- a/ocaml/xapi/pool_db_backup.ml +++ b/ocaml/xapi/pool_db_backup.ml @@ -20,7 +20,8 @@ module Unixext = Xapi_stdext_unix.Unixext let finally = Xapi_stdext_pervasives.Pervasiveext.finally open Client -open Db_cache_types +open Xapi_database +open Xapi_database.Db_cache_types module D = Debug.Make (struct let name = "pool_db_sync" end) diff --git a/ocaml/xapi/pvs_cache_vdi.ml b/ocaml/xapi/pvs_cache_vdi.ml index b0b3f42d694..5fe404be616 100644 --- a/ocaml/xapi/pvs_cache_vdi.ml +++ b/ocaml/xapi/pvs_cache_vdi.ml @@ -15,7 +15,7 @@ module D = Debug.Make (struct let name = "pvs_cache_vdi" end) open D -open Db_filter_types +open Xapi_database.Db_filter_types let create_vdi ~__context ~sR ~size = info "Creating new PVS-cache VDI" ; diff --git a/ocaml/xapi/pvs_proxy_control.ml b/ocaml/xapi/pvs_proxy_control.ml index 0b5360a86b8..8597166fe7b 100644 --- a/ocaml/xapi/pvs_proxy_control.ml +++ b/ocaml/xapi/pvs_proxy_control.ml @@ -26,7 +26,7 @@ let proxy_port_name vif = (** [proxies] returns all currently attached proxies *) let get_running_proxies ~__context ~site = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in Db.PVS_proxy.get_refs_where ~__context ~expr: (And @@ -39,7 +39,7 @@ let get_running_proxies ~__context ~site = module State = struct type t = Starting | Started | Stopping | Failed - open Xenstore + open Ezxenstore_core.Xenstore let of_string = function | "starting" -> @@ -192,7 +192,7 @@ let remove_site_on_localhost ~__context ~site = exception No_cache_sr_available let find_cache_vdi ~__context ~host ~site = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in (* There should be at most one matching PVS_cache_storage object *) let pcs' = Db.PVS_cache_storage.get_refs_where ~__context @@ -376,7 +376,7 @@ let clear_proxy_state ~__context _vif proxy = Db.PVS_proxy.set_status ~__context ~self:proxy ~value:`stopped let find_proxy_for_vif ~__context ~vif = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let proxies = Db.PVS_proxy.get_refs_where ~__context ~expr:(Eq (Field "VIF", Literal (Ref.string_of vif))) diff --git a/ocaml/xapi/rbac_audit.ml b/ocaml/xapi/rbac_audit.ml index 6c3f99b7341..bbc5a7a6fc9 100644 --- a/ocaml/xapi/rbac_audit.ml +++ b/ocaml/xapi/rbac_audit.ml @@ -111,7 +111,7 @@ let get_obj_names_of_refs (obj_ref_list : SExpr.t list) : SExpr.t list = (function | SExpr.(Node [String name; String ""; String ""; String ref_value]) -> let obj_name, uuid = - match Ref_index.lookup ref_value with + match Xapi_database.Ref_index.lookup ref_value with | None -> ("", "") | Some {name_label= None; uuid; _} -> @@ -312,7 +312,7 @@ let rec sexpr_args_of __context name rpc_value action = else (* heuristic 2: print uuid/refs arguments in the xapi call *) match rpc_value with | Rpc.String value -> ( - match Ref_index.lookup value with + match Xapi_database.Ref_index.lookup value with | None when Ref.(is_real (of_string value)) -> (* it's a ref, just not in the db cache *) Some diff --git a/ocaml/xapi/redo_log_alert.ml b/ocaml/xapi/redo_log_alert.ml index 02ae81f62ef..11e9db4bdfe 100644 --- a/ocaml/xapi/redo_log_alert.ml +++ b/ocaml/xapi/redo_log_alert.ml @@ -52,7 +52,7 @@ let loop () = (fun () -> while true do let name, accessible = - Event.sync (Event.receive Redo_log.redo_log_events) + Event.sync (Event.receive Xapi_database.Redo_log.redo_log_events) in let alert_body = Printf.sprintf "Redo log [%s]" name in if accessible then ( diff --git a/ocaml/xapi/redo_log_usage.ml b/ocaml/xapi/redo_log_usage.ml index 245a0d183cd..630ebf03be5 100644 --- a/ocaml/xapi/redo_log_usage.ml +++ b/ocaml/xapi/redo_log_usage.ml @@ -19,6 +19,8 @@ exception DeltaTooOld exception DatabaseWrongSize of int * int +open Xapi_database + let read_from_redo_log log staging_path db_ref = R.log_and_ignore_exn @@ fun () -> (* 1. Start the process with which we communicate to access the redo log *) diff --git a/ocaml/xapi/redo_log_usage.mli b/ocaml/xapi/redo_log_usage.mli index 1bbd9c8888b..1e1c921820b 100644 --- a/ocaml/xapi/redo_log_usage.mli +++ b/ocaml/xapi/redo_log_usage.mli @@ -16,9 +16,12 @@ *) val read_from_redo_log : - [< `RO | `RW] Redo_log.redo_log -> string -> Db_ref.t -> unit + [< `RO | `RW] Xapi_database.Redo_log.redo_log + -> string + -> Xapi_database.Db_ref.t + -> unit (** Connect to the block device and write the latest version of the database * on it to a file with a given name. *) -val stop_using_redo_log : _ Redo_log.redo_log -> unit +val stop_using_redo_log : _ Xapi_database.Redo_log.redo_log -> unit (** Disconnect from the block device. May be safely called even when not currently connected. *) diff --git a/ocaml/xapi/slave_backup.ml b/ocaml/xapi/slave_backup.ml index bf8cd226031..aeb3e3e1e95 100644 --- a/ocaml/xapi/slave_backup.ml +++ b/ocaml/xapi/slave_backup.ml @@ -21,6 +21,8 @@ *) type write_entry = {period_start_time: float; writes_this_period: int} +module Parse_db_conf = Xapi_database.Parse_db_conf + let backup_write_table : (Parse_db_conf.db_connection, write_entry) Hashtbl.t = Hashtbl.create 20 @@ -93,7 +95,9 @@ let notify_write dbconn = let determine_backup_connections generation_count = tick_backup_write_table () ; (* reset existing write_entries if any periods expire *) - let dbconns_and_gen_counts = Db_connections.get_dbs_and_gen_counts () in + let dbconns_and_gen_counts = + Xapi_database.Db_connections.get_dbs_and_gen_counts () + in (* throw out dbconns that are up-to-date *) let dbconns_and_gen_counts = List.filter (fun (gen, _) -> gen <> generation_count) dbconns_and_gen_counts diff --git a/ocaml/xapi/sm.ml b/ocaml/xapi/sm.ml index 0ae899f63f0..df438a656bd 100644 --- a/ocaml/xapi/sm.ml +++ b/ocaml/xapi/sm.ml @@ -30,7 +30,7 @@ exception Unknown_driver of string exception MasterOnly -let with_dbg ~name ~dbg f = Debuginfo.with_dbg ~module_name:"SM" ~name ~dbg f +let with_dbg ~name ~dbg f = Debug_info.with_dbg ~module_name:"SM" ~name ~dbg f let supported_drivers () = Hashtbl.fold (fun name _ acc -> name :: acc) driver_info_cache [] @@ -39,7 +39,7 @@ let supported_drivers () = let register ~__context () = let dbg = Context.string_of_task_and_tracing __context in with_dbg ~name:"register" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let add_entry driver info = let name = String.lowercase_ascii driver in Hashtbl.replace driver_info_cache name info @@ -77,7 +77,7 @@ let srmaster_only (_, dconf) = let sr_create ~dbg dconf driver sr size = with_dbg ~dbg ~name:"sr_create" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_create" [Int64.to_string size] in @@ -86,7 +86,7 @@ let sr_create ~dbg dconf driver sr size = let sr_delete ~dbg dconf driver sr = with_dbg ~dbg ~name:"sr_delete" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_delete" [] in debug "sr_delete" driver (sprintf "sr=%s" (Ref.string_of sr)) ; Sm_exec.parse_unit (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call) @@ -97,7 +97,7 @@ let serialize_attach_detach = let sr_attach ~dbg dconf driver sr = with_dbg ~dbg ~name:"sr_attach" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Locking_helpers.Named_mutex.execute serialize_attach_detach (fun () -> debug "sr_attach" driver (sprintf "sr=%s" (Ref.string_of sr)) ; let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_attach" [] in @@ -106,7 +106,7 @@ let sr_attach ~dbg dconf driver sr = let sr_detach ~dbg dconf driver sr = with_dbg ~dbg ~name:"sr_detach" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Locking_helpers.Named_mutex.execute serialize_attach_detach (fun () -> debug "sr_detach" driver (sprintf "sr=%s" (Ref.string_of sr)) ; let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_detach" [] in @@ -115,7 +115,7 @@ let sr_detach ~dbg dconf driver sr = let sr_probe ~dbg dconf driver sr_sm_config = with_dbg ~dbg ~name:"sr_probe" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in if List.mem_assoc Sr_probe (features_of_driver driver) then Locking_helpers.Named_mutex.execute serialize_attach_detach (fun () -> debug "sr_probe" driver @@ -139,7 +139,7 @@ let sr_probe ~dbg dconf driver sr_sm_config = let sr_scan ~dbg dconf driver sr = with_dbg ~dbg ~name:"sr_scan" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "sr_scan" driver (sprintf "sr=%s" (Ref.string_of sr)) ; srmaster_only dconf ; let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_scan" [] in @@ -147,7 +147,7 @@ let sr_scan ~dbg dconf driver sr = let sr_update ~dbg dconf driver sr = with_dbg ~dbg ~name:"sr_update" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "sr_update" driver (sprintf "sr=%s" (Ref.string_of sr)) ; let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_update" [] in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call) @@ -156,7 +156,7 @@ let vdi_create ~dbg ?vdi_uuid dconf driver sr sm_config vdi_type size name_label name_description metadata_of_pool is_a_snapshot snapshot_time snapshot_of read_only = with_dbg ~dbg ~name:"vdi_create" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_create" driver (sprintf "sr=%s sm_config=[%s] type=[%s] size=%Ld" (Ref.string_of sr) (String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) sm_config)) @@ -181,7 +181,7 @@ let vdi_create ~dbg ?vdi_uuid dconf driver sr sm_config vdi_type size name_label let vdi_update ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_update" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_update" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = Sm_exec.make_call ~sr_ref:sr ~vdi_ref:vdi dconf "vdi_update" [] in @@ -189,7 +189,7 @@ let vdi_update ~dbg dconf driver sr vdi = let vdi_introduce ~dbg dconf driver sr new_uuid sm_config location = with_dbg ~dbg ~name:"vdi_introduce" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_introduce" driver (sprintf "sr=%s new_uuid=%s sm_config=[%s] location=%s" (Ref.string_of sr) new_uuid @@ -204,7 +204,7 @@ let vdi_introduce ~dbg dconf driver sr new_uuid sm_config location = let vdi_delete ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_delete" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_delete" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -213,7 +213,7 @@ let vdi_delete ~dbg dconf driver sr vdi = let vdi_attach ~dbg dconf driver sr vdi writable = with_dbg ~dbg ~name:"vdi_attach" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_attach" driver (sprintf "sr=%s vdi=%s writable=%b" (Ref.string_of sr) (Ref.string_of vdi) writable @@ -227,7 +227,7 @@ let vdi_attach ~dbg dconf driver sr vdi writable = let vdi_detach ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_detach" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_detach" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = Sm_exec.make_call ~sr_ref:sr ~vdi_ref:vdi dconf "vdi_detach" [] in @@ -235,7 +235,7 @@ let vdi_detach ~dbg dconf driver sr vdi = let vdi_activate ~dbg dconf driver sr vdi writable = with_dbg ~dbg ~name:"vdi_activate" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_activate" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -246,7 +246,7 @@ let vdi_activate ~dbg dconf driver sr vdi writable = let vdi_deactivate ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_deactivate" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_deactivate" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -256,7 +256,7 @@ let vdi_deactivate ~dbg dconf driver sr vdi = let vdi_snapshot ~dbg dconf driver driver_params sr vdi = with_dbg ~dbg ~name:"vdi_snapshot" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_snapshot" driver (sprintf "sr=%s vdi=%s driver_params=[%s]" (Ref.string_of sr) (Ref.string_of vdi) @@ -271,7 +271,7 @@ let vdi_snapshot ~dbg dconf driver driver_params sr vdi = let vdi_clone ~dbg dconf driver driver_params sr vdi = with_dbg ~dbg ~name:"vdi_clone" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_clone" driver (sprintf "sr=%s vdi=%s driver_params=[%s]" (Ref.string_of sr) (Ref.string_of vdi) @@ -286,7 +286,7 @@ let vdi_clone ~dbg dconf driver driver_params sr vdi = let vdi_resize ~dbg dconf driver sr vdi newsize = with_dbg ~dbg ~name:"vdi_resize" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_resize" driver (sprintf "sr=%s vdi=%s newsize=%Ld" (Ref.string_of sr) (Ref.string_of vdi) newsize @@ -300,7 +300,7 @@ let vdi_resize ~dbg dconf driver sr vdi newsize = let vdi_generate_config ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_generate_config" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_generate_config" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -310,7 +310,7 @@ let vdi_generate_config ~dbg dconf driver sr vdi = let vdi_compose ~dbg dconf driver sr vdi1 vdi2 = with_dbg ~dbg ~name:"vdi_compose" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_compose" driver (sprintf "sr=%s vdi1=%s vdi2=%s" (Ref.string_of sr) (Ref.string_of vdi1) (Ref.string_of vdi2) @@ -324,7 +324,7 @@ let vdi_compose ~dbg dconf driver sr vdi1 vdi2 = let vdi_epoch_begin ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_epoch_begin" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_epoch_begin" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -334,7 +334,7 @@ let vdi_epoch_begin ~dbg dconf driver sr vdi = let vdi_epoch_end ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_epoch_end" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_epoch_end" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -344,7 +344,7 @@ let vdi_epoch_end ~dbg dconf driver sr vdi = let vdi_enable_cbt ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_enable_cbt" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_enable_cbt" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -355,7 +355,7 @@ let vdi_enable_cbt ~dbg dconf driver sr vdi = let vdi_disable_cbt ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_disable_cbt" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_disable_cbt" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -366,7 +366,7 @@ let vdi_disable_cbt ~dbg dconf driver sr vdi = let vdi_data_destroy ~dbg dconf driver sr vdi = with_dbg ~dbg ~name:"vdi_data_destroy" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_data_destroy" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -377,7 +377,7 @@ let vdi_data_destroy ~dbg dconf driver sr vdi = let vdi_list_changed_blocks ~dbg dconf driver sr ~vdi_from ~vdi_to = with_dbg ~dbg ~name:"vdi_list_changed_blocks" @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in debug "vdi_list_changed_blocks" driver (sprintf "sr=%s vdi_from=%s vdi_to=%s" (Ref.string_of sr) (Ref.string_of vdi_from) (Ref.string_of vdi_to) @@ -407,17 +407,12 @@ let assert_session_has_internal_sr_access ~__context ~sr = let get_my_pbd_for_sr __context sr_id = let me = Helpers.get_localhost ~__context in let pbd_ref_and_record = + let open Xapi_database.Db_filter_types in Db.PBD.get_records_where ~__context ~expr: - (Db_filter_types.And - ( Db_filter_types.Eq - ( Db_filter_types.Field "host" - , Db_filter_types.Literal (Ref.string_of me) - ) - , Db_filter_types.Eq - ( Db_filter_types.Field "SR" - , Db_filter_types.Literal (Ref.string_of sr_id) - ) + (And + ( Eq (Field "host", Literal (Ref.string_of me)) + , Eq (Field "SR", Literal (Ref.string_of sr_id)) ) ) in diff --git a/ocaml/xapi/sm_exec.ml b/ocaml/xapi/sm_exec.ml index 5b449ae0a07..28cdd11e07b 100644 --- a/ocaml/xapi/sm_exec.ml +++ b/ocaml/xapi/sm_exec.ml @@ -33,7 +33,7 @@ let cmd_name driver = sprintf "%s/%sSR" !Xapi_globs.sm_dir driver let sm_username = "__sm__backend" let with_dbg ~name ~dbg f = - Debuginfo.with_dbg ~module_name:"Sm_exec" ~name ~dbg f + Debug_info.with_dbg ~module_name:"Sm_exec" ~name ~dbg f (*********************************************************************************************) (* Random utility functions *) @@ -345,7 +345,7 @@ let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string) let xml = xmlrpc_of_call call in let name = Printf.sprintf "sm_exec: %s" call.cmd in let xml, stderr = - Stats.time_this name (fun () -> + Xapi_database.Stats.time_this name (fun () -> let exe = cmd_name driver in (* Logging call.cmd is safe, but call.args could contain a password. *) try @@ -579,7 +579,7 @@ let parse_sr_get_driver_info driver (xml : Xml.xml) = let sr_get_driver_info ~dbg driver = with_dbg ~name:"sr_get_driver_info" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let call = make_call (None, []) "sr_get_driver_info" [] in parse_sr_get_driver_info driver (exec_xmlrpc ~dbg ~needs_session:false driver call) @@ -588,7 +588,7 @@ let sr_get_driver_info ~dbg driver = * backend and daemon found. *) let get_supported ~dbg add_fn = with_dbg ~name:"get_supported" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let check_driver entry = if Astring.String.is_suffix ~affix:"SR" entry then let driver = String.sub entry 0 (String.length entry - 2) in diff --git a/ocaml/xapi/startup.ml b/ocaml/xapi/startup.ml index a230fc680db..73b496f327d 100644 --- a/ocaml/xapi/startup.ml +++ b/ocaml/xapi/startup.ml @@ -63,7 +63,7 @@ let run ~__context tasks = List.iter (fun (tsk_name, tsk_flags, tsk_fct) -> (* Wrap the function with a timer *) - let tsk_fct () = Stats.time_this tsk_name tsk_fct in + let tsk_fct () = Xapi_database.Stats.time_this tsk_name tsk_fct in let only_master, only_slave, exnraise, onthread = get_flags_of_list tsk_flags in @@ -105,4 +105,6 @@ let run ~__context tasks = tasks let run ~__context tasks = - Stats.time_this "overall xapi startup" (fun () -> run ~__context tasks) + Xapi_database.Stats.time_this "overall xapi startup" (fun () -> + run ~__context tasks + ) diff --git a/ocaml/xapi/static_vdis.ml b/ocaml/xapi/static_vdis.ml index 5ed45c95e16..049708e9c71 100644 --- a/ocaml/xapi/static_vdis.ml +++ b/ocaml/xapi/static_vdis.ml @@ -18,7 +18,8 @@ module D = Debug.Make (struct let name = "static_vdis" end) open D -include Static_vdis_list (* include the vdi type and the list() function *) +include Xapi_database.Static_vdis_list +(* include the vdi type and the list() function *) (** Generate the static configuration and attach the VDI now *) let permanent_vdi_attach ~__context ~vdi ~reason = diff --git a/ocaml/xapi/storage_migrate.ml b/ocaml/xapi/storage_migrate.ml index fa306e42b61..eff980cfbe6 100644 --- a/ocaml/xapi/storage_migrate.ml +++ b/ocaml/xapi/storage_migrate.ml @@ -654,10 +654,10 @@ let stop ~dbg ~id = raise (Storage_interface.Storage_error (Does_not_exist ("mirror", id))) let dbg_and_tracing_of_task task = - Debuginfo.make + Debug_info.make ~log:(Storage_task.get_dbg task) ~tracing:(Storage_task.tracing task) - |> Debuginfo.to_string + |> Debug_info.to_string let start' ~task ~dbg:_ ~sr ~vdi ~dp ~url ~dest ~verify_dest = debug "Mirror.start sr:%s vdi:%s url:%s dest:%s verify_dest:%B" @@ -1336,8 +1336,8 @@ let copy ~task ~dbg ~sr ~vdi ~dp:_ ~url ~dest ~verify_dest = let with_task_and_thread ~dbg f = let task = - Storage_task.add tasks dbg.Debuginfo.log (fun task -> - Storage_task.set_tracing task dbg.Debuginfo.tracing ; + Storage_task.add tasks dbg.Debug_info.log (fun task -> + Storage_task.set_tracing task dbg.Debug_info.tracing ; try f task with | Storage_error (Backend_error (code, params)) | Api_errors.Server_error (code, params) -> @@ -1360,17 +1360,17 @@ let with_task_and_thread ~dbg f = let start ~dbg ~sr ~vdi ~dp ~url ~dest ~verify_dest = with_task_and_thread ~dbg (fun task -> - start' ~task ~dbg:dbg.Debuginfo.log ~sr ~vdi ~dp ~url ~dest ~verify_dest + start' ~task ~dbg:dbg.Debug_info.log ~sr ~vdi ~dp ~url ~dest ~verify_dest ) let copy ~dbg ~sr ~vdi ~dp ~url ~dest ~verify_dest = with_task_and_thread ~dbg (fun task -> - copy ~task ~dbg:dbg.Debuginfo.log ~sr ~vdi ~dp ~url ~dest ~verify_dest + copy ~task ~dbg:dbg.Debug_info.log ~sr ~vdi ~dp ~url ~dest ~verify_dest ) let copy_into ~dbg ~sr ~vdi ~url ~dest ~dest_vdi ~verify_dest = with_task_and_thread ~dbg (fun task -> - copy_into ~task ~dbg:dbg.Debuginfo.log ~sr ~vdi ~url ~dest ~dest_vdi + copy_into ~task ~dbg:dbg.Debug_info.log ~sr ~vdi ~url ~dest ~dest_vdi ~verify_dest ) diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index 7e85a2ed324..0931b4b0903 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -21,7 +21,7 @@ open D (* Sets the logging context based on `dbg`. Also adds a new tracing span, linked to the parent span from `dbg`, if available. *) let with_dbg ~name ~dbg f = - let open Debuginfo in + let open Debug_info in let di = of_string dbg in Debug.with_thread_associated di.log (fun () -> @@ -189,7 +189,7 @@ module Mux = struct let rpc = of_sr sr end)) in with_dbg ~name:"Query.diagnostics" ~dbg @@ fun di -> - C.Query.diagnostics (Debuginfo.to_string di) + C.Query.diagnostics (Debug_info.to_string di) ) end @@ -247,7 +247,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.DP.destroy2 (Debuginfo.to_string di) dp sr vdi vm allow_leak ; + C.DP.destroy2 (Debug_info.to_string di) dp sr vdi vm allow_leak ; DP_info.delete dp let destroy _context ~dbg ~dp ~allow_leak = @@ -256,7 +256,7 @@ module Mux = struct let open DP_info in match read dp with | Some {sr; vdi; vm; _} -> - destroy2 _context ~dbg:(Debuginfo.to_string di) ~dp ~sr ~vdi ~vm + destroy2 _context ~dbg:(Debug_info.to_string di) ~dp ~sr ~vdi ~vm ~allow_leak | None -> info @@ -305,7 +305,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.create (Debuginfo.to_string di) sr name_label name_description + C.SR.create (Debug_info.to_string di) sr name_label name_description device_config physical_size let attach () ~dbg ~sr ~device_config = @@ -315,7 +315,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.attach (Debuginfo.to_string di) sr device_config + C.SR.attach (Debug_info.to_string di) sr device_config let set_name_label () ~dbg ~sr ~new_name_label = with_dbg ~name:"SR.set_name_label" ~dbg @@ fun di -> @@ -324,7 +324,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.set_name_label (Debuginfo.to_string di) sr new_name_label + C.SR.set_name_label (Debug_info.to_string di) sr new_name_label let set_name_description () ~dbg ~sr ~new_name_description = with_dbg ~name:"SR.set_name_description" ~dbg @@ fun di -> @@ -333,7 +333,8 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.set_name_description (Debuginfo.to_string di) sr new_name_description + C.SR.set_name_description (Debug_info.to_string di) sr + new_name_description let detach () ~dbg ~sr = with_dbg ~name:"SR.detach" ~dbg @@ fun di -> @@ -341,7 +342,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.detach (Debuginfo.to_string di) sr + C.SR.detach (Debug_info.to_string di) sr let destroy () ~dbg ~sr = with_dbg ~name:"SR.destroy" ~dbg @@ fun di -> @@ -349,7 +350,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.destroy (Debuginfo.to_string di) sr + C.SR.destroy (Debug_info.to_string di) sr let stat () ~dbg ~sr = with_dbg ~name:"SR.stat" ~dbg @@ fun di -> @@ -357,7 +358,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.stat (Debuginfo.to_string di) sr + C.SR.stat (Debug_info.to_string di) sr let scan () ~dbg ~sr = with_dbg ~name:"SR.scan" ~dbg @@ fun di -> @@ -365,7 +366,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.scan (Debuginfo.to_string di) sr + C.SR.scan (Debug_info.to_string di) sr module SRSet = Set.Make (struct type t = Storage_interface.Sr.t @@ -389,7 +390,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.list (Debuginfo.to_string di) + C.SR.list (Debug_info.to_string di) ) ) |> SRSet.elements @@ -400,7 +401,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.SR.reset (Debuginfo.to_string di) sr + C.SR.reset (Debug_info.to_string di) sr let update_snapshot_info_src () ~dbg ~sr ~vdi ~url ~dest ~dest_vdi ~snapshot_pairs = @@ -418,8 +419,8 @@ module Mux = struct |> String.concat "; " |> Printf.sprintf "[%s]" ) ; - Storage_migrate.update_snapshot_info_src ~dbg:(Debuginfo.to_string di) ~sr - ~vdi ~url ~dest ~dest_vdi ~snapshot_pairs + Storage_migrate.update_snapshot_info_src ~dbg:(Debug_info.to_string di) + ~sr ~vdi ~url ~dest ~dest_vdi ~snapshot_pairs let update_snapshot_info_dest () ~dbg ~sr ~vdi ~src_vdi ~snapshot_pairs = with_dbg ~name:"SR.update_snapshot_info_dest" ~dbg @@ fun di -> @@ -439,7 +440,7 @@ module Mux = struct |> String.concat "; " |> Printf.sprintf "[%s]" ) ; - C.SR.update_snapshot_info_dest (Debuginfo.to_string di) sr vdi src_vdi + C.SR.update_snapshot_info_dest (Debug_info.to_string di) sr vdi src_vdi snapshot_pairs end @@ -451,7 +452,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.create (Debuginfo.to_string di) sr vdi_info + C.VDI.create (Debug_info.to_string di) sr vdi_info let set_name_label () ~dbg ~sr ~vdi ~new_name_label = with_dbg ~name:"VDI.set_name_label" ~dbg @@ fun di -> @@ -460,7 +461,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.set_name_label (Debuginfo.to_string di) sr vdi new_name_label + C.VDI.set_name_label (Debug_info.to_string di) sr vdi new_name_label let set_name_description () ~dbg ~sr ~vdi ~new_name_description = with_dbg ~name:"VDI.set_name_description" ~dbg @@ fun di -> @@ -470,7 +471,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.set_name_description (Debuginfo.to_string di) sr vdi + C.VDI.set_name_description (Debug_info.to_string di) sr vdi new_name_description let snapshot () ~dbg ~sr ~vdi_info = @@ -480,7 +481,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - try C.VDI.snapshot (Debuginfo.to_string di) sr vdi_info + try C.VDI.snapshot (Debug_info.to_string di) sr vdi_info with Storage_interface.Storage_error (Activated_on_another_host uuid) -> Server_helpers.exec_with_new_task "smapiv2.snapshot.activated" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -500,7 +501,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.clone (Debuginfo.to_string di) sr vdi_info + C.VDI.clone (Debug_info.to_string di) sr vdi_info let resize () ~dbg ~sr ~vdi ~new_size = with_dbg ~name:"VDI.resize" ~dbg @@ fun di -> @@ -509,7 +510,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.resize (Debuginfo.to_string di) sr vdi new_size + C.VDI.resize (Debug_info.to_string di) sr vdi new_size let destroy () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.destroy" ~dbg @@ fun di -> @@ -517,7 +518,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.destroy (Debuginfo.to_string di) sr vdi + C.VDI.destroy (Debug_info.to_string di) sr vdi let stat () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.stat" ~dbg @@ fun di -> @@ -525,7 +526,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.stat (Debuginfo.to_string di) sr vdi + C.VDI.stat (Debug_info.to_string di) sr vdi let introduce () ~dbg ~sr ~uuid ~sm_config ~location = with_dbg ~name:"VDI.introduce" ~dbg @@ fun di -> @@ -536,7 +537,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.introduce (Debuginfo.to_string di) sr uuid sm_config location + C.VDI.introduce (Debug_info.to_string di) sr uuid sm_config location let set_persistent () ~dbg ~sr ~vdi ~persistent = with_dbg ~name:"VDI.set_persistent" ~dbg @@ fun di -> @@ -545,7 +546,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.set_persistent (Debuginfo.to_string di) sr vdi persistent + C.VDI.set_persistent (Debug_info.to_string di) sr vdi persistent let epoch_begin () ~dbg ~sr ~vdi ~vm ~persistent = with_dbg ~name:"VDI.epoch_begin" ~dbg @@ fun di -> @@ -554,7 +555,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.epoch_begin (Debuginfo.to_string di) sr vdi vm persistent + C.VDI.epoch_begin (Debug_info.to_string di) sr vdi vm persistent let attach () ~dbg ~dp ~sr ~vdi ~read_write = with_dbg ~name:"VDI.attach" ~dbg @@ fun di -> @@ -566,7 +567,7 @@ module Mux = struct let vm = Vm.of_string "0" in DP_info.write dp DP_info.{sr; vdi; vm; read_write} ; let backend = - C.VDI.attach3 (Debuginfo.to_string di) dp sr vdi vm read_write + C.VDI.attach3 (Debug_info.to_string di) dp sr vdi vm read_write in (* VDI.attach2 should be used instead, VDI.attach is only kept for backwards-compatibility, because older xapis call Remote.VDI.attach during SXM. @@ -615,17 +616,17 @@ module Mux = struct end)) in let vm = Vm.of_string "0" in DP_info.write dp DP_info.{sr; vdi; vm; read_write} ; - C.VDI.attach3 (Debuginfo.to_string di) dp sr vdi vm read_write + C.VDI.attach3 (Debug_info.to_string di) dp sr vdi vm read_write let attach3 () ~dbg ~dp ~sr ~vdi ~vm ~read_write = with_dbg ~name:"VDI.attach3" ~dbg @@ fun di -> info "VDI.attach3 dbg:%s dp:%s sr:%s vdi:%s vm:%s read_write:%b" - di.Debuginfo.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) read_write ; + di.Debug_info.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) read_write ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in DP_info.write dp DP_info.{sr; vdi; vm; read_write} ; - C.VDI.attach3 (Debuginfo.to_string di) dp sr vdi vm read_write + C.VDI.attach3 (Debug_info.to_string di) dp sr vdi vm read_write let activate () ~dbg ~dp ~sr ~vdi = with_dbg ~name:"VDI.activate" ~dbg @@ fun di -> @@ -634,7 +635,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.activate (Debuginfo.to_string di) dp sr vdi + C.VDI.activate (Debug_info.to_string di) dp sr vdi let activate3 () ~dbg ~dp ~sr ~vdi ~vm = with_dbg ~name:"VDI.activate3" ~dbg @@ fun di -> @@ -654,10 +655,10 @@ module Mux = struct if (not read_write) && sr_has_capability sr Smint.Vdi_activate_readonly then ( info "The VDI was attached read-only: calling activate_readonly" ; - C.VDI.activate_readonly (Debuginfo.to_string di) dp sr vdi vm + C.VDI.activate_readonly (Debug_info.to_string di) dp sr vdi vm ) else ( info "The VDI was attached read/write: calling activate3" ; - C.VDI.activate3 (Debuginfo.to_string di) dp sr vdi vm + C.VDI.activate3 (Debug_info.to_string di) dp sr vdi vm ) let activate_readonly () ~dbg ~dp ~sr ~vdi ~vm = @@ -667,7 +668,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.activate_readonly (Debuginfo.to_string di) dp sr vdi vm + C.VDI.activate_readonly (Debug_info.to_string di) dp sr vdi vm let deactivate () ~dbg ~dp ~sr ~vdi ~vm = with_dbg ~name:"VDI.deativate" ~dbg @@ fun di -> @@ -676,7 +677,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.deactivate (Debuginfo.to_string di) dp sr vdi vm + C.VDI.deactivate (Debug_info.to_string di) dp sr vdi vm let detach () ~dbg ~dp ~sr ~vdi ~vm = with_dbg ~name:"VDI.detach" ~dbg @@ fun di -> @@ -685,7 +686,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.detach (Debuginfo.to_string di) dp sr vdi vm ; + C.VDI.detach (Debug_info.to_string di) dp sr vdi vm ; DP_info.delete dp let epoch_end () ~dbg ~sr ~vdi ~vm = @@ -695,7 +696,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.epoch_end (Debuginfo.to_string di) sr vdi vm + C.VDI.epoch_end (Debug_info.to_string di) sr vdi vm let get_by_name () ~dbg ~sr ~name = with_dbg ~name:"VDI.get_by_name" ~dbg @@ fun di -> @@ -703,7 +704,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.get_by_name (Debuginfo.to_string di) sr name + C.VDI.get_by_name (Debug_info.to_string di) sr name let set_content_id () ~dbg ~sr ~vdi ~content_id = with_dbg ~name:"VDI.set_content_id" ~dbg @@ fun di -> @@ -712,7 +713,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.set_content_id (Debuginfo.to_string di) sr vdi content_id + C.VDI.set_content_id (Debug_info.to_string di) sr vdi content_id let similar_content () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.similar_content" ~dbg @@ fun di -> @@ -721,7 +722,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.similar_content (Debuginfo.to_string di) sr vdi + C.VDI.similar_content (Debug_info.to_string di) sr vdi let compose () ~dbg ~sr ~vdi1 ~vdi2 = with_dbg ~name:"VDI.compose" ~dbg @@ fun di -> @@ -730,7 +731,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.compose (Debuginfo.to_string di) sr vdi1 vdi2 + C.VDI.compose (Debug_info.to_string di) sr vdi1 vdi2 let add_to_sm_config () ~dbg ~sr ~vdi ~key ~value = with_dbg ~name:"VDI.add_to_sm_config" ~dbg @@ fun di -> @@ -739,7 +740,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.add_to_sm_config (Debuginfo.to_string di) sr vdi key value + C.VDI.add_to_sm_config (Debug_info.to_string di) sr vdi key value let remove_from_sm_config () ~dbg ~sr ~vdi ~key = with_dbg ~name:"VDI.remove_from_sm_config" ~dbg @@ fun di -> @@ -748,7 +749,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.remove_from_sm_config (Debuginfo.to_string di) sr vdi key + C.VDI.remove_from_sm_config (Debug_info.to_string di) sr vdi key let get_url () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.get_url" ~dbg @@ fun di -> @@ -756,7 +757,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.get_url (Debuginfo.to_string di) sr vdi + C.VDI.get_url (Debug_info.to_string di) sr vdi let enable_cbt () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.enabled_cbt" ~dbg @@ fun di -> @@ -764,7 +765,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.enable_cbt (Debuginfo.to_string di) sr vdi + C.VDI.enable_cbt (Debug_info.to_string di) sr vdi let disable_cbt () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.disable_cbt" ~dbg @@ fun di -> @@ -772,7 +773,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.disable_cbt (Debuginfo.to_string di) sr vdi + C.VDI.disable_cbt (Debug_info.to_string di) sr vdi let data_destroy () ~dbg ~sr ~vdi = with_dbg ~name:"VDI.data_destroy" ~dbg @@ fun di -> @@ -780,7 +781,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.data_destroy (Debuginfo.to_string di) sr vdi + C.VDI.data_destroy (Debug_info.to_string di) sr vdi let list_changed_blocks () ~dbg ~sr ~vdi_from ~vdi_to = with_dbg ~name:"VDI.list_changed_blocks" ~dbg @@ fun di -> @@ -789,7 +790,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.list_changed_blocks (Debuginfo.to_string di) sr vdi_from vdi_to + C.VDI.list_changed_blocks (Debug_info.to_string di) sr vdi_from vdi_to end let get_by_name () ~dbg ~name = @@ -804,7 +805,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - (sr, C.VDI.get_by_name (Debuginfo.to_string di) sr name) + (sr, C.VDI.get_by_name (Debug_info.to_string di) sr name) | [name] -> ( match success_or choose @@ -812,7 +813,7 @@ module Mux = struct let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - (sr, C.VDI.get_by_name (Debuginfo.to_string di) sr name) + (sr, C.VDI.get_by_name (Debug_info.to_string di) sr name) ) ) with diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index c7bdd772a28..b6abfdcd2c3 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -28,13 +28,13 @@ let s_of_sr = Sr.string_of let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute let with_dbg ~name ~dbg f = - Debuginfo.with_dbg ~module_name:"SMAPIv1" ~name ~dbg f + Debug_info.with_dbg ~module_name:"SMAPIv1" ~name ~dbg f (* Find a VDI given a storage-layer SR and VDI *) let find_vdi ~__context sr vdi = let sr = s_of_sr sr in let vdi = s_of_vdi vdi in - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let sr = Db.SR.get_by_uuid ~__context ~uuid:sr in match Db.VDI.get_records_where ~__context @@ -53,7 +53,7 @@ let find_vdi ~__context sr vdi = (* Find a VDI reference given a name *) let find_content ~__context ?sr name = (* PR-1255: the backend should do this for us *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let expr = Option.fold ~none:True ~some:(fun sr -> @@ -395,7 +395,7 @@ module SMAPIv1 : Server_impl = struct Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> try Sm.sr_scan ~dbg device_config _type sr ; - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let vdis = Db.VDI.get_records_where ~__context ~expr:(Eq (Field "SR", Literal (Ref.string_of sr))) @@ -498,7 +498,7 @@ module SMAPIv1 : Server_impl = struct let epoch_begin _context ~dbg ~sr ~vdi ~vm:_ ~persistent:_ = with_dbg ~name:"VDI.epoch_begin" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try for_vdi ~dbg ~sr ~vdi "VDI.epoch_begin" (fun device_config _type sr self -> @@ -509,7 +509,7 @@ module SMAPIv1 : Server_impl = struct let attach2 _context ~dbg ~dp:_ ~sr ~vdi ~read_write = with_dbg ~name:"VDI.attach2" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try let backend = for_vdi ~dbg ~sr ~vdi "VDI.attach2" @@ -575,7 +575,7 @@ module SMAPIv1 : Server_impl = struct let attach3 context ~dbg ~dp ~sr ~vdi ~vm:_ ~read_write = with_dbg ~name:"VDI.attach3" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in (*Throw away vm argument as does nothing in SMAPIv1*) attach2 context ~dbg ~dp ~sr ~vdi ~read_write @@ -586,7 +586,7 @@ module SMAPIv1 : Server_impl = struct let activate _context ~dbg ~dp ~sr ~vdi = with_dbg ~name:"VDI.activate" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try let read_write = with_lock vdi_read_write_m (fun () -> @@ -616,14 +616,14 @@ module SMAPIv1 : Server_impl = struct let activate3 context ~dbg ~dp ~sr ~vdi ~vm:_ = with_dbg ~name:"VDI.activate3" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in activate context ~dbg ~dp ~sr ~vdi let activate_readonly = activate3 let deactivate _context ~dbg ~dp ~sr ~vdi ~vm:_ = with_dbg ~name:"VDI.deactivate" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try for_vdi ~dbg ~sr ~vdi "VDI.deactivate" (fun device_config _type sr self -> @@ -647,7 +647,7 @@ module SMAPIv1 : Server_impl = struct let detach _context ~dbg ~dp:_ ~sr ~vdi ~vm:_ = with_dbg ~name:"VDI.detach" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try for_vdi ~dbg ~sr ~vdi "VDI.detach" (fun device_config _type sr self -> Sm.vdi_detach ~dbg device_config _type sr self ; @@ -670,7 +670,7 @@ module SMAPIv1 : Server_impl = struct let epoch_end _context ~dbg ~sr ~vdi ~vm:_ = with_dbg ~name:"VDI.epoch_end" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try for_vdi ~dbg ~sr ~vdi "VDI.epoch_end" (fun device_config _type sr self -> @@ -693,7 +693,7 @@ module SMAPIv1 : Server_impl = struct let create _context ~dbg ~sr ~(vdi_info : Storage_interface.vdi_info) = with_dbg ~name:"VDI.create" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task "VDI.create" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -736,7 +736,7 @@ module SMAPIv1 : Server_impl = struct let snapshot_and_clone call_name call_f is_a_snapshot _context ~dbg ~sr ~vdi_info = with_dbg ~name:"VDI.snapshot_and_clone" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task call_name ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -802,7 +802,7 @@ module SMAPIv1 : Server_impl = struct let set_name_label _context ~dbg ~sr ~vdi ~new_name_label = with_dbg ~name:"VDI.set_name_label" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Server_helpers.exec_with_new_task "VDI.set_name_label" ~subtask_of:(Ref.of_string dbg) (fun __context -> let self, _ = find_vdi ~__context sr vdi in @@ -811,7 +811,7 @@ module SMAPIv1 : Server_impl = struct let set_name_description _context ~dbg ~sr ~vdi ~new_name_description = with_dbg ~name:"VDI.set_name_description" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Server_helpers.exec_with_new_task "VDI.set_name_description" ~subtask_of:(Ref.of_string dbg) (fun __context -> let self, _ = find_vdi ~__context sr vdi in @@ -821,7 +821,7 @@ module SMAPIv1 : Server_impl = struct let resize _context ~dbg ~sr ~vdi ~new_size = with_dbg ~name:"VDI.resize" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try let vi = for_vdi ~dbg ~sr ~vdi "VDI.resize" (fun device_config _type sr self -> @@ -846,7 +846,7 @@ module SMAPIv1 : Server_impl = struct let destroy _context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.destroy" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try for_vdi ~dbg ~sr ~vdi "VDI.destroy" (fun device_config _type sr self -> Sm.vdi_delete ~dbg device_config _type sr self @@ -864,7 +864,7 @@ module SMAPIv1 : Server_impl = struct let stat _context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.stat" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task "VDI.stat" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -880,7 +880,7 @@ module SMAPIv1 : Server_impl = struct let introduce _context ~dbg ~sr ~uuid ~sm_config ~location = with_dbg ~name:"VDI.introduce" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task "VDI.introduce" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -900,7 +900,7 @@ module SMAPIv1 : Server_impl = struct let set_persistent _context ~dbg ~sr ~vdi ~persistent = with_dbg ~name:"VDI.set_persistent" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task "VDI.set_persistent" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -930,7 +930,7 @@ module SMAPIv1 : Server_impl = struct let get_by_name _context ~dbg ~sr ~name = with_dbg ~name:"VDI.get_by_name" ~dbg @@ fun di -> info "VDI.get_by_name dbg:%s sr:%s name:%s" di.log (s_of_sr sr) name ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in (* PR-1255: the backend should do this for us *) Server_helpers.exec_with_new_task "VDI.get_by_name" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -949,7 +949,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.set_content_id" ~dbg @@ fun di -> info "VDI.get_by_content dbg:%s sr:%s vdi:%s content_id:%s" di.log (s_of_sr sr) (s_of_vdi vdi) content_id ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in (* PR-1255: the backend should do this for us *) Server_helpers.exec_with_new_task "VDI.set_content_id" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -963,7 +963,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.similar_content" ~dbg @@ fun di -> info "VDI.similar_content dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Server_helpers.exec_with_new_task "VDI.similar_content" ~subtask_of:(Ref.of_string dbg) (fun __context -> (* PR-1255: the backend should do this for us. *) @@ -979,7 +979,7 @@ module SMAPIv1 : Server_impl = struct let compare = compare end) in let _vhdparent = "vhd-parent" in - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let all = Db.VDI.get_records_where ~__context ~expr:(Eq (Field "SR", Literal (Ref.string_of sr_ref))) @@ -1075,7 +1075,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.compose" ~dbg @@ fun di -> info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" di.log (s_of_sr sr) (s_of_vdi vdi1) (s_of_vdi vdi2) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task "VDI.compose" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -1103,7 +1103,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.add_to_sm_config" ~dbg @@ fun di -> info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" di.log (s_of_sr sr) (s_of_vdi vdi) key value ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Server_helpers.exec_with_new_task "VDI.add_to_sm_config" ~subtask_of:(Ref.of_string dbg) (fun __context -> let self = find_vdi ~__context sr vdi |> fst in @@ -1114,7 +1114,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.remove_from_sm_config" ~dbg @@ fun di -> info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" di.log (s_of_sr sr) (s_of_vdi vdi) key ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Server_helpers.exec_with_new_task "VDI.remove_from_sm_config" ~subtask_of:(Ref.of_string dbg) (fun __context -> let self = find_vdi ~__context sr vdi |> fst in @@ -1124,7 +1124,7 @@ module SMAPIv1 : Server_impl = struct let get_url _context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.get_url" ~dbg @@ fun di -> info "VDI.get_url dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in (* XXX: PR-1255: tapdisk shouldn't hardcode xapi urls *) (* peer_ip/session_ref/vdi_ref *) Server_helpers.exec_with_new_task "VDI.get_url" @@ -1145,7 +1145,7 @@ module SMAPIv1 : Server_impl = struct let call_cbt_function _context ~f ~f_name ~dbg ~sr ~vdi = with_dbg ~name:"VDI.call_cbt_function" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try for_vdi ~dbg ~sr ~vdi f_name (fun device_config _type sr self -> f ~dbg device_config _type sr self @@ -1177,7 +1177,7 @@ module SMAPIv1 : Server_impl = struct let list_changed_blocks _context ~dbg ~sr ~vdi_from ~vdi_to = with_dbg ~name:"VDI.list_changed_blocks" ~dbg @@ fun di -> - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in try Server_helpers.exec_with_new_task "VDI.list_changed_blocks" ~subtask_of:(Ref.of_string dbg) (fun __context -> diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index b3d748c7ad0..8fde6ec60bd 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -93,8 +93,8 @@ let indent x = " " ^ x let string_of_date x = Date.to_string (Date.of_float x) let with_dbg ~name ~dbg f = - Debuginfo.with_dbg ~with_thread:true ~module_name:"SMAPIv1-Wrapper" ~name ~dbg - f + Debug_info.with_dbg ~with_thread:true ~module_name:"SMAPIv1-Wrapper" ~name + ~dbg f let rpc_fns keyty valty = let rpc_of hashtbl = @@ -589,7 +589,7 @@ functor with_dbg ~name:"VDI.epoch_begin" ~dbg @@ fun di -> info "VDI.epoch_begin dbg:%s sr:%s vdi:%s vm:%s persistent:%b" di.log (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) persistent ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked (fun () -> @@ -601,7 +601,7 @@ functor with_dbg ~name:"VDI.attach3" ~dbg @@ fun di -> info "VDI.attach3 dbg:%s dp:%s sr:%s vdi:%s vm:%s read_write:%b" di.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) read_write ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked (fun () -> @@ -625,7 +625,7 @@ functor (s_of_sr sr) (s_of_vdi vdi) read_write ; (*Support calls from older XAPI during migrate operation (dom 0 attach )*) let vm = vm_of_s "0" in - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in attach3 context ~dbg ~dp ~sr ~vdi ~vm ~read_write let attach context ~dbg ~dp ~sr ~vdi ~read_write = @@ -633,7 +633,7 @@ functor info "VDI.attach dbg:%s dp:%s sr:%s vdi:%s read_write:%b" di.log dp (s_of_sr sr) (s_of_vdi vdi) read_write ; let vm = vm_of_s "0" in - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let backend = attach3 context ~dbg ~dp ~sr ~vdi ~vm ~read_write in (* VDI.attach2 should be used instead, VDI.attach is only kept for backwards-compatibility, because older xapis call Remote.VDI.attach during SXM. @@ -677,7 +677,7 @@ functor with_dbg ~name:"VDI.activate3" ~dbg @@ fun di -> info "VDI.activate3 dbg:%s dp:%s sr:%s vdi:%s vm:%s" di.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked (fun () -> @@ -696,14 +696,14 @@ functor (s_of_vdi vdi) ; (*Support calls from older XAPI during migrate operation (dom 0 attach )*) let vm = vm_of_s "0" in - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in activate3 context ~dbg ~dp ~sr ~vdi ~vm let deactivate context ~dbg ~dp ~sr ~vdi ~vm = with_dbg ~name:"VDI.deactivate" ~dbg @@ fun di -> info "VDI.deactivate dbg:%s dp:%s sr:%s vdi:%s vm:%s" di.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked (fun () -> @@ -718,7 +718,7 @@ functor with_dbg ~name:"VDI.detach" ~dbg @@ fun di -> info "VDI.detach dbg:%s dp:%s sr:%s vdi:%s vm:%s" di.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked (fun () -> @@ -733,7 +733,7 @@ functor with_dbg ~name:"VDI.epoch_end" ~dbg @@ fun di -> info "VDI.epoch_end dbg:%s sr:%s vdi:%s vm:%s" di.log (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked (fun () -> Impl.VDI.epoch_end context ~dbg ~sr ~vdi ~vm @@ -744,7 +744,7 @@ functor with_dbg ~name:"VDI.create" ~dbg @@ fun di -> info "VDI.create dbg:%s sr:%s vdi_info:%s" di.log (s_of_sr sr) (string_of_vdi_info vdi_info) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in let result = Impl.VDI.create context ~dbg ~sr ~vdi_info in match result with | {virtual_size= virtual_size'; _} @@ -770,7 +770,7 @@ functor with_dbg ~name:call_name ~dbg @@ fun di -> info "%s dbg:%s sr:%s vdi_info:%s" call_name di.log (s_of_sr sr) (string_of_vdi_info vdi_info) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi_info.vdi (fun () -> call_f context ~dbg ~sr ~vdi_info) let snapshot = snapshot_and_clone "VDI.snapshot" Impl.VDI.snapshot @@ -781,7 +781,7 @@ functor with_dbg ~name:"VDI.set_name_label" ~dbg @@ fun di -> info "VDI.set_name_label dbg:%s sr:%s vdi:%s new_name_label:%s" di.log (s_of_sr sr) (s_of_vdi vdi) new_name_label ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> Impl.VDI.set_name_label context ~dbg ~sr ~vdi ~new_name_label ) @@ -791,7 +791,7 @@ functor info "VDI.set_name_description dbg:%s sr:%s vdi:%s new_name_description:%s" di.log (s_of_sr sr) (s_of_vdi vdi) new_name_description ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> Impl.VDI.set_name_description context ~dbg ~sr ~vdi ~new_name_description @@ -801,7 +801,7 @@ functor with_dbg ~name:"VDI.resize" ~dbg @@ fun di -> info "VDI.resize dbg:%s sr:%s vdi:%s new_size:%Ld" di.log (s_of_sr sr) (s_of_vdi vdi) new_size ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> Impl.VDI.resize context ~dbg ~sr ~vdi ~new_size ) @@ -810,7 +810,7 @@ functor with_dbg ~name:call_name ~dbg @@ fun di -> info "%s dbg:%s sr:%s vdi:%s" call_name di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi Vdi.all (fun () -> call_f context ~dbg ~sr ~vdi @@ -825,7 +825,7 @@ functor let stat context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.stat" ~dbg @@ fun di -> info "VDI.stat dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.stat context ~dbg ~sr ~vdi let introduce context ~dbg ~sr ~uuid ~sm_config ~location = @@ -834,14 +834,14 @@ functor di.log (s_of_sr sr) uuid (String.concat ", " (List.map (fun (k, v) -> k ^ ":" ^ v) sm_config)) location ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.introduce context ~dbg ~sr ~uuid ~sm_config ~location let set_persistent context ~dbg ~sr ~vdi ~persistent = with_dbg ~name:"VDI.set_persistent" ~dbg @@ fun di -> info "VDI.set_persistent dbg:%s sr:%s vdi:%s persistent:%b" di.log (s_of_sr sr) (s_of_vdi vdi) persistent ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> Impl.VDI.set_persistent context ~dbg ~sr ~vdi ~persistent ) @@ -849,62 +849,62 @@ functor let get_by_name context ~dbg ~sr ~name = with_dbg ~name:"VDI.get_by_name" ~dbg @@ fun di -> info "VDI.get_by_name dbg:%s sr:%s name:%s" di.log (s_of_sr sr) name ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.get_by_name context ~dbg ~sr ~name let set_content_id context ~dbg ~sr ~vdi ~content_id = with_dbg ~name:"VDI.set_content_id" ~dbg @@ fun di -> info "VDI.set_content_id dbg:%s sr:%s vdi:%s content_id:%s" di.log (s_of_sr sr) (s_of_vdi vdi) content_id ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.set_content_id context ~dbg ~sr ~vdi ~content_id let similar_content context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.similar_content" ~dbg @@ fun di -> info "VDI.similar_content dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.similar_content context ~dbg ~sr ~vdi let compose context ~dbg ~sr ~vdi1 ~vdi2 = with_dbg ~name:"VDI.compose" ~dbg @@ fun di -> info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" di.log (s_of_sr sr) (s_of_vdi vdi1) (s_of_vdi vdi2) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.compose context ~dbg ~sr ~vdi1 ~vdi2 let add_to_sm_config context ~dbg ~sr ~vdi ~key ~value = with_dbg ~name:"VDI.add_to_sm_config" ~dbg @@ fun di -> info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" di.log (s_of_sr sr) (s_of_vdi vdi) key value ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.add_to_sm_config context ~dbg ~sr ~vdi ~key ~value let remove_from_sm_config context ~dbg ~sr ~vdi ~key = with_dbg ~name:"VDI.remove_from_sm_config" ~dbg @@ fun di -> info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" di.log (s_of_sr sr) (s_of_vdi vdi) key ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.remove_from_sm_config context ~dbg ~sr ~vdi ~key let get_url context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.get_url" ~dbg @@ fun di -> info "VDI.get_url dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.VDI.get_url context ~dbg ~sr ~vdi let enable_cbt context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.enabled_cbt" ~dbg @@ fun di -> info "VDI.enable_cbt dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> Impl.VDI.enable_cbt context ~dbg ~sr ~vdi) let disable_cbt context ~dbg ~sr ~vdi = with_dbg ~name:"VDI.disable_cbt" ~dbg @@ fun di -> info "VDI.disable_cbt dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi (fun () -> Impl.VDI.disable_cbt context ~dbg ~sr ~vdi) (** The [sr] parameter is the SR of VDI [vdi_to]. *) @@ -912,7 +912,7 @@ functor with_dbg ~name:"VDI.list_changed_blocks" ~dbg @@ fun di -> info "VDI.list_changed_blocks dbg:%s sr:%s vdi_from:%s vdi_to:%s" di.log (s_of_sr sr) (s_of_vdi vdi_from) (s_of_vdi vdi_to) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_vdi sr vdi_to (fun () -> Impl.VDI.list_changed_blocks context ~dbg ~sr ~vdi_from ~vdi_to ) @@ -921,7 +921,7 @@ functor let get_by_name context ~dbg ~name = with_dbg ~name:"get_by_name" ~dbg @@ fun di -> debug "get_by_name dbg:%s name:%s" di.log name ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.get_by_name context ~dbg ~name module DATA = struct @@ -1107,7 +1107,7 @@ functor with_dbg ~name:"DP.destroy2" ~dbg @@ fun di -> info "DP.destroy2 dbg:%s dp:%s sr:%s vdi:%s vm:%s allow_leak:%b" di.log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) allow_leak ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in destroy' context ~dbg ~dp ~allow_leak let diagnostics _context () = @@ -1183,7 +1183,7 @@ functor let probe context ~dbg ~queue ~device_config ~sm_config = with_dbg ~name:"SR.probe" ~dbg @@ fun di -> info "SR.probe dbg:%s" di.log ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.SR.probe context ~dbg ~queue ~device_config ~sm_config let list _context ~dbg = @@ -1194,7 +1194,7 @@ functor let stat context ~dbg ~sr = with_dbg ~name:"SR.stat" ~dbg @@ fun di -> info "SR.stat dbg:%s sr:%s" di.log (s_of_sr sr) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1206,7 +1206,7 @@ functor let scan context ~dbg ~sr = with_dbg ~name:"SR.scan" ~dbg @@ fun di -> info "SR.scan dbg:%s sr:%s" di.log (s_of_sr sr) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1220,7 +1220,7 @@ functor with_dbg ~name:"SR.create" ~dbg @@ fun di -> info "SR.create dbg:%s sr:%s name_label:%s" di.log (s_of_sr sr) name_label ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1235,14 +1235,14 @@ functor with_dbg ~name:"SR.set_name_label" ~dbg @@ fun di -> info "SR.set_name_label dbg:%s sr:%s new_name_label:%s" di.log (s_of_sr sr) new_name_label ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.SR.set_name_label context ~dbg ~sr ~new_name_label let set_name_description context ~dbg ~sr ~new_name_description = with_dbg ~name:"SR.set_name_description" ~dbg @@ fun di -> info "SR.set_name_description dbg:%s sr:%s new_name_description:%s" di.log (s_of_sr sr) new_name_description ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.SR.set_name_description context ~dbg ~sr ~new_name_description let attach context ~dbg ~sr ~device_config = @@ -1271,7 +1271,7 @@ functor in info "SR.attach dbg:%s sr:%s device_config:[%s]" di.log (s_of_sr sr) device_config_str ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1321,7 +1321,7 @@ functor let detach context ~dbg ~sr = with_dbg ~name:"SR.detach" ~dbg @@ fun di -> info "SR.detach dbg:%s sr:%s" di.log (s_of_sr sr) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in detach_destroy_common context ~dbg ~sr Impl.SR.detach let reset _context ~dbg ~sr = @@ -1336,7 +1336,7 @@ functor let destroy context ~dbg ~sr = with_dbg ~name:"SR.destroy" ~dbg @@ fun di -> info "SR.destroy dbg:%s sr:%s" di.log (s_of_sr sr) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in detach_destroy_common context ~dbg ~sr Impl.SR.destroy let update_snapshot_info_src context ~dbg ~sr ~vdi ~url ~dest ~dest_vdi @@ -1356,7 +1356,7 @@ functor |> String.concat "; " |> Printf.sprintf "[%s]" ) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.SR.update_snapshot_info_src context ~dbg ~sr ~vdi ~url ~dest ~dest_vdi ~snapshot_pairs @@ -1376,7 +1376,7 @@ functor |> String.concat "; " |> Printf.sprintf "[%s]" ) ; - let dbg = Debuginfo.to_string di in + let dbg = Debug_info.to_string di in Impl.SR.update_snapshot_info_dest context ~dbg ~sr ~vdi ~src_vdi ~snapshot_pairs end diff --git a/ocaml/xapi/sync_networking.ml b/ocaml/xapi/sync_networking.ml index fb0d9ed9ec6..6046a14782f 100644 --- a/ocaml/xapi/sync_networking.ml +++ b/ocaml/xapi/sync_networking.ml @@ -13,7 +13,6 @@ *) open Client -open Db_filter_types module D = Debug.Make (struct let name = "sync_networking" end) diff --git a/ocaml/xapi/vhd_tool_wrapper.ml b/ocaml/xapi/vhd_tool_wrapper.ml index 6fe4e40d70d..ee1151febb5 100644 --- a/ocaml/xapi/vhd_tool_wrapper.ml +++ b/ocaml/xapi/vhd_tool_wrapper.ml @@ -117,7 +117,7 @@ let receive progress_cb format protocol (s : Unix.file_descr) the driver domain corresponding to the frontend device [path] in this domain. *) let find_backend_device path = try - let open Xenstore in + let open Ezxenstore_core.Xenstore in (* If we're looking at a xen frontend device, see if the backend is in the same domain. If so check if it looks like a .vhd *) let rdev = (Unix.stat path).Unix.st_rdev in diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml index ac65142e0c6..105fd9db581 100644 --- a/ocaml/xapi/xapi.ml +++ b/ocaml/xapi/xapi.ml @@ -25,7 +25,9 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally open Auth_signature open Extauth -open Db_filter_types +open Xapi_database +open Xapi_database.Db_filter_types +open Xapi_database.Db_cache_types module D = Debug.Make (struct let name = "xapi" end) @@ -62,8 +64,6 @@ let database_ready_for_clients = ref false (* while this is false, client calls will be blocked *) -open Db_cache_types - (** Populate the database from the default connections or the restore db file (if it is present). Perform an initial flush to the database connections which were already setup, then delete the restore file. *) diff --git a/ocaml/xapi/xapi_bond.ml b/ocaml/xapi/xapi_bond.ml index 0a78bef2501..20764394b36 100644 --- a/ocaml/xapi/xapi_bond.ml +++ b/ocaml/xapi/xapi_bond.ml @@ -14,7 +14,7 @@ module D = Debug.Make (struct let name = "xapi_bond" end) open D -open Db_filter_types +open Xapi_database.Db_filter_types (* Returns the name of a new bond device, which is the string "bond" followed * by the smallest integer > 0 that does not yet appear in a bond name on this host. *) diff --git a/ocaml/xapi/xapi_cluster_host.ml b/ocaml/xapi/xapi_cluster_host.ml index f026e782f2e..17c87419bdd 100644 --- a/ocaml/xapi/xapi_cluster_host.ml +++ b/ocaml/xapi/xapi_cluster_host.ml @@ -417,7 +417,7 @@ let sync_required ~__context ~host = None | [(cluster_ref, cluster_rec)] -> ( let expr = - Db_filter_types.( + Xapi_database.Db_filter_types.( And ( Eq (Field "host", Literal (Ref.string_of host)) , Eq (Field "cluster", Literal (Ref.string_of cluster_ref)) diff --git a/ocaml/xapi/xapi_clustering.ml b/ocaml/xapi/xapi_clustering.ml index f9a78fef05f..dca5efdd986 100644 --- a/ocaml/xapi/xapi_clustering.ml +++ b/ocaml/xapi/xapi_clustering.ml @@ -52,7 +52,7 @@ let pif_of_host ~__context (network : API.ref_network) (host : API.ref_host) = let pifs = Db.PIF.get_records_where ~__context ~expr: - Db_filter_types.( + Xapi_database.Db_filter_types.( And ( Eq (Literal (Ref.string_of host), Field "host") , Eq (Literal (Ref.string_of network), Field "network") @@ -118,10 +118,12 @@ let handle_error = function failwith ("Unix Error: " ^ message) let assert_cluster_host_can_be_created ~__context ~host = - match - Db.Cluster_host.get_refs_where ~__context - ~expr:Db_filter_types.(Eq (Literal (Ref.string_of host), Field "host")) - with + let expr = + Xapi_database.Db_filter_types.( + Eq (Literal (Ref.string_of host), Field "host") + ) + in + match Db.Cluster_host.get_refs_where ~__context ~expr with | [] -> () | _ -> @@ -137,10 +139,10 @@ let assert_cluster_host_can_be_created ~__context ~host = [get_required_cluster_stacks context sr_sm_type] should be configured and running for SRs of type [sr_sm_type] to work. *) let get_required_cluster_stacks ~__context ~sr_sm_type = - let sms_matching_sr_type = - Db.SM.get_records_where ~__context - ~expr:Db_filter_types.(Eq (Field "type", Literal sr_sm_type)) + let expr = + Xapi_database.Db_filter_types.(Eq (Field "type", Literal sr_sm_type)) in + let sms_matching_sr_type = Db.SM.get_records_where ~__context ~expr in sms_matching_sr_type |> List.map (fun (_sm_ref, sm_rec) -> sm_rec.API.sM_required_cluster_stack) (* We assume that we only have one SM for each SR type, so this is only to satisfy type checking *) @@ -166,10 +168,12 @@ let with_clustering_lock_if_cluster_exists ~__context where f = with_clustering_lock where f let find_cluster_host ~__context ~host = - match - Db.Cluster_host.get_refs_where ~__context - ~expr:Db_filter_types.(Eq (Field "host", Literal (Ref.string_of host))) - with + let expr = + Xapi_database.Db_filter_types.( + Eq (Field "host", Literal (Ref.string_of host)) + ) + in + match Db.Cluster_host.get_refs_where ~__context ~expr with | [ref] -> Some ref | _ :: _ -> diff --git a/ocaml/xapi/xapi_db_upgrade.ml b/ocaml/xapi/xapi_db_upgrade.ml index 05f20f083e7..b9ecf94ba01 100644 --- a/ocaml/xapi/xapi_db_upgrade.ml +++ b/ocaml/xapi/xapi_db_upgrade.ml @@ -488,7 +488,7 @@ let remove_vmpp = (fun ~__context -> let vmpps = Db.VMPP.get_all ~__context in List.iter (fun self -> Db.VMPP.destroy ~__context ~self) vmpps ; - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let vms = Db.VM.get_refs_where ~__context ~expr: @@ -938,9 +938,10 @@ let rules = (* Maybe upgrade most recent db *) let maybe_upgrade ~__context = let db_ref = Context.database_of __context in + let open Xapi_database in let db = Db_ref.get_database db_ref in let ((previous_major_vsn, previous_minor_vsn) as previous_vsn) = - Db_cache_types.Manifest.schema (Db_cache_types.Database.manifest db) + Db_cache_types.(Manifest.schema (Database.manifest db)) in let ((latest_major_vsn, latest_minor_vsn) as latest_vsn) = (Datamodel_common.schema_major_vsn, Datamodel_common.schema_minor_vsn) diff --git a/ocaml/xapi/xapi_diagnostics.ml b/ocaml/xapi/xapi_diagnostics.ml index 4c709f0d055..c765867a987 100644 --- a/ocaml/xapi/xapi_diagnostics.ml +++ b/ocaml/xapi/xapi_diagnostics.ml @@ -1,11 +1,11 @@ (* Copyright (C) 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 @@ -36,7 +36,7 @@ let gc_stats ~__context ~host:_ = let db_stats ~__context = (* Use Printf.sprintf to keep format *) - let n, avgtime, min, max = Db_lock.report () in + let n, avgtime, min, max = Xapi_database.Db_lock.report () in [ ("n", Printf.sprintf "%d" n) ; ("avgtime", Printf.sprintf "%f" avgtime) diff --git a/ocaml/xapi/xapi_dr.ml b/ocaml/xapi/xapi_dr.ml index bdbb4dee6c2..b2f80481324 100644 --- a/ocaml/xapi/xapi_dr.ml +++ b/ocaml/xapi/xapi_dr.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Db_cache_types +open Xapi_database.Db_cache_types let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute @@ -25,7 +25,8 @@ open D (* Keep track of foreign metadata VDIs and their database generations and pool UUIDs. *) (* The generation count is used to keep track of metadata_latest of all foreign database VDIs. *) (* The pool uuid is cached so that "xe pool-param-get param-name=metadata-of-pool" can be called without opening the database. *) -let db_vdi_cache : (API.ref_VDI, Generation.t * string) Hashtbl.t = +let db_vdi_cache : (API.ref_VDI, Xapi_database.Generation.t * string) Hashtbl.t + = Hashtbl.create 10 let db_vdi_cache_mutex = Mutex.create () @@ -101,7 +102,7 @@ let update_metadata_latest ~__context = vdis_grouped_by_pool let read_database_generation ~db_ref = - let db = Db_ref.get_database db_ref in + let db = Xapi_database.Db_ref.get_database db_ref in let manifest = Database.manifest db in Manifest.generation manifest diff --git a/ocaml/xapi/xapi_event.ml b/ocaml/xapi/xapi_event.ml index 5e10d5590a1..4c6a5eac959 100644 --- a/ocaml/xapi/xapi_event.ml +++ b/ocaml/xapi/xapi_event.ml @@ -338,6 +338,7 @@ module From = struct let calls : (API.ref_session, call list) Hashtbl.t = Hashtbl.create 10 let get_current_event_number () = + let open Xapi_database in Db_cache_types.Manifest.generation (Db_cache_types.Database.manifest (Db_ref.get_database (Db_backend.make ())) @@ -507,6 +508,7 @@ let rec next ~__context = rpc_of_events relevant let from_inner __context session subs from from_t deadline = + let open Xapi_database in let open From in (* The database tables involved in our subscription *) let tables = @@ -730,7 +732,8 @@ let from ~__context ~classes ~token ~timeout = let get_current_id ~__context = with_lock Next.m (fun () -> !Next.id) let inject ~__context ~_class ~_ref = - let open Db_cache_types in + let open Xapi_database in + let open Xapi_database.Db_cache_types in let generation : int64 = Db_lock.with_lock (fun () -> let db_ref = Db_backend.make () in @@ -780,13 +783,13 @@ let event_add ?snapshot ty op reference = From.add ev ; Next.add ev ) -let register_hooks () = Db_action_helper.events_register event_add +let register_hooks () = Xapi_database.Db_action_helper.events_register event_add (* Called whenever a session is being destroyed i.e. by Session.logout and db_gc *) let on_session_deleted session_id = (* Unregister this session if is associated with in imported DB. *) (* FIXME: this doesn't logically belong in the event code *) - Db_backend.unregister_session (Ref.string_of session_id) ; + Xapi_database.Db_backend.unregister_session (Ref.string_of session_id) ; Next.on_session_deleted session_id ; From.on_session_deleted session_id @@ -795,7 +798,7 @@ let on_session_deleted session_id = 2. allow the server to detect when a client has failed *) let heartbeat ~__context = try - Db_lock.with_lock (fun () -> + Xapi_database.Db_lock.with_lock (fun () -> (* We must hold the database lock since we are sending an update for a real object and we don't want to accidentally transmit an older snapshot. *) let pool = try Some (Helpers.get_pool ~__context) with _ -> None in diff --git a/ocaml/xapi/xapi_fuse.ml b/ocaml/xapi/xapi_fuse.ml index bb318848fbd..48d0737a613 100644 --- a/ocaml/xapi/xapi_fuse.ml +++ b/ocaml/xapi/xapi_fuse.ml @@ -55,6 +55,7 @@ let light_fuse_and_run ?(fuse_length = !Constants.fuse_time) () = ignore (Thread.create (fun () -> + let open Xapi_database in Thread.delay new_fuse_length ; debug "light_fuse_and_run: calling flush and exit" ; (* CA-16368: If the database hasn't been initialised *at all* we can exit immediately. @@ -112,6 +113,7 @@ let light_fuse_and_dont_restart ?(fuse_length = !Constants.fuse_time) () = ignore (Thread.create (fun () -> + let open Xapi_database in debug "light_fuse_and_dont_restart: calling Rrdd.backup_rrds to save \ current RRDs locally" ; diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 37e9f561537..f58cb35757b 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -20,6 +20,8 @@ module StringSet = Set.Make (String) module D = Debug.Make (struct let name = "xapi_globs" end) +module Db_globs = Xapi_database.Db_globs + (* set this to true to enable XSM to out-of-pool SRs with matching UUID *) let relax_xsm_sr_check = ref true diff --git a/ocaml/xapi/xapi_ha.ml b/ocaml/xapi/xapi_ha.ml index ee8253e17b6..2295651ed05 100644 --- a/ocaml/xapi/xapi_ha.ml +++ b/ocaml/xapi/xapi_ha.ml @@ -31,8 +31,9 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute open Client -open Db_filter_types +open Xapi_database.Db_filter_types open Xha_scripts +module Redo_log = Xapi_database.Redo_log (* Create a redo_log instance to use for HA. *) let ha_redo_log = @@ -926,7 +927,7 @@ let redo_log_ha_enabled_during_runtime __context = ) else ( info "Switching on HA redo log." ; Redo_log.enable_and_flush - (Context.database_of __context |> Db_ref.get_database) + (Context.database_of __context |> Xapi_database.Db_ref.get_database) ha_redo_log Xapi_globs.ha_metadata_vdi_reason (* upon the first attempt to write a delta, it will realise that a DB flush * is necessary as the I/O process will not be running *) @@ -958,8 +959,9 @@ let redo_log_ha_enabled_at_startup () = debug "This node is a master; attempting to extract a database from a metadata \ VDI" ; - let db_ref = Db_backend.make () in - Redo_log_usage.read_from_redo_log ha_redo_log Db_globs.ha_metadata_db db_ref + let db_ref = Xapi_database.Db_backend.make () in + Redo_log_usage.read_from_redo_log ha_redo_log + Xapi_database.Db_globs.ha_metadata_db db_ref (* best effort only: does not raise any exceptions *) ) @@ -1759,8 +1761,6 @@ let disable __context = raise (Api_errors.Server_error (Api_errors.ha_not_enabled, [])) ; disable_internal __context -open Db_cache_types (* for the Manifest. Database. functions below *) - let enable __context heartbeat_srs configuration = debug "Enabling HA on the Pool." ; let pool = Helpers.get_pool ~__context in @@ -1984,6 +1984,8 @@ let enable __context heartbeat_srs configuration = (* ... *) (* Make sure everyone's got a fresh database *) let generation = + let open Xapi_database in + let open Xapi_database.Db_cache_types in Db_lock.with_lock (fun () -> Manifest.generation (Database.manifest (Db_ref.get_database (Db_backend.make ()))) diff --git a/ocaml/xapi/xapi_ha.mli b/ocaml/xapi/xapi_ha.mli index d6967db9807..ddf583d6cb8 100644 --- a/ocaml/xapi/xapi_ha.mli +++ b/ocaml/xapi/xapi_ha.mli @@ -15,7 +15,7 @@ (** Functions for implementing 'High Availability' (HA). @group High Availability (HA) *) -val ha_redo_log : [`RW] Redo_log.redo_log +val ha_redo_log : [`RW] Xapi_database.Redo_log.redo_log (** The redo log instance used for HA *) (******************************************************************************) diff --git a/ocaml/xapi/xapi_hooks.ml b/ocaml/xapi/xapi_hooks.ml index 7a2e2bd3b7e..abb29dd4f52 100644 --- a/ocaml/xapi/xapi_hooks.ml +++ b/ocaml/xapi/xapi_hooks.ml @@ -128,7 +128,7 @@ let internal_host_dead_hook __context host = info "Running host dead hook for %s" (Ref.string_of host) ; (* reverse lookup host from metrics id; don't have backedge here... *) let forwarded_tasks = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in Db.Task.get_refs_where ~__context ~expr:(Eq (Field "forwarded_to", Literal (Ref.string_of host))) in diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 768f33aba7b..4d5872aa5ca 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -21,7 +21,7 @@ let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute module Unixext = Xapi_stdext_unix.Unixext open Xapi_host_helpers open Xapi_pif_helpers -open Db_filter_types +open Xapi_database.Db_filter_types open Workload_balancing module D = Debug.Make (struct let name = "xapi_host" end) @@ -1196,6 +1196,7 @@ let request_backup ~__context ~host ~generation ~force = if Helpers.get_localhost ~__context <> host then failwith "Forwarded to the wrong host" ; if Pool_role.is_master () then ( + let open Xapi_database in debug "Requesting database backup on master: Using direct sync" ; let connections = Db_conn_store.read_db_connections () in Db_cache_impl.sync connections (Db_ref.get_database (Db_backend.make ())) @@ -1331,7 +1332,8 @@ let get_thread_diagnostics ~__context ~host:_ = let sm_dp_destroy ~__context ~host:_ ~dp ~allow_leak = Storage_access.dp_destroy ~__context dp allow_leak -let get_diagnostic_timing_stats ~__context ~host:_ = Stats.summarise () +let get_diagnostic_timing_stats ~__context ~host:_ = + Xapi_database.Stats.summarise () (* CP-825: Serialize execution of host-enable-extauth and host-disable-extauth *) (* We need to protect against concurrent execution of the extauth-hook script and host.enable/disable extauth, *) @@ -1966,6 +1968,8 @@ let disable_external_auth ~__context ~host ~config = disable_external_auth_common ~during_pool_eject:false ~__context ~host ~config () +module Static_vdis_list = Xapi_database.Static_vdis_list + let attach_static_vdis ~__context ~host:_ ~vdi_reason_map = (* We throw an exception immediately if any of the VDIs in vdi_reason_map is a changed block tracking metadata VDI. *) diff --git a/ocaml/xapi/xapi_host_helpers.ml b/ocaml/xapi/xapi_host_helpers.ml index 00f01d83ed2..dcac8edc5ce 100644 --- a/ocaml/xapi/xapi_host_helpers.ml +++ b/ocaml/xapi/xapi_host_helpers.ml @@ -19,7 +19,7 @@ module D = Debug.Make (struct let name = "xapi_host_helpers" end) open D module Unixext = Xapi_stdext_unix.Unixext -open Db_filter_types +open Xapi_database.Db_filter_types open Record_util (* for host_operation_to_string *) let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute diff --git a/ocaml/xapi/xapi_message.ml b/ocaml/xapi/xapi_message.ml index 2d44962d720..95702a49515 100644 --- a/ocaml/xapi/xapi_message.ml +++ b/ocaml/xapi/xapi_message.ml @@ -331,6 +331,7 @@ let write ~__context ~_ref ~message = gen in let gen = ref 0L in + let open Xapi_database in Db_lock.with_lock (fun () -> let t = Context.database_of __context in Db_ref.update_database t (fun db -> @@ -450,7 +451,8 @@ let create ~__context ~name ~priority ~cls ~obj_uuid ~body = (* Return the message ref, or Ref.null if the message wasn't written *) match gen with Some _ -> _ref | None -> Ref.null -let deleted : (Generation.t * API.ref_message) list ref = ref [(0L, Ref.null)] +let deleted : (Xapi_database.Generation.t * API.ref_message) list ref = + ref [(0L, Ref.null)] let ndeleted = ref 1 @@ -469,6 +471,7 @@ let destroy_real __context basefilename = Unixext.unlink_safe filename ; let rpc = API.rpc_of_message_t message in let gen = ref 0L in + let open Xapi_database in Db_lock.with_lock (fun () -> let t = Context.database_of __context in Db_ref.update_database t (fun db -> diff --git a/ocaml/xapi/xapi_network.ml b/ocaml/xapi/xapi_network.ml index 59686f9fa7d..bb641e980c2 100644 --- a/ocaml/xapi/xapi_network.ml +++ b/ocaml/xapi/xapi_network.ml @@ -327,7 +327,7 @@ let create_new_blob ~__context ~network ~name ~mime_type ~public = let set_default_locking_mode ~__context ~network ~value = (* Get all VIFs which are attached and associated with this network. *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in match Db.VIF.get_records_where ~__context ~expr: diff --git a/ocaml/xapi/xapi_network_attach_helpers.ml b/ocaml/xapi/xapi_network_attach_helpers.ml index b28013d5892..4a3f64b3c38 100644 --- a/ocaml/xapi/xapi_network_attach_helpers.ml +++ b/ocaml/xapi/xapi_network_attach_helpers.ml @@ -15,7 +15,7 @@ module D = Debug.Make (struct let name = "xapi_network_attach_helpers" end) open D -open Db_filter_types +open Xapi_database.Db_filter_types let assert_network_has_no_vifs_in_use_on_me ~__context ~host ~network = (* Check if there are any active VIFs on VMs resident on me *) diff --git a/ocaml/xapi/xapi_network_sriov_helpers.ml b/ocaml/xapi/xapi_network_sriov_helpers.ml index 1e14ff277c1..952a7c35270 100644 --- a/ocaml/xapi/xapi_network_sriov_helpers.ml +++ b/ocaml/xapi/xapi_network_sriov_helpers.ml @@ -13,7 +13,7 @@ *) open Network -open Db_filter_types +open Xapi_database.Db_filter_types open Xapi_stdext_std module D = Debug.Make (struct let name = "xapi_network_sriov" end) diff --git a/ocaml/xapi/xapi_pbd.ml b/ocaml/xapi/xapi_pbd.ml index 552bd6ad5a7..4b6b5c22711 100644 --- a/ocaml/xapi/xapi_pbd.ml +++ b/ocaml/xapi/xapi_pbd.ml @@ -15,7 +15,7 @@ * @group XenAPI functions *) -open Db_filter_types +open Xapi_database.Db_filter_types module D = Debug.Make (struct let name = "xapi_pbd" end) @@ -292,11 +292,10 @@ let get_locally_attached ~__context = let host = Helpers.get_localhost ~__context in Db.PBD.get_refs_where ~__context ~expr: - Db_filter_types.( - And - ( Eq (Field "host", Literal (Ref.string_of host)) - , Eq (Field "currently_attached", Literal "true") - ) + (And + ( Eq (Field "host", Literal (Ref.string_of host)) + , Eq (Field "currently_attached", Literal "true") + ) ) (* Host calls unplug_all_pbds on shutdown, diff --git a/ocaml/xapi/xapi_pci.ml b/ocaml/xapi/xapi_pci.ml index 6da3c4e220e..1ff5620cf58 100644 --- a/ocaml/xapi/xapi_pci.ml +++ b/ocaml/xapi/xapi_pci.ml @@ -63,7 +63,9 @@ let create ~__context ~class_id ~class_name ~vendor_id ~vendor_name ~device_id let get_local ~__context getter = let localhost = Helpers.get_localhost ~__context in let expr = - Db_filter_types.(Eq (Field "host", Literal (Ref.string_of localhost))) + Xapi_database.Db_filter_types.( + Eq (Field "host", Literal (Ref.string_of localhost)) + ) in getter ~__context ~expr diff --git a/ocaml/xapi/xapi_pgpu_helpers.ml b/ocaml/xapi/xapi_pgpu_helpers.ml index efe79d5296d..dc49ec33a83 100644 --- a/ocaml/xapi/xapi_pgpu_helpers.ml +++ b/ocaml/xapi/xapi_pgpu_helpers.ml @@ -40,7 +40,7 @@ let assert_VGPU_type_enabled ~__context ~self ~vgpu_type = ) let get_scheduled_VGPUs ~__context ~self = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in Db.VGPU.get_refs_where ~__context ~expr: (Eq (Field "scheduled_to_be_resident_on", Literal (Ref.string_of self))) @@ -85,7 +85,7 @@ let assert_VGPU_type_allowed ~__context ~self ~vgpu_type = ) let assert_no_resident_VGPUs_of_type ~__context ~self ~vgpu_type = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in match Db.VGPU.get_records_where ~__context ~expr: diff --git a/ocaml/xapi/xapi_pif.ml b/ocaml/xapi/xapi_pif.ml index e1cb02c60f0..f7bbd19ae19 100644 --- a/ocaml/xapi/xapi_pif.ml +++ b/ocaml/xapi/xapi_pif.ml @@ -17,7 +17,7 @@ open D module L = Debug.Make (struct let name = "license" end) -open Db_filter_types +open Xapi_database.Db_filter_types module Listext = Xapi_stdext_std.Listext.List open Xapi_stdext_std.Xstringext module Date = Xapi_stdext_date.Date @@ -27,12 +27,10 @@ let get_device_pci ~__context ~host ~device = let dbg = Context.string_of_task __context in let pci_bus_path = Net.Interface.get_pci_bus_path dbg device in let expr = - Db_filter_types.( - And - ( Eq (Field "pci_id", Literal pci_bus_path) - , Eq (Field "host", Literal (Ref.string_of host)) - ) - ) + And + ( Eq (Field "pci_id", Literal pci_bus_path) + , Eq (Field "host", Literal (Ref.string_of host)) + ) in match Db.PCI.get_refs_where ~__context ~expr with | pci :: _ -> @@ -515,9 +513,7 @@ let introduce_internal ?network ?(physical = true) ~t:_ ~__context ~host ~mAC (* Assertion passes if PIF has clusters attached but host has disabled clustering *) let assert_no_clustering_enabled_on ~__context ~self = - let cluster_host_on_pif = - Db_filter_types.(Eq (Field "PIF", Literal (Ref.string_of self))) - in + let cluster_host_on_pif = Eq (Field "PIF", Literal (Ref.string_of self)) in match Db.Cluster_host.get_refs_where ~__context ~expr:cluster_host_on_pif with | [] -> () diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index f4736a1a61f..acb7bdfa7e9 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -1719,6 +1719,7 @@ let unplug_pbds ~__context host = (* This means eject me, since will have been forwarded from master *) let eject_self ~__context ~host = + let open Xapi_database in (* If HA is enabled then refuse *) let pool = Helpers.get_pool ~__context in if Db.Pool.get_ha_enabled ~__context ~self:pool then @@ -1998,7 +1999,7 @@ let eject ~__context ~host = (* Prohibit parallel flushes since they're so expensive *) let sync_m = Mutex.create () -open Db_cache_types +open Xapi_database.Db_cache_types let sync_database ~__context = with_lock sync_m (fun () -> @@ -2006,7 +2007,7 @@ let sync_database ~__context = let pool = Helpers.get_pool ~__context in let flushed_to_vdi = Db.Pool.get_ha_enabled ~__context ~self:pool - && Db_lock.with_lock (fun () -> + && Xapi_database.Db_lock.with_lock (fun () -> Xha_metadata_vdi.flush_database ~__context Xapi_ha.ha_redo_log ) in @@ -2015,10 +2016,12 @@ let sync_database ~__context = else ( debug "flushing database to all online nodes" ; let generation = - Db_lock.with_lock (fun () -> + Xapi_database.Db_lock.with_lock (fun () -> Manifest.generation (Database.manifest - (Db_ref.get_database (Context.database_of __context)) + (Xapi_database.Db_ref.get_database + (Context.database_of __context) + ) ) ) in @@ -2133,7 +2136,7 @@ let is_slave ~__context ~host:_ = debug "About to kick the database connection to make sure it's still working..." ; let (_ : bool) = - Scheduler.PipeDelay.signal Master_connection.delay ; + Scheduler.PipeDelay.signal Xapi_database.Master_connection.delay ; Db.is_valid_ref __context (Ref.of_string "Pool.is_slave checking to see if the database connection is up" @@ -2861,6 +2864,8 @@ let detect_nonhomogeneous_external_auth () = let detect_nonhomogeneous_external_auth ~__context ~pool:_ = detect_nonhomogeneous_external_auth () +module Redo_log = Xapi_database.Redo_log + let create_redo_log_vdi ~__context ~sr = Helpers.call_api_functions ~__context (fun rpc session_id -> Client.VDI.create ~rpc ~session_id ~name_label:"Metadata redo-log" @@ -2936,7 +2941,7 @@ let enable_redo_log ~__context ~sr = * is already in use) *) if not (Db.Pool.get_ha_enabled ~__context ~self:pool) then ( Redo_log.enable_and_flush - (Context.database_of __context |> Db_ref.get_database) + (Context.database_of __context |> Xapi_database.Db_ref.get_database) Xapi_ha.ha_redo_log Xapi_globs.gen_metadata_vdi_reason ; Localdb.put Constants.redo_log_enabled "true" ) ; diff --git a/ocaml/xapi/xapi_pool_patch.ml b/ocaml/xapi/xapi_pool_patch.ml index 433cc1e92ac..5988a1abc7c 100644 --- a/ocaml/xapi/xapi_pool_patch.ml +++ b/ocaml/xapi/xapi_pool_patch.ml @@ -35,7 +35,7 @@ let pool_patch_of_update ~__context update_ref = match Db.Pool_patch.get_refs_where ~__context ~expr: - Db_filter_types.( + Xapi_database.Db_filter_types.( Eq (Field "pool_update", Literal (Ref.string_of update_ref)) ) with @@ -124,7 +124,7 @@ let pool_patch_upload_handler (req : Http.Request.t) s _ = returns [Some (ref, false)] if it's on the host but isn't applied yet or the application is in progress. *) let get_patch_applied_to ~__context ~patch ~host = let expr = - Db_filter_types.( + Xapi_database.Db_filter_types.( And ( Eq (Field "pool_patch", Literal (Ref.string_of patch)) , Eq (Field "host", Literal (Ref.string_of host)) diff --git a/ocaml/xapi/xapi_pool_transition.ml b/ocaml/xapi/xapi_pool_transition.ml index a8f00deaa26..6ff8f892bd9 100644 --- a/ocaml/xapi/xapi_pool_transition.ml +++ b/ocaml/xapi/xapi_pool_transition.ml @@ -85,6 +85,7 @@ let become_master () = This code runs on the new master. *) let attempt_two_phase_commit_of_new_master ~__context (manual : bool) (peer_addresses : string list) (my_address : string) = + let open Xapi_database in debug "attempting %s two-phase commit of new master. My address = %s; peer \ addresses = [ %s ]" diff --git a/ocaml/xapi/xapi_psr.ml b/ocaml/xapi/xapi_psr.ml index adc9b7ec7f1..aa2481b3eca 100644 --- a/ocaml/xapi/xapi_psr.ml +++ b/ocaml/xapi/xapi_psr.ml @@ -461,8 +461,10 @@ let notify_send ~__context ~old_ps ~new_ps = ) in Xapi_globs.pool_secrets := [priority_2_ps; priority_1_ps] ; - Db_globs.pool_secret := - priority_2_ps |> SecretString.rpc_of_t |> Db_secret_string.t_of_rpc + Xapi_database.Db_globs.pool_secret := + priority_2_ps + |> SecretString.rpc_of_t + |> Xapi_database.Db_secret_string.t_of_rpc | [priority_1_ps; priority_2_ps] when SecretString.(equal priority_1_ps new_ps && equal priority_2_ps old_ps) -> diff --git a/ocaml/xapi/xapi_pusb.ml b/ocaml/xapi/xapi_pusb.ml index da34329cc4f..e1bf3e82acb 100644 --- a/ocaml/xapi/xapi_pusb.ml +++ b/ocaml/xapi/xapi_pusb.ml @@ -218,7 +218,7 @@ let set_passthrough_enabled ~__context ~self ~value = we want to re-display the vdi records. But in udevSR.py we will handle this, as if passthrough_enabled = true, we will not re-introduce the vdi. *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in Db.SR.get_refs_where ~__context ~expr:(Eq (Field "type", Literal "udev")) |> List.iter (fun sr -> diff --git a/ocaml/xapi/xapi_pvs_proxy.ml b/ocaml/xapi/xapi_pvs_proxy.ml index 71334c0d545..136daeef4be 100644 --- a/ocaml/xapi/xapi_pvs_proxy.ml +++ b/ocaml/xapi/xapi_pvs_proxy.ml @@ -21,7 +21,9 @@ open D let create ~__context ~site ~vIF = Pool_features.assert_enabled ~__context ~f:Features.PVS_proxy ; Helpers.assert_using_vswitch ~__context ; - let expr = Db_filter_types.(Eq (Field "VIF", Literal (Ref.string_of vIF))) in + let expr = + Xapi_database.Db_filter_types.(Eq (Field "VIF", Literal (Ref.string_of vIF))) + in let proxies = Db.PVS_proxy.get_refs_where ~__context ~expr in if List.length proxies > 0 then raise diff --git a/ocaml/xapi/xapi_session.ml b/ocaml/xapi/xapi_session.ml index 221498d6f1b..4df3a365a2a 100644 --- a/ocaml/xapi/xapi_session.ml +++ b/ocaml/xapi/xapi_session.ml @@ -431,7 +431,7 @@ let revalidate_external_session ~__context ~session = if not (Db.Session.get_is_local_superuser ~__context ~self:session - || Db_backend.is_session_registered (Ref.string_of session) + || Xapi_database.Db_backend.is_session_registered (Ref.string_of session) ) then ( (* 1. is the external authentication disabled in the pool? *) @@ -653,7 +653,8 @@ let login_no_password_common ~__context ~uname ~originator ~host ~pool Ref.of_string ( match db_ref with | Some db_ref -> - Db_backend.create_registered_session create_session db_ref + Xapi_database.Db_backend.create_registered_session create_session + db_ref | None -> create_session () ) @@ -1347,8 +1348,8 @@ let create_readonly_session ~__context ~uname ~db_ref = (* Create a database reference from a DB dump, and register it with a new readonly session. *) let create_from_db_file ~__context ~filename = let db = - Db_xml.From.file (Datamodel_schema.of_datamodel ()) filename - |> Db_upgrade.generic_database_upgrade + Xapi_database.Db_xml.From.file (Datamodel_schema.of_datamodel ()) filename + |> Xapi_database.Db_upgrade.generic_database_upgrade in - let db_ref = Some (Db_ref.in_memory (ref (ref db))) in + let db_ref = Some (Xapi_database.Db_ref.in_memory (ref (ref db))) in create_readonly_session ~__context ~uname:"db-from-file" ~db_ref diff --git a/ocaml/xapi/xapi_session.mli b/ocaml/xapi/xapi_session.mli index 422afd46cc3..2dc98429f3e 100644 --- a/ocaml/xapi/xapi_session.mli +++ b/ocaml/xapi/xapi_session.mli @@ -78,7 +78,7 @@ val get_top : __context:Context.t -> self:API.ref_session -> API.ref_session val create_readonly_session : __context:Context.t -> uname:string - -> db_ref:Db_ref.t option + -> db_ref:Xapi_database.Db_ref.t option -> API.ref_session val create_from_db_file : diff --git a/ocaml/xapi/xapi_sr.ml b/ocaml/xapi/xapi_sr.ml index 0508f5384c5..f692f524050 100644 --- a/ocaml/xapi/xapi_sr.ml +++ b/ocaml/xapi/xapi_sr.ml @@ -25,7 +25,8 @@ module Unixext = Xapi_stdext_unix.Unixext let finally = Xapi_stdext_pervasives.Pervasiveext.finally -open Db_filter_types +module Redo_log = Xapi_database.Redo_log +open Xapi_database.Db_filter_types open API open Client @@ -461,7 +462,6 @@ let assert_sr_not_local_cache ~__context ~sr = () let find_or_create_rrd_vdi ~__context ~sr = - let open Db_filter_types in match Db.VDI.get_refs_where ~__context ~expr: diff --git a/ocaml/xapi/xapi_sr_operations.ml b/ocaml/xapi/xapi_sr_operations.ml index 8f7a7d8012a..5d4cc834750 100644 --- a/ocaml/xapi/xapi_sr_operations.ml +++ b/ocaml/xapi/xapi_sr_operations.ml @@ -15,7 +15,7 @@ * @group XenAPI functions *) -open Db_filter_types +open Xapi_database.Db_filter_types open API open Client @@ -70,7 +70,6 @@ let sm_cap_table : (API.storage_operations * _) list = type table = (API.storage_operations, (string * string list) option) Hashtbl.t let features_of_sr_internal ~__context ~_type = - let open Db_filter_types in match Db.SM.get_internal_records_where ~__context ~expr:(Eq (Field "type", Literal _type)) diff --git a/ocaml/xapi/xapi_subject.ml b/ocaml/xapi/xapi_subject.ml index f5939b5b5bd..5c1cdd69a5d 100644 --- a/ocaml/xapi/xapi_subject.ml +++ b/ocaml/xapi/xapi_subject.ml @@ -245,14 +245,10 @@ let remove_from_roles ~__context ~self ~role = ) let query_subject_information_from_db ~__context identifier = + let open Xapi_database.Db_filter_types in match Db.Subject.get_records_where ~__context - ~expr: - (Db_filter_types.Eq - ( Db_filter_types.Field "subject_identifier" - , Db_filter_types.Literal identifier - ) - ) + ~expr:(Eq (Field "subject_identifier", Literal identifier)) with | [] -> raise Auth_signature.Subject_cannot_be_resolved diff --git a/ocaml/xapi/xapi_tunnel.ml b/ocaml/xapi/xapi_tunnel.ml index affd5583a2b..1fb8a83b097 100644 --- a/ocaml/xapi/xapi_tunnel.ml +++ b/ocaml/xapi/xapi_tunnel.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Db_filter_types +open Xapi_database.Db_filter_types let choose_tunnel_device_name ~__context ~host = (* list all the tunnel access PIFs on this host *) diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index bc7bafb23d0..6a2fa244c84 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -104,7 +104,7 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) let sr_type = Db.SR.get_type ~__context ~self:sr in let is_tools_sr = Db.SR.get_is_tools_sr ~__context ~self:sr in (* Check to see if any PBDs are attached *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let pbds_attached = match pbd_records with | [] -> @@ -560,7 +560,7 @@ let cancel_tasks ~__context ~self ~all_tasks_in_db ~task_ids = (* This function updates xapi's database for a single VDI. The row will be created if it doesn't exist *) let update_vdi_db ~__context ~sr newvdi = - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let expr = And ( Eq @@ -1031,7 +1031,7 @@ let destroy_and_data_destroy_common ~__context ~self ) vbds ; (* If VDI destroyed is suspend VDI of VM then set the suspend_VDI field as null ref *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in Db.VM.get_refs_where ~__context ~expr:(Eq (Field "suspend_VDI", Literal (Ref.string_of self))) |> List.iter (fun self -> @@ -1441,7 +1441,7 @@ let _get_nbd_info ~__context ~self ~get_server_certificate = let hosts_with_attached_pbds = Db.PBD.get_refs_where ~__context ~expr: - Db_filter_types.( + Xapi_database.Db_filter_types.( And ( Eq (Field "SR", Literal (Ref.string_of sr)) , Eq (Field "currently_attached", Literal "true") @@ -1469,7 +1469,7 @@ let _get_nbd_info ~__context ~self ~get_server_certificate = let attached_pifs = Db.PIF.get_refs_where ~__context ~expr: - Db_filter_types.( + Xapi_database.Db_filter_types.( And ( Eq (Field "host", Literal (Ref.string_of host)) , Eq (Field "currently_attached", Literal "true") diff --git a/ocaml/xapi/xapi_vdi_helpers.ml b/ocaml/xapi/xapi_vdi_helpers.ml index 6b4366a80ce..0fe39c68c26 100644 --- a/ocaml/xapi/xapi_vdi_helpers.ml +++ b/ocaml/xapi/xapi_vdi_helpers.ml @@ -16,7 +16,8 @@ *) open Client -open Db_cache_types +open Xapi_database.Db_cache_types +module Redo_log = Xapi_database.Redo_log let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute @@ -125,7 +126,7 @@ let enable_database_replication ~__context ~get_vdi_callback = let device = Db.VBD.get_device ~__context ~self:vbd in try Redo_log.enable_block_and_flush - (Context.database_of __context |> Db_ref.get_database) + (Context.database_of __context |> Xapi_database.Db_ref.get_database) log ("/dev/" ^ device) ; Hashtbl.add metadata_replication vdi (vbd, log) ; let vbd_uuid = Db.VBD.get_uuid ~__context ~self:vbd in @@ -183,18 +184,20 @@ let database_ref_of_vdi ~__context ~vdi = debug "Enabling redo_log with device reason [%s]" device ; Redo_log.enable_block_existing log device ; let db = Database.make (Datamodel_schema.of_datamodel ()) in - let db_ref = Db_ref.in_memory (ref (ref db)) in + let db_ref = Xapi_database.Db_ref.in_memory (ref (ref db)) in Redo_log_usage.read_from_redo_log log Xapi_globs.foreign_metadata_db db_ref ; Redo_log.delete log ; (* Upgrade database to the local schema. *) (* Reindex database to make sure is_valid_ref works. *) let ( ++ ) f g x = f (g x) in - Db_ref.update_database db_ref - (Db_upgrade.generic_database_upgrade - ++ Database.reindex - ++ Db_backend.blow_away_non_persistent_fields - (Datamodel_schema.of_datamodel ()) - ) ; + Xapi_database.( + Db_ref.update_database db_ref + (Db_upgrade.generic_database_upgrade + ++ Database.reindex + ++ Db_backend.blow_away_non_persistent_fields + (Datamodel_schema.of_datamodel ()) + ) + ) ; db_ref in with_lock database_open_mutex (fun () -> diff --git a/ocaml/xapi/xapi_vgpu_type.ml b/ocaml/xapi/xapi_vgpu_type.ml index 24a7ae29762..9656aa8f959 100644 --- a/ocaml/xapi/xapi_vgpu_type.ml +++ b/ocaml/xapi/xapi_vgpu_type.ml @@ -162,7 +162,7 @@ let find_and_update ~__context vgpu_type = let fail () = failwith "Error: Multiple vGPU types exist with the same configuration." in - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let new_expr = Eq (Field "identifier", Literal identifier_string) in let old_expr = And @@ -1041,7 +1041,7 @@ module Nvidia_compat = struct let create_compat_config_file __context = try - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let host_driver_version = Vendor_nvidia.get_host_driver_version () in let host_driver_supports_multiple = Vendor_nvidia.host_driver_supports_multi_vgpu ~host_driver_version diff --git a/ocaml/xapi/xapi_vif_helpers.ml b/ocaml/xapi/xapi_vif_helpers.ml index 5144ef7ef7a..751f987a6da 100644 --- a/ocaml/xapi/xapi_vif_helpers.ml +++ b/ocaml/xapi/xapi_vif_helpers.ml @@ -366,10 +366,10 @@ let copy ~__context ~vm ~preserve_mac_address vif = ~ipv6_addresses:all.API.vIF_ipv6_addresses ~ipv6_gateway:all.API.vIF_ipv6_gateway in - let proxies = - Db.PVS_proxy.get_records_where ~__context - ~expr:Db_filter_types.(Eq (Field "VIF", Literal (Ref.string_of vif))) + let expr = + Xapi_database.Db_filter_types.(Eq (Field "VIF", Literal (Ref.string_of vif))) in + let proxies = Db.PVS_proxy.get_records_where ~__context ~expr in List.iter (fun (_, proxy) -> try diff --git a/ocaml/xapi/xapi_vlan.ml b/ocaml/xapi/xapi_vlan.ml index 4038cf83793..2e2b13191cf 100644 --- a/ocaml/xapi/xapi_vlan.ml +++ b/ocaml/xapi/xapi_vlan.ml @@ -91,17 +91,12 @@ let create ~__context ~tagged_PIF ~tag ~network = ) ; let device = pif_rec.API.pIF_device in let vlans = + let open Xapi_database.Db_filter_types in Db.VLAN.get_records_where ~__context ~expr: - (Db_filter_types.And - ( Db_filter_types.Eq - ( Db_filter_types.Field "tagged_PIF" - , Db_filter_types.Literal (Ref.string_of tagged_PIF) - ) - , Db_filter_types.Eq - ( Db_filter_types.Field "tag" - , Db_filter_types.Literal (Int64.to_string tag) - ) + (And + ( Eq (Field "tagged_PIF", Literal (Ref.string_of tagged_PIF)) + , Eq (Field "tag", Literal (Int64.to_string tag)) ) ) in diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index ea1cd6e36fa..425de03a5a2 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -1972,7 +1972,7 @@ let vdi_pool_migrate ~__context ~vdi ~sr ~options = let management_if = Xapi_inventory.lookup Xapi_inventory._management_interface in - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let networks = Db.Network.get_records_where ~__context ~expr:(Eq (Field "bridge", Literal management_if)) diff --git a/ocaml/xapi/xapi_vm_placement.ml b/ocaml/xapi/xapi_vm_placement.ml index 90b1b9806a1..ec8c184595b 100644 --- a/ocaml/xapi/xapi_vm_placement.ml +++ b/ocaml/xapi/xapi_vm_placement.ml @@ -15,7 +15,7 @@ * @group Virtual-Machine Management *) -open Db_filter_types +open Xapi_database.Db_filter_types open Vm_placement (* === Snapshot constructors ================================================ *) diff --git a/ocaml/xapi/xapi_vm_snapshot.ml b/ocaml/xapi/xapi_vm_snapshot.ml index 7ac67ddba58..747fd68deb3 100644 --- a/ocaml/xapi/xapi_vm_snapshot.ml +++ b/ocaml/xapi/xapi_vm_snapshot.ml @@ -20,6 +20,7 @@ module Listext = Xapi_stdext_std.Listext.List module D = Debug.Make (struct let name = "xapi_vm_snapshot" end) +module Xs = Ezxenstore_core.Xenstore open D (*************************************************************************************************) @@ -39,21 +40,20 @@ let snapshot ~__context ~vm ~new_name ~ignore_vdis = (* Quiesced snapshot *) (*************************************************************************************************) (* xenstore paths *) -let control_path ~xs ~domid x = - xs.Xenstore.Xs.getdomainpath domid ^ "/control/" ^ x +let control_path ~xs ~domid x = xs.Xs.getdomainpath domid ^ "/control/" ^ x let snapshot_path ~xs ~domid x = - xs.Xenstore.Xs.getdomainpath domid ^ "/control/snapshot/" ^ x + xs.Xs.getdomainpath domid ^ "/control/snapshot/" ^ x let snapshot_cleanup_path ~xs ~domid = - xs.Xenstore.Xs.getdomainpath domid ^ "/control/snapshot" + xs.Xs.getdomainpath domid ^ "/control/snapshot" (* check if [flag] is set in the control_path of the VM [vm]. This looks like this code is a kind *) (* of duplicate of the one in {!xal.ml}, {!events.ml} and {!xapi_guest_agent.ml} which are looking *) (* dynamically if there is a change in this part of the VM's xenstore tree. However, at the moment *) (* always allowing the operation and checking if it is enabled when it is triggered is sufficient. *) let is_flag_set ~xs ~flag ~domid ~vm = - try xs.Xenstore.Xs.read (control_path ~xs ~domid flag) = "1" + try xs.Xs.read (control_path ~xs ~domid flag) = "1" with e -> debug "Exception while reading %s flag of VM %s (domain %i): %s" flag (Ref.string_of vm) domid (Printexc.to_string e) ; @@ -167,7 +167,9 @@ let copy_vm_fields ~__context ~metadata ~dst ~do_not_copy ~overrides = ) ; debug "copying metadata into %s" (Ref.string_of dst) ; let db = Context.database_of __context in - let module DB = (val Db_cache.get db : Db_interface.DB_ACCESS) in + let module DB = + (val Xapi_database.Db_cache.get db : Xapi_database.Db_interface.DB_ACCESS) + in List.iter (fun (key, value) -> let value = Option.value ~default:value (List.assoc_opt key overrides) in @@ -267,7 +269,7 @@ let update_vifs_vbds_vgpus_and_vusbs ~__context ~snapshot ~vm = 2) Find all snapshots with the same snapshot_of 3) Update each of these snapshots so that their snapshot_of points to the new cloned disk. *) - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let snapshot_of = Db.VDI.get_snapshot_of ~__context ~self:snap_disk in let all_snaps_in_tree = Db.VDI.get_refs_where ~__context @@ -541,13 +543,12 @@ let create_vm_from_snapshot ~__context ~snapshot = let old_vm = Db.VM.get_snapshot_of ~__context ~self:snapshot in try let snapshots = - Db.VM.get_records_where ~__context - ~expr: - (Db_filter_types.Eq - ( Db_filter_types.Field "snapshot_of" - , Db_filter_types.Literal (Ref.string_of old_vm) - ) - ) + let expr = + Xapi_database.Db_filter_types.( + Eq (Field "snapshot_of", Literal (Ref.string_of old_vm)) + ) + in + Db.VM.get_records_where ~__context ~expr in let snap_metadata = Db.VM.get_snapshot_metadata ~__context ~self:snapshot in let snap_metadata = Helpers.vm_string_to_assoc snap_metadata in diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index ac92853d104..23801ba7ba5 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -119,7 +119,7 @@ let disk_of_vdi ~__context ~self = let vdi_of_disk ~__context x = match String.split ~limit:2 '/' x with | [sr_uuid; location] -> ( - let open Db_filter_types in + let open Xapi_database.Db_filter_types in let sr = Db.SR.get_by_uuid ~__context ~uuid:sr_uuid in match Db.VDI.get_records_where ~__context @@ -3278,7 +3278,7 @@ let events_from_xapi () = let timeout = 30. +. api_timeout - +. !Db_globs.master_connection_reset_timeout + +. !Xapi_database.Db_globs.master_connection_reset_timeout in let timebox_rpc = Helpers.make_timeboxed_rpc ~__context timeout diff --git a/ocaml/xapi/xha_metadata_vdi.ml b/ocaml/xapi/xha_metadata_vdi.ml index d824bf6a493..d2142c30d6a 100644 --- a/ocaml/xapi/xha_metadata_vdi.ml +++ b/ocaml/xapi/xha_metadata_vdi.ml @@ -19,6 +19,7 @@ module D = Debug.Make (struct let name = "xha_metadata_vdi" end) open D open Client +module Redo_log = Xapi_database.Redo_log let create ~__context ~sr = Helpers.call_api_functions ~__context (fun rpc session_id -> @@ -82,6 +83,7 @@ let deactivate_and_detach_existing ~__context = (** Attempt to flush the database to the metadata VDI *) let flush_database ~__context log = + let open Xapi_database in try Redo_log.flush_db_to_redo_log (Db_ref.get_database (Db_backend.make ())) log with _ -> false diff --git a/ocaml/xapi/xha_statefile.ml b/ocaml/xapi/xha_statefile.ml index 357ad1bd6b2..abcae2d1697 100644 --- a/ocaml/xapi/xha_statefile.ml +++ b/ocaml/xapi/xha_statefile.ml @@ -18,6 +18,7 @@ module D = Debug.Make (struct let name = "xha_statefile" end) open D +module Redo_log = Xapi_database.Redo_log (** Reason associated with the static VDI attach, to help identify these later *) let reason = "HA statefile" @@ -108,7 +109,7 @@ let check_sr_can_host_statefile ~__context ~sr ~cluster_stack = Cluster_stack_constraints.assert_sr_compatible ~__context ~cluster_stack ~sr ; (* Check the exported capabilities of the SR's SM plugin *) let srtype = Db.SR.get_type ~__context ~self:sr in - let open Db_filter_types in + let open Xapi_database.Db_filter_types in match Db.SM.get_internal_records_where ~__context ~expr:(Eq (Field "type", Literal srtype)) diff --git a/ocaml/xcp-rrdd/bin/rrdd/dune b/ocaml/xcp-rrdd/bin/rrdd/dune index 42b0823d9c2..c38e712f74b 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/dune +++ b/ocaml/xcp-rrdd/bin/rrdd/dune @@ -1,6 +1,7 @@ (library (name rrdd_libs_internal) (wrapped false) + (modes best) (modules (:standard \ xcp_rrdd)) (libraries astring diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index 3eb708d7a5c..faa2c7f0076 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -795,7 +795,7 @@ let domain_snapshot xc = the original and the final uuid to xenstore *) let uuid_from_key key = let path = Printf.sprintf "/vm/%s/%s" uuid key in - try Xenstore.(with_xs (fun xs -> xs.read path)) + try Ezxenstore_core.Xenstore.(with_xs (fun xs -> xs.read path)) with Xs_protocol.Enoent _hint -> info "Couldn't read path %s; falling back to actual uuid" path ; uuid diff --git a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml index 844ad7f8a17..23d8831b9cf 100644 --- a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml +++ b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml @@ -20,7 +20,7 @@ open Blktap3_stats module Process = Process (struct let name = "xcp-rrdd-iostat" end) open Process -open Xenstore +open Ezxenstore_core.Xenstore let with_xc_and_xs f = Xenctrl.with_intf (fun xc -> with_xs (fun xs -> f xc xs)) diff --git a/ocaml/xen-api-client/lwt/dune b/ocaml/xen-api-client/lwt/dune index f07183058dc..306a170d0c4 100644 --- a/ocaml/xen-api-client/lwt/dune +++ b/ocaml/xen-api-client/lwt/dune @@ -22,6 +22,5 @@ xen-api-client xmlm ) - (wrapped false) ) diff --git a/ocaml/xen-api-client/lwt_examples/list_vms.ml b/ocaml/xen-api-client/lwt_examples/list_vms.ml index 40730ef4473..1e5bb7e83a6 100644 --- a/ocaml/xen-api-client/lwt_examples/list_vms.ml +++ b/ocaml/xen-api-client/lwt_examples/list_vms.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Xen_api_lwt_unix +open Xen_api_client_lwt.Xen_api_lwt_unix open Lwt.Syntax let uri = ref "http://127.0.0.1/jsonrpc" diff --git a/ocaml/xen-api-client/lwt_examples/upload_disk.ml b/ocaml/xen-api-client/lwt_examples/upload_disk.ml index e7043e35db9..2ccb62d8eef 100644 --- a/ocaml/xen-api-client/lwt_examples/upload_disk.ml +++ b/ocaml/xen-api-client/lwt_examples/upload_disk.ml @@ -13,8 +13,10 @@ *) open Lwt -open Xen_api_lwt_unix +open Xen_api_client_lwt.Xen_api_lwt_unix open Lwt.Syntax +module Disk = Xen_api_client_lwt.Disk +module Data_channel = Xen_api_client_lwt.Data_channel let uri = ref "http://127.0.0.1/jsonrpc" diff --git a/ocaml/xen-api-client/lwt_examples/watch_metrics.ml b/ocaml/xen-api-client/lwt_examples/watch_metrics.ml index ae881fb296e..11e5dea3b48 100644 --- a/ocaml/xen-api-client/lwt_examples/watch_metrics.ml +++ b/ocaml/xen-api-client/lwt_examples/watch_metrics.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Xen_api_lwt_unix +open Xen_api_client_lwt.Xen_api_lwt_unix open Lwt.Syntax let uri = ref "http://127.0.0.1/jsonrpc" diff --git a/ocaml/xenopsd/lib/storage.ml b/ocaml/xenopsd/lib/storage.ml index 29692f4051c..72dd3b03322 100644 --- a/ocaml/xenopsd/lib/storage.ml +++ b/ocaml/xenopsd/lib/storage.ml @@ -37,9 +37,9 @@ let transform_exception f x = let id_of frontend vbd = Printf.sprintf "vbd/%s/%s" frontend (snd vbd) let get_dbg task = - Debuginfo.make ~log:(Xenops_task.get_dbg task) + Debug_info.make ~log:(Xenops_task.get_dbg task) ~tracing:(Xenops_task.tracing task) - |> Debuginfo.to_string + |> Debug_info.to_string let epoch_begin task sr vdi domid persistent = transform_exception diff --git a/ocaml/xenopsd/lib/xenops_task.ml b/ocaml/xenopsd/lib/xenops_task.ml index d14a407d754..3fcaffefec0 100644 --- a/ocaml/xenopsd/lib/xenops_task.ml +++ b/ocaml/xenopsd/lib/xenops_task.ml @@ -71,12 +71,12 @@ let is_task task = function None let parallel_id_with_tracing parallel_id t = - Debuginfo.make ~log:parallel_id ~tracing:(Xenops_task.tracing t) - |> Debuginfo.to_string + Debug_info.make ~log:parallel_id ~tracing:(Xenops_task.tracing t) + |> Debug_info.to_string let dbg_with_traceparent_of_task t = - Debuginfo.make ~log:(Xenops_task.get_dbg t) ~tracing:(Xenops_task.tracing t) - |> Debuginfo.to_string + Debug_info.make ~log:(Xenops_task.get_dbg t) ~tracing:(Xenops_task.tracing t) + |> Debug_info.to_string let traceparent_header_of_task t = Option.map diff --git a/ocaml/xenopsd/pvs/pvs_proxy_setup.ml b/ocaml/xenopsd/pvs/pvs_proxy_setup.ml index 7cf25f74b2a..8e73cc91696 100644 --- a/ocaml/xenopsd/pvs/pvs_proxy_setup.ml +++ b/ocaml/xenopsd/pvs/pvs_proxy_setup.ml @@ -27,7 +27,7 @@ module D = Debug.Make (struct end) (* using __MODULE__ leads to a convoluted long name, so avoiding it *) -module XS = Xenstore +module XS = Ezxenstore_core.Xenstore let error fmt = Printf.kprintf diff --git a/ocaml/xenopsd/xc/cancel_utils.ml b/ocaml/xenopsd/xc/cancel_utils.ml index 130233cb577..d0df8e54297 100644 --- a/ocaml/xenopsd/xc/cancel_utils.ml +++ b/ocaml/xenopsd/xc/cancel_utils.ml @@ -11,7 +11,7 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) -open Xenstore +open Ezxenstore_core.Xenstore open Xenops_task open Device_common @@ -88,8 +88,8 @@ let cleanup_for_domain ~xs domid = let watches_of key = [ - Watch.key_to_disappear (cancel_path_of key) - ; Watch.value_to_become (shutdown_path_of key) "" + Ezxenstore_core.Watch.key_to_disappear (cancel_path_of key) + ; Ezxenstore_core.Watch.value_to_become (shutdown_path_of key) "" ] let cancel ~xs key = @@ -144,6 +144,8 @@ let with_path ~xs key f = () ) +module Watch = Ezxenstore_core.Watch + let cancellable_watch key good_watches error_watches (task : Xenops_task.task_handle) ~xs ~timeout () = with_path ~xs key (fun () -> @@ -161,9 +163,7 @@ let cancellable_watch key good_watches error_watches ) ) in - let any_have_fired ws = - List.fold_left ( || ) false (List.map (Watch.has_fired ~xs) ws) - in + let any_have_fired ws = List.exists (Watch.has_fired ~xs) ws in (* If multiple conditions are true simultaneously then we apply the policy: if the success condition is met then any error or cancellation is ignored if the error condition is met then any diff --git a/ocaml/xenopsd/xc/cancel_utils_test.ml b/ocaml/xenopsd/xc/cancel_utils_test.ml index 459c0caa085..cf9a6be9150 100644 --- a/ocaml/xenopsd/xc/cancel_utils_test.ml +++ b/ocaml/xenopsd/xc/cancel_utils_test.ml @@ -43,7 +43,7 @@ let xenstore_test xs = Printf.printf "%s: success: watch cancelled successfully" __MODULE__ let () = - try Xenstore.with_xs xenstore_test + try Ezxenstore_core.Xenstore.with_xs xenstore_test with Xs_transport.Could_not_find_xenstore -> Printf.printf "%s: Xenstore not found, cannot test cancellable watches, are you \ diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index d86caae2d81..a9dabdd9159 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -16,7 +16,7 @@ open Printf open Xenops_utils open Xenops_interface open Device_common -open Xenstore +open Ezxenstore_core.Xenstore open Cancel_utils open Xenops_task module Unixext = Xapi_stdext_unix.Unixext @@ -1893,7 +1893,8 @@ module Vusb = struct end module Serial : sig - val update_xenstore : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val update_xenstore : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit end = struct let tty_prefix = "pty:" @@ -2372,35 +2373,40 @@ module Backend = struct profile backends *) module Vbd : sig val qemu_media_change : - xs:Xenstore.Xs.xsh -> device -> string -> string -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -> string -> unit end (** Vcpu functions that use the dispatcher to choose between different profile backends *) module Vcpu : sig - val add : xs:Xenstore.Xs.xsh -> devid:int -> int -> bool -> unit + val add : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> devid:int -> int -> bool -> unit - val set : xs:Xenstore.Xs.xsh -> devid:int -> int -> bool -> unit + val set : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> devid:int -> int -> bool -> unit - val del : xs:Xenstore.Xs.xsh -> devid:int -> int -> unit + val del : xs:Ezxenstore_core.Xenstore.Xs.xsh -> devid:int -> int -> unit - val status : xs:Xenstore.Xs.xsh -> devid:int -> int -> bool + val status : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> devid:int -> int -> bool end (** Dm functions that use the dispatcher to choose between different profile backends *) module Dm : sig - val get_vnc_port : xs:Xenstore.Xs.xsh -> int -> Socket.t option + val get_vnc_port : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> int -> Socket.t option (** [get_vnc_port xenstore domid] returns the dom0 tcp port in which the vnc server for [domid] can be found *) - val assert_can_suspend : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val assert_can_suspend : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit (** [assert_can_suspend xenstore xc] checks whether suspending is prevented by QEMU *) val suspend : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> Xenctrl.domid -> unit @@ -2411,7 +2417,7 @@ module Backend = struct -> path:string -> args:string list -> domid:int - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> ready_path:Watch.path -> timeout:float -> cancel:Cancel_utils.key @@ -2422,7 +2428,7 @@ module Backend = struct returns a forkhelper pid after starting the qemu daemon in dom0 *) val stop : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> vtpm:Xenops_interface.Vm.tpm option -> int @@ -2430,7 +2436,7 @@ module Backend = struct (** [stop xenstore qemu_domid domid] stops a domain *) val qemu_args : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> Dm_Common.info -> bool @@ -2440,7 +2446,7 @@ module Backend = struct arguments to pass to the qemu wrapper script *) val after_suspend_image : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> vtpm:Xenops_interface.Vm.tpm option -> int @@ -2449,7 +2455,7 @@ module Backend = struct after the suspend image has been created *) val pci_assign_guest : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> index:int -> host:Pci.address -> Pci.address option @@ -2548,7 +2554,7 @@ module Backend = struct module XenPV : sig val addr : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid:int -> Dm_Common.info -> nics:(string * string * int) list @@ -2557,7 +2563,10 @@ module Backend = struct module XenPlatform : sig val device : - xs:Xenstore.Xs.xsh -> domid:int -> info:Dm_Common.info -> string list + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> domid:int + -> info:Dm_Common.info + -> string list end module VGPU : sig @@ -2566,7 +2575,7 @@ module Backend = struct module PCI : sig val assign_guest : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> index:int -> host:Pci.address -> Pci.address option diff --git a/ocaml/xenopsd/xc/device.mli b/ocaml/xenopsd/xc/device.mli index a39a8de5c9c..887c109e256 100644 --- a/ocaml/xenopsd/xc/device.mli +++ b/ocaml/xenopsd/xc/device.mli @@ -59,11 +59,12 @@ module Profile : sig end module Generic : sig - val rm_device_state : xs:Xenstore.Xs.xsh -> device -> unit + val rm_device_state : xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> unit - val exists : xs:Xenstore.Xs.xsh -> device -> bool + val exists : xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> bool - val get_private_key : xs:Xenstore.Xs.xsh -> device -> string -> string + val get_private_key : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -> string end module Vbd : sig @@ -104,7 +105,7 @@ module Vbd : sig val add : Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> hvm:bool -> t -> Xenctrl.domid @@ -113,39 +114,43 @@ module Vbd : sig val release : Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> unit - val media_eject : xs:Xenstore.Xs.xsh -> dm:Profile.t -> device -> unit + val media_eject : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> device -> unit val media_insert : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> phystype:physty -> params:string -> device -> unit - val media_is_ejected : xs:Xenstore.Xs.xsh -> device -> bool + val media_is_ejected : xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> bool - val clean_shutdown_async : xs:Xenstore.Xs.xsh -> device -> unit + val clean_shutdown_async : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> unit val clean_shutdown_wait : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> ignore_transients:bool -> device -> unit (* For migration: *) - val hard_shutdown_request : xs:Xenstore.Xs.xsh -> device -> unit + val hard_shutdown_request : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> unit - val hard_shutdown_complete : xs:Xenstore.Xs.xsh -> device -> unit Watch.t + val hard_shutdown_complete : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> unit Ezxenstore_core.Watch.t val hard_shutdown_wait : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> timeout:float -> device -> unit @@ -153,7 +158,7 @@ end module Vif : sig val add : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> devid:int -> mac:string -> ?mtu:int @@ -169,21 +174,21 @@ module Vif : sig -> Xenctrl.domid -> device - val set_carrier : xs:Xenstore.Xs.xsh -> device -> bool -> unit + val set_carrier : xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> bool -> unit val release : Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> unit - val move : xs:Xenstore.Xs.xsh -> device -> string -> unit + val move : xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -> unit end module NetSriovVf : sig val add : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> devid:int -> mac:string -> ?mtu:int @@ -201,23 +206,49 @@ module NetSriovVf : sig end val clean_shutdown : - Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> device -> unit + Xenops_task.task_handle + -> xs:Ezxenstore_core.Xenstore.Xs.xsh + -> device + -> unit val hard_shutdown : - Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> device -> unit + Xenops_task.task_handle + -> xs:Ezxenstore_core.Xenstore.Xs.xsh + -> device + -> unit -val can_surprise_remove : xs:Xenstore.Xs.xsh -> device -> bool +val can_surprise_remove : xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> bool module Vcpu : sig val add : - xs:Xenstore.Xs.xsh -> dm:Profile.t -> devid:int -> int -> bool -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> dm:Profile.t + -> devid:int + -> int + -> bool + -> unit - val del : xs:Xenstore.Xs.xsh -> dm:Profile.t -> devid:int -> int -> unit + val del : + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> dm:Profile.t + -> devid:int + -> int + -> unit val set : - xs:Xenstore.Xs.xsh -> dm:Profile.t -> devid:int -> int -> bool -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> dm:Profile.t + -> devid:int + -> int + -> bool + -> unit - val status : xs:Xenstore.Xs.xsh -> dm:Profile.t -> devid:int -> int -> bool + val status : + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> dm:Profile.t + -> devid:int + -> int + -> bool end module PCI : sig @@ -242,7 +273,7 @@ module PCI : sig val add : xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> hvm:bool -> device' list -> Xenctrl.domid @@ -250,11 +281,12 @@ module PCI : sig val release : address list -> Xenctrl.domid -> unit - val reset : xs:Xenstore.Xs.xsh -> address -> unit + val reset : xs:Ezxenstore_core.Xenstore.Xs.xsh -> address -> unit val bind : address list -> supported_driver -> unit - val list : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> (int * address) list + val list : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> (int * address) list val dequarantine : Xenops_interface.Pci.address -> bool end @@ -262,7 +294,7 @@ end module Vfs : sig val add : xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> ?backend_domid:int -> Xenctrl.domid -> unit @@ -271,7 +303,7 @@ end module Vfb : sig val add : xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> ?backend_domid:int -> ?protocol:protocol -> Xenctrl.domid @@ -281,7 +313,7 @@ end module Vkbd : sig val add : xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> ?backend_domid:int -> ?protocol:protocol -> Xenctrl.domid @@ -338,16 +370,17 @@ module Dm : sig } val get_vnc_port : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> Xenctrl.domid -> Xenops_utils.Socket.t option - val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option + val get_tc_port : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> int option val signal : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> domid:Xenctrl.domid -> ?wait_for:string @@ -356,7 +389,7 @@ module Dm : sig -> unit val qemu_args : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> info -> bool (** true = restore *) @@ -367,7 +400,7 @@ module Dm : sig val start : Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> ?timeout:float -> info @@ -377,7 +410,7 @@ module Dm : sig val restore : Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> ?timeout:float -> info @@ -385,11 +418,11 @@ module Dm : sig -> unit val assert_can_suspend : - xs:Xenstore.Xs.xsh -> dm:Profile.t -> Xenctrl.domid -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> Xenctrl.domid -> unit val suspend : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> dm:Profile.t -> Xenctrl.domid @@ -397,13 +430,13 @@ module Dm : sig val resume : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> Xenctrl.domid -> unit val stop : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> vtpm:Xenops_interface.Vm.tpm option -> dm:Profile.t @@ -413,7 +446,7 @@ module Dm : sig val restore_vgpu : Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> Xenops_interface.Vgpu.t list -> int @@ -422,35 +455,35 @@ module Dm : sig val suspend_varstored : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> vm_uuid:string -> string val restore_varstored : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> efivars:string -> Xenctrl.domid -> unit val suspend_vtpm : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> vtpm:Xenops_interface.Vm.tpm option -> string list val restore_vtpm : Xenops_task.task_handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> contents:string -> vtpm:Xenops_interface.Vm.tpm option -> Xenctrl.domid -> unit val after_suspend_image : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> qemu_domid:int -> vtpm:Xenops_interface.Vm.tpm option @@ -458,7 +491,7 @@ module Dm : sig -> unit val pci_assign_guest : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> index:int -> host:Xenops_interface.Pci.address @@ -470,12 +503,13 @@ module Backend : sig end module Serial : sig - val update_xenstore : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val update_xenstore : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit end module Vusb : sig val vusb_plug : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> privileged:bool -> domid:Xenctrl.domid -> id:string @@ -486,7 +520,7 @@ module Vusb : sig -> unit val vusb_unplug : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> privileged:bool -> domid:Xenctrl.domid -> id:string @@ -494,13 +528,15 @@ module Vusb : sig -> hostport:string -> unit - val qom_list : xs:Xenstore.Xs.xsh -> domid:Xenctrl.domid -> string list + val qom_list : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid:Xenctrl.domid -> string list end val get_vnc_port : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Profile.t -> Xenctrl.domid -> Xenops_utils.Socket.t option -val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option +val get_tc_port : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> int option diff --git a/ocaml/xenopsd/xc/device_common.ml b/ocaml/xenopsd/xc/device_common.ml index acac7d3faf1..871628aeef5 100644 --- a/ocaml/xenopsd/xc/device_common.ml +++ b/ocaml/xenopsd/xc/device_common.ml @@ -11,7 +11,7 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) -open Xenstore +open Ezxenstore_core.Xenstore type kind = Vif | Tap | Pci | Vfs | Vfb | Vkbd | Vbd of string | NetSriovVf [@@deriving rpcty] diff --git a/ocaml/xenopsd/xc/device_common.mli b/ocaml/xenopsd/xc/device_common.mli index f1aa53fc6ba..d2ed8f04932 100644 --- a/ocaml/xenopsd/xc/device_common.mli +++ b/ocaml/xenopsd/xc/device_common.mli @@ -47,36 +47,47 @@ exception QMP_connection_error of int * string val block_device_of_device : device -> string -val backend_path : xs:Xenstore.Xs.xsh -> endpoint -> Xenctrl.domid -> string +val backend_path : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> endpoint -> Xenctrl.domid -> string -val backend_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val backend_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val frontend_rw_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val frontend_rw_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val frontend_ro_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val frontend_ro_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val disconnect_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val disconnect_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val kthread_pid_paths_of_device : xs:Xenstore.Xs.xsh -> device -> string list +val kthread_pid_paths_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string list -val error_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val error_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val backend_error_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val backend_error_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string val backend_shutdown_request_path_of_device : - xs:Xenstore.Xs.xsh -> device -> string + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string val backend_shutdown_done_path_of_device : - xs:Xenstore.Xs.xsh -> device -> string + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string val backend_pause_request_path_of_device : - xs:Xenstore.Xs.xsh -> device -> string + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val backend_pause_token_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val backend_pause_token_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val backend_pause_done_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val backend_pause_done_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -val backend_state_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val backend_state_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string val get_private_path : Xenctrl.domid -> string @@ -84,7 +95,8 @@ val get_private_path_by_uuid : 'a Uuidx.t -> string val get_private_data_path_of_device : device -> string -val extra_xenserver_path_of_device : xs:Xenstore.Xs.xsh -> device -> string +val extra_xenserver_path_of_device : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string val string_of_endpoint : endpoint -> string @@ -94,28 +106,39 @@ val string_of_kind : kind -> string val kind_of_string : string -> kind -val list_backends : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> device list +val list_backends : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> device list (** [list_backends xs domid] returns a list of devices where there is a backend in [domid]. This function only reads data stored in the backend directory.*) val list_frontends : - xs:Xenstore.Xs.xsh -> ?for_devids:int list -> Xenctrl.domid -> device list + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> ?for_devids:int list + -> Xenctrl.domid + -> device list (** [list_frontends xs domid] returns a list of devices where there is a frontend in [domid]. This function only reads data stored in the frontend directory.*) val list_devices_between : - xs:Xenstore.Xs.xsh -> Xenctrl.domid -> Xenctrl.domid -> device list + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> Xenctrl.domid + -> Xenctrl.domid + -> device list (** Return a list of devices connecting two domains. Ignore those whose kind we don't recognise *) val device_of_backend : endpoint -> Xenctrl.domid -> device val add_backend_keys : - xs:Xenstore.Xs.xsh -> device -> string -> (string * string) list -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> device + -> string + -> (string * string) list + -> unit val remove_backend_keys : - xs:Xenstore.Xs.xsh -> device -> string -> string list -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh -> device -> string -> string list -> unit type protocol = Protocol_Native | Protocol_X86_32 | Protocol_X86_64 diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index bd17e5d284a..f78e7179e6a 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/ocaml/xenopsd/xc/domain.ml @@ -15,7 +15,7 @@ open Printf open Xenops_utils -open Xenstore +open Ezxenstore_core.Xenstore open Cancel_utils open Device_common open Xenops_task @@ -2008,7 +2008,6 @@ let move_xstree ~xs domid olduuid newuuid = in let regexp = Re.Pcre.regexp olduuid in let rec get_tree t path = - let open Xenstore in let subtrees = let path' = String.concat "/" path in try t.Xs.directory path' @@ -2030,7 +2029,6 @@ let move_xstree ~xs domid olduuid newuuid = with Xs_protocol.Enoent _ -> false in let mv_tree path = - let open Xenstore in Xs.transaction xs (fun t -> if exists t path then let tree = get_tree t path in diff --git a/ocaml/xenopsd/xc/domain.mli b/ocaml/xenopsd/xc/domain.mli index b7b275a6efd..598a9efc3d9 100644 --- a/ocaml/xenopsd/xc/domain.mli +++ b/ocaml/xenopsd/xc/domain.mli @@ -142,7 +142,7 @@ val build_info : build_info Rpc.Types.def val make : xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> create_info -> int -> arch_domainconfig @@ -176,7 +176,11 @@ val hard_shutdown : xc:Xenctrl.handle -> domid -> shutdown_reason -> unit exception Domain_does_not_exist val shutdown : - xc:Xenctrl.handle -> xs:Xenstore.Xs.xsh -> domid -> shutdown_reason -> unit + xc:Xenctrl.handle + -> xs:Ezxenstore_core.Xenstore.Xs.xsh + -> domid + -> shutdown_reason + -> unit (** Tell the domain to shutdown with reason 'shutdown_reason'. Don't wait for an ack *) @@ -184,7 +188,7 @@ val shutdown_wait_for_ack : Xenops_task.Xenops_task.task_handle -> timeout:float -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> [`hvm | `pv | `pvh] -> shutdown_reason @@ -192,13 +196,13 @@ val shutdown_wait_for_ack : (** Tell the domain to shutdown with reason 'shutdown_reason', waiting for an ack *) -val sysrq : xs:Xenstore.Xs.xsh -> domid -> char -> unit +val sysrq : xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> char -> unit (** send a domain a sysrq *) val destroy : Xenops_task.Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> qemu_domid:int -> vtpm:Xenops_interface.Vm.tpm option -> dm:Device.Profile.t @@ -212,16 +216,18 @@ val pause : xc:Xenctrl.handle -> domid -> unit val unpause : xc:Xenctrl.handle -> domid -> unit (** Unpause a domain *) -val set_action_request : xs:Xenstore.Xs.xsh -> domid -> string option -> unit +val set_action_request : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> string option -> unit (** [set_action_request xs domid None] declares this domain is fully intact. Any other string is a hint to the toolstack that the domain is still broken. *) -val get_action_request : xs:Xenstore.Xs.xsh -> domid -> string option +val get_action_request : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> string option val build : Xenops_task.Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> store_domid:int -> console_domid:int -> timeoffset:string @@ -237,7 +243,7 @@ val build : val restore : Xenops_task.Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> dm:Device.Profile.t -> store_domid:int -> console_domid:int @@ -258,7 +264,7 @@ type suspend_flag = Live | Debug val suspend : Xenops_task.Xenops_task.task_handle -> xc:Xenctrl.handle - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> domain_type:[`hvm | `pv | `pvh] -> is_uefi:bool -> dm:Device.Profile.t @@ -281,7 +287,8 @@ val send_s3resume : xc:Xenctrl.handle -> domid -> unit val vcpu_affinity_set : xc:Xenctrl.handle -> domid -> int -> bool array -> unit (** Set cpu affinity of some vcpus of a domain using an boolean array *) -val soft_reset : xc:Xenctrl.handle -> xs:Xenstore.Xs.xsh -> domid -> unit +val soft_reset : + xc:Xenctrl.handle -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> unit (** Perform soft reset of a domain *) val vcpu_affinity_get : xc:Xenctrl.handle -> domid -> int -> bool array @@ -291,7 +298,12 @@ val get_uuid : xc:Xenctrl.handle -> Xenctrl.domid -> [`Vm] Uuidx.t (** Get the uuid from a specific domain *) val set_memory_dynamic_range : - xc:Xenctrl.handle -> xs:Xenstore.Xs.xsh -> min:int -> max:int -> domid -> unit + xc:Xenctrl.handle + -> xs:Ezxenstore_core.Xenstore.Xs.xsh + -> min:int + -> max:int + -> domid + -> unit (** Write the min,max values of memory/target to xenstore for use by a memory policy agent *) @@ -313,15 +325,21 @@ val add_irq : xc:Xenctrl.handle -> domid -> int -> unit val del_irq : xc:Xenctrl.handle -> domid -> int -> unit (** Revoke a domain's access to a physical IRQ *) -val set_memory_target : xs:Xenstore.Xs.xsh -> Xenstore.Xs.domid -> int64 -> unit +val set_memory_target : + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> Ezxenstore_core.Xenstore.Xs.domid + -> int64 + -> unit val wait_xen_free_mem : xc:Xenctrl.handle -> ?maximum_wait_time_seconds:int -> int64 -> bool val allowed_xsdata_prefixes : string list -val set_xsdata : xs:Xenstore.Xs.xsh -> domid -> (string * string) list -> unit +val set_xsdata : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> (string * string) list -> unit -val move_xstree : xs:Xenstore.Xs.xsh -> domid -> string -> string -> unit +val move_xstree : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid -> string -> string -> unit val numa_init : unit -> unit diff --git a/ocaml/xenopsd/xc/hotplug.ml b/ocaml/xenopsd/xc/hotplug.ml index 97413350ab6..06a4edec85d 100644 --- a/ocaml/xenopsd/xc/hotplug.ml +++ b/ocaml/xenopsd/xc/hotplug.ml @@ -15,7 +15,7 @@ open Printf open Xenops_task open Device_common -open Xenstore +open Ezxenstore_core.Xenstore open Cancel_utils open Xenops_utils diff --git a/ocaml/xenopsd/xc/memory_breakdown.ml b/ocaml/xenopsd/xc/memory_breakdown.ml index 29a287865c0..f13d76d41c8 100644 --- a/ocaml/xenopsd/xc/memory_breakdown.ml +++ b/ocaml/xenopsd/xc/memory_breakdown.ml @@ -14,7 +14,7 @@ module Unixext = Xapi_stdext_unix.Unixext module Date = Xapi_stdext_date.Date -open Xenstore +open Ezxenstore_core.Xenstore (** Command-line tool for sampling host and guest memory usage. *) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 315780cd040..e85ae122067 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -18,7 +18,7 @@ module Unixext = Xapi_stdext_unix.Unixext module Xenops_task = Xenops_task.Xenops_task module Chroot = Xenops_sandbox.Chroot module Path = Chroot.Path -module Xs = Xenstore.Xs +module Xs = Ezxenstore_core.Xenstore.Xs module Socket = Xenops_utils.Socket let defer f g = Xapi_stdext_pervasives.Pervasiveext.finally g f @@ -191,14 +191,16 @@ let start_and_wait_for_readyness ~task ~service = an exception is raised *) let wait_path ~pidalive ~task ~name ~domid ~xs ~ready_path ~timeout ~cancel _ = let syslog_key = Printf.sprintf "%s-%d" name domid in - let watch = Watch.value_to_appear ready_path |> Watch.map (fun _ -> ()) in + let watch = + Ezxenstore_core.Watch.(value_to_appear ready_path |> map (fun _ -> ())) + in Xenops_task.check_cancelling task ; ( try let (_ : bool) = Cancel_utils.cancellable_watch cancel [watch] [] task ~xs ~timeout () in () - with Watch.Timeout _ -> + with Ezxenstore_core.Watch.Timeout _ -> if pidalive name then raise (Service_failed (name, "Timeout reached while starting daemon")) ; raise (Service_failed (name, "Daemon exited unexpectedly")) diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli index 7b50696abb7..b0cd9178b6f 100644 --- a/ocaml/xenopsd/xc/service.mli +++ b/ocaml/xenopsd/xc/service.mli @@ -43,17 +43,20 @@ module Qemu : sig -> unit -> Forkhelpers.pidty - val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option + val pid : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> int option - val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool + val is_running : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> bool val stop : - xs:Xenstore.Xs.xsh -> qemu_domid:Xenctrl.domid -> Xenctrl.domid -> unit + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> qemu_domid:Xenctrl.domid + -> Xenctrl.domid + -> unit end module Vgpu : sig val start : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> vcpus:int -> vgpus:Xenops_interface.Vgpu.t list -> restore:bool @@ -65,11 +68,11 @@ module Vgpu : sig val state_path : Xenctrl.domid -> string - val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option + val pid : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> int option - val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool + val is_running : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> bool - val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val stop : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit end module PV_Vnc : sig @@ -79,23 +82,27 @@ module PV_Vnc : sig val tc_port_path : Xenctrl.domid -> string - val save : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val save : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit - val get_statefile : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> string option + val get_statefile : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> string option val start : ?statefile:string - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> ?ip:string -> Xenctrl.domid -> unit - val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val stop : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit val get_vnc_port : - xs:Xenstore.Xs.xsh -> Xenctrl.domid -> Xenops_utils.Socket.t option + xs:Ezxenstore_core.Xenstore.Xs.xsh + -> Xenctrl.domid + -> Xenops_utils.Socket.t option - val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option + val get_tc_port : + xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> int option end module Varstored : sig @@ -104,19 +111,19 @@ module Varstored : sig val efivars_resume_path : Xenops_sandbox.Chroot.Path.t val start : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> nvram:Xenops_types.Nvram_uefi_variables.t -> ?restore:bool -> Xenops_task.Xenops_task.task_handle -> Xenctrl.domid -> unit - val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + val stop : xs:Ezxenstore_core.Xenstore.Xs.xsh -> Xenctrl.domid -> unit end module Swtpm : sig val start : - xs:Xenstore.Xs.xsh + xs:Ezxenstore_core.Xenstore.Xs.xsh -> vtpm_uuid:Xapi_idl_guard_privileged.Interface.Uuidm.t -> index:int -> Xenops_task.Xenops_task.task_handle @@ -132,14 +139,14 @@ module Swtpm : sig val suspend : string - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid:int -> vtpm_uuid:Xapi_idl_guard_privileged.Interface.Uuidm.t -> string val stop : string - -> xs:Xenstore.Xs.xsh + -> xs:Ezxenstore_core.Xenstore.Xs.xsh -> domid:int -> vm_uuid:string -> vtpm_uuid:Xapi_idl_guard_privileged.Interface.Uuidm.t diff --git a/ocaml/xenopsd/xc/xenops_helpers.ml b/ocaml/xenopsd/xc/xenops_helpers.ml index 81e15f09d07..602ef72d40f 100644 --- a/ocaml/xenopsd/xc/xenops_helpers.ml +++ b/ocaml/xenopsd/xc/xenops_helpers.ml @@ -11,7 +11,7 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) -open Xenstore +open Ezxenstore_core.Xenstore (** {2 XC, XS and XAL interface helpers.} *) diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 2f60e3b2716..c94bbd16b3e 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -15,7 +15,7 @@ open Xenops_interface open Xenops_server_plugin open Xenops_helpers -open Xenstore +open Ezxenstore_core.Xenstore open Xenops_utils open Xenops_task open Cancel_utils diff --git a/ocaml/xenopsd/xc/xenops_xc_main.ml b/ocaml/xenopsd/xc/xenops_xc_main.ml index aeeefb3540f..b7fce8d0b65 100644 --- a/ocaml/xenopsd/xc/xenops_xc_main.ml +++ b/ocaml/xenopsd/xc/xenops_xc_main.ml @@ -36,7 +36,7 @@ let check_domain0_uuid () = ; (Printf.sprintf "/vm/%s/domains/0/create-time" uuid, "0") ] in - let open Xenstore in + let open Ezxenstore_core.Xenstore in with_xs (fun xs -> List.iter (fun (k, v) -> xs.Xs.write k v) kvs) ; if !Xcp_service.daemon then (* before daemonizing we need to forget the xenstore client because the