Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions dune-project
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@

(generate_opam_files true)

(name "xapi")
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am surprised that this was not included before.

(source (github xapi-project/xen-api))
(license "LGPL-2.1-only WITH OCaml-LGPL-linking-exception")
(authors "[email protected]")
Expand Down
2 changes: 2 additions & 0 deletions ocaml/database/block_device_io.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"

Expand Down
8 changes: 5 additions & 3 deletions ocaml/database/database_server_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ;
Expand All @@ -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

Expand Down Expand Up @@ -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] ;
Expand Down
3 changes: 2 additions & 1 deletion ocaml/database/db_cache_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/database/dune
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -48,7 +49,6 @@
xml-light2
xmlm
)
(wrapped false)
(preprocess (pps ppx_deriving_rpc))
)

Expand Down
6 changes: 3 additions & 3 deletions ocaml/database/unit_test_marshall.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)

Expand Down
3 changes: 2 additions & 1 deletion ocaml/db_process/xapi_db_process.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
11 changes: 6 additions & 5 deletions ocaml/idl/ocaml_backend/gen_db_actions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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'"
]
| _ ->
Expand Down Expand Up @@ -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"
]
Expand Down
1 change: 0 additions & 1 deletion ocaml/libs/ezxenstore/core/dune
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
(library
(name ezxenstore_core)
(public_name ezxenstore.core)
(wrapped false)
(libraries
cmdliner
logs
Expand Down
2 changes: 1 addition & 1 deletion ocaml/libs/ezxenstore/lib_test/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 6 additions & 4 deletions ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ end

module Make (Debug : DEBUG) = struct
open Debug
open Xenstore
open Ezxenstore_core.Xenstore

exception Watch_overflow

Expand All @@ -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
Expand All @@ -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 =
Expand Down
2 changes: 2 additions & 0 deletions ocaml/libs/http-lib/dune
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@
(library
(name httpsvr)
(wrapped false)
(modes best)
(modules http_svr http_proxy server_io)
(libraries
astring
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/nbd/lib/local_xapi_session.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/nbd/src/cleanup.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
2 changes: 1 addition & 1 deletion ocaml/nbd/src/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
6 changes: 4 additions & 2 deletions ocaml/tests/common/alcotest_comparators.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
1 change: 1 addition & 0 deletions ocaml/tests/common/dune
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
(library
(name tests_common)
(modules :standard)
(modes best)
(wrapped false)
(libraries
alcotest
Expand Down
2 changes: 2 additions & 0 deletions ocaml/tests/common/mock.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"]
Expand Down
3 changes: 2 additions & 1 deletion ocaml/tests/dune
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -121,6 +121,7 @@
(name test_observer)
(package xapi)
(modules test_observer)
(modes (best exe))
(libraries alcotest tracing xapi_internal tests_common yojson))

(rule
Expand Down
1 change: 1 addition & 0 deletions ocaml/tests/test_db_lowlevel.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/tests/test_ha_vm_failover.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"))
Expand Down
2 changes: 1 addition & 1 deletion ocaml/tests/test_helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
1 change: 1 addition & 0 deletions ocaml/xapi-cli-server/cli_util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions ocaml/xapi-cli-server/dune
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
(library
(name xapi_cli_server)
(modes best)
(libraries
astring
base64
Expand Down
2 changes: 2 additions & 0 deletions ocaml/xapi-cli-server/records.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
8 changes: 3 additions & 5 deletions ocaml/xapi-guard/lib/server_interface.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()

Expand Down Expand Up @@ -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
Expand Down
Loading