diff --git a/gnt/gnttab_stubs.c b/gnt/gnttab_stubs.c index dc0c78f..7f2ff9a 100644 --- a/gnt/gnttab_stubs.c +++ b/gnt/gnttab_stubs.c @@ -32,6 +32,8 @@ #include #include +#include + #include "xengnttab.h" #include "mmap_stubs.h" @@ -57,14 +59,25 @@ stub_gnttab_interface_open (void) CAMLreturn (result); } -/* Only called in tests, returns a unit that poses as any particular type on - * OCaml side - kind of like an unsafe cast from nullptr */ +/* Only called in tests, returns a mmap_interface allocated without xen */ CAMLprim value unsafe_stub (value unit) { +#define Intf_val(a) ((struct mmap_interface *)Data_abstract_val(a)) +#define Wsize_bsize_round(n) (Wsize_bsize( (n) + sizeof(value) - 1 )) + CAMLparam1 (unit); + CAMLlocal1 (result); + assert (geteuid () != 0); - CAMLreturn (Val_unit); + + struct xenstore_domain_interface *addr = calloc (1, 4096); + + result = caml_alloc (Wsize_bsize_round + (sizeof (struct mmap_interface)), Abstract_tag); + Intf_val (result)->addr = addr; + + CAMLreturn (result); } CAMLprim value diff --git a/oxenstored/connection.ml b/oxenstored/connection.ml index 65a3c0b..29d1911 100644 --- a/oxenstored/connection.ml +++ b/oxenstored/connection.ml @@ -326,7 +326,7 @@ let get_fd con = Xenbus.Xb.get_fd con.xb let close con = Logging.end_connection ~tid:Transaction.none ~con:(get_domstr con) ; - Xenbus.Xb.close ~under_testing:Testing_status.under_testing con.xb + Xenbus.Xb.close ~under_testing:!Testing_status.under_testing con.xb let get_perm con = con.perm diff --git a/oxenstored/connections.ml b/oxenstored/connections.ml index a017a76..f4f5f8f 100644 --- a/oxenstored/connections.ml +++ b/oxenstored/connections.ml @@ -62,8 +62,8 @@ let add_anonymous cons fd = let add_domain cons dom = let capacity = get_capacity () in let xbcon = - Xenbus.Xb.open_mmap ~under_testing:Testing_status.under_testing ~capacity - (Domain.get_interface dom) (fun () -> Domain.notify dom + Xenbus.Xb.open_mmap ~under_testing:!Testing_status.under_testing + ~capacity (Domain.get_interface dom) (fun () -> Domain.notify dom ) in let con = Connection.create xbcon (Some dom) in diff --git a/oxenstored/domains.ml b/oxenstored/domains.ml index 01d860a..9ceacbe 100644 --- a/oxenstored/domains.ml +++ b/oxenstored/domains.ml @@ -38,7 +38,7 @@ let load_plug fname = let () = (* Do not link with the plugin when being tested *) - if not Testing_status.under_testing then ( + if not !Testing_status.under_testing then ( let plugins_dir = Filename.concat Paths.libexec "ocaml/xsd_glue/xenctrl_plugin" in diff --git a/oxenstored/logging.ml b/oxenstored/logging.ml index 17cb1a7..d28660b 100644 --- a/oxenstored/logging.ml +++ b/oxenstored/logging.ml @@ -323,6 +323,10 @@ let string_of_access_type = function "error " | Xenbus.Xb.Op.Watchevent -> "w event " + | Xenbus.Xb.Op.Get_feature -> + "get_feature " + | Xenbus.Xb.Op.Set_feature -> + "set_feature " | Xenbus.Xb.Op.Invalid -> "invalid " ) diff --git a/oxenstored/poll.ml b/oxenstored/poll.ml index a214228..fe12e74 100644 --- a/oxenstored/poll.ml +++ b/oxenstored/poll.ml @@ -56,5 +56,5 @@ let poll_select fdarr timeout = fdarr r let () = - if not Testing_status.under_testing then + if not !Testing_status.under_testing then set_fd_limit (get_sys_fs_nr_open ()) diff --git a/oxenstored/process.ml b/oxenstored/process.ml index b8aac07..477b4e4 100644 --- a/oxenstored/process.ml +++ b/oxenstored/process.ml @@ -886,6 +886,8 @@ let retain_op_in_history ty = | Xenbus.Xb.Op.Rm | Xenbus.Xb.Op.Setperms -> true + | Xenbus.Xb.Op.Get_feature + | Xenbus.Xb.Op.Set_feature | Xenbus.Xb.Op.Debug | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Directory_part diff --git a/oxenstored/testing_status/testing_status.ml b/oxenstored/testing_status/testing_status.ml index f93fd29..f389872 100644 --- a/oxenstored/testing_status/testing_status.ml +++ b/oxenstored/testing_status/testing_status.ml @@ -1 +1 @@ -let under_testing = false +let under_testing = ref false diff --git a/oxenstored/xenstored.ml b/oxenstored/xenstored.ml index 6cea2d4..98b3399 100644 --- a/oxenstored/xenstored.ml +++ b/oxenstored/xenstored.ml @@ -439,7 +439,7 @@ let main () = (Unix.handle_unix_error Utils.create_unix_socket Define.xs_daemon_socket) in - if (not Testing_status.under_testing) && cf.daemonize && not cf.live_reload + if (not !Testing_status.under_testing) && cf.daemonize && not cf.live_reload then Unixext.daemonize () else @@ -719,7 +719,7 @@ let main () = if cfds <> [] || wset <> [] then process_connection_fds store cons domains cfds wset spec_fds ; - if not Testing_status.under_testing then ( + if not !Testing_status.under_testing then ( ( if timeout <> 0. then let now = Unix.gettimeofday () in if now > !period_start +. period_ops_interval then ( @@ -732,7 +732,7 @@ let main () = ) in - if not Testing_status.under_testing then ( + if not !Testing_status.under_testing then ( Systemd.sd_notify_ready () ; let live_update = ref false in while not (!quit && Connections.prevents_quit cons = []) do diff --git a/tests/testing_status.ml b/tests/testing_status.ml index 5fc6bf7..ac71a73 100644 --- a/tests/testing_status.ml +++ b/tests/testing_status.ml @@ -1 +1 @@ -let under_testing = true +let under_testing = ref true diff --git a/tests/unit_tests.ml b/tests/unit_tests.ml index db5fe36..4617407 100644 --- a/tests/unit_tests.ml +++ b/tests/unit_tests.ml @@ -916,8 +916,49 @@ let test_quota_maxent () = ; (dom1, none, (Write, ["b"; "hello"]), (Error, ["EQUOTA"])) ] +let feature_testable = + Alcotest.testable + (Fmt.of_to_string Xenbus.Xs_ring.Server_feature.to_string) + Stdlib.( = ) + +let check_features (con : Connection.t) expected = + let open Xenbus.Xs_ring in + let d = Option.get (Connection.get_domain con) in + let x = get_server_features (Xenmmap.to_interface (Domain.get_interface d)) in + Alcotest.(check' (seq @@ feature_testable)) + ~msg:"Verify advertised features on xenstore ring" + ~actual:(Server_features.to_seq x) ~expected:(List.to_seq expected) + +let test_feature_advertisement () = + let _store, doms, cons = initialize () in + (* Turn off under_testing flag here to trigger the setting of feature bitmap *) + Testing_status.under_testing := false ; + + let dom0 = create_dom0_conn cons doms in + let dom1 = create_domU_conn cons doms 1 in + check_features dom0 Xenbus.Xs_ring.Server_feature.[Reconnection; Watch_depth] ; + check_features dom1 Xenbus.Xs_ring.Server_feature.[Reconnection; Watch_depth] ; + Testing_status.under_testing := true + +let test_get_feature () = + let store, doms, cons = initialize () in + (* Turn off under_testing flag here to trigger the setting of feature bitmap *) + Testing_status.under_testing := false ; + + let dom0 = create_dom0_conn cons doms in + let dom1 = create_domU_conn cons doms 1 in + run store cons doms + [ + (dom0, none, (Get_feature, ["0"]), (Error, ["ENOSYS"])) + ; (dom1, none, (Get_feature, ["1"]), (Error, ["ENOSYS"])) + ; (dom1, none, (Set_feature, ["0"; "1"]), (Error, ["ENOSYS"])) + ] ; + check_features dom0 Xenbus.Xs_ring.Server_feature.[Reconnection; Watch_depth] ; + check_features dom1 Xenbus.Xs_ring.Server_feature.[Reconnection; Watch_depth] ; + Testing_status.under_testing := true + let () = - Alcotest.run "Test RRD library" + Alcotest.run "Test oxenstored" [ ( "Basic tests" , [ @@ -972,4 +1013,10 @@ let () = ; ("test_quota_maxent", `Quick, test_quota_maxent) ] ) + ; ( "Features tests" + , [ + ("test_feature_advertisement", `Quick, test_feature_advertisement) + ; ("test_get_feature", `Quick, test_get_feature) + ] + ) ] diff --git a/xenbus/op.ml b/xenbus/op.ml index 17e2bc1..b88b1e7 100644 --- a/xenbus/op.ml +++ b/xenbus/op.ml @@ -37,6 +37,8 @@ type operation = | Set_target | Reset_watches | Directory_part + | Get_feature + | Set_feature | Invalid (* See xs_wire.h for the required order *) @@ -65,6 +67,8 @@ let operation_c_mapping = ; Invalid ; Reset_watches ; Directory_part + ; Get_feature + ; Set_feature |] let size = Array.length operation_c_mapping @@ -131,5 +135,9 @@ let to_string ty = "RESET_WATCHES" | Directory_part -> "DIRECTORY_PART" + | Get_feature -> + "GET_FEATURE" + | Set_feature -> + "SET_FEATURE" | Invalid -> "INVALID" diff --git a/xenbus/op.mli b/xenbus/op.mli index 9e10d76..dbe59e4 100644 --- a/xenbus/op.mli +++ b/xenbus/op.mli @@ -21,6 +21,8 @@ type operation = | Set_target | Reset_watches | Directory_part + | Get_feature + | Set_feature | Invalid val operation_c_mapping : operation array diff --git a/xenbus/xb.ml b/xenbus/xb.ml index 852a620..b769e00 100644 --- a/xenbus/xb.ml +++ b/xenbus/xb.ml @@ -352,11 +352,19 @@ let newcon ~capacity backend = let open_fd fd = newcon (Fd {fd}) let open_mmap mmap notifyfct ~under_testing = - (* Advertise XENSTORE_SERVER_FEATURE_RECONNECTION *) - if not under_testing then - Xs_ring.set_server_features - (Xenmmap.to_interface mmap) - (Xs_ring.Server_features.singleton Xs_ring.Server_feature.Reconnection) ; + (* Advertise + XENSTORE_SERVER_FEATURE_RECONNECTION | + XENSTORE_SERVER_FEATURE_WATCHDEPTH + *) + ( if not under_testing then + Xs_ring.( + set_server_features + (Xenmmap.to_interface mmap) + (Server_features.of_list + [Server_feature.Reconnection; Server_feature.Watch_depth] + ) + ) + ) ; newcon (Xenmmap {mmap; eventchn_notify= notifyfct; work_again= false}) let close con ~under_testing = diff --git a/xenbus/xb.mli b/xenbus/xb.mli index 21824c4..cdf5dae 100644 --- a/xenbus/xb.mli +++ b/xenbus/xb.mli @@ -22,6 +22,8 @@ module Op : sig | Set_target | Reset_watches | Directory_part + | Get_feature + | Set_feature | Invalid val operation_c_mapping : operation array diff --git a/xenbus/xs_ring.ml b/xenbus/xs_ring.ml index be0542b..40aa8a9 100644 --- a/xenbus/xs_ring.ml +++ b/xenbus/xs_ring.ml @@ -14,7 +14,31 @@ * GNU Lesser General Public License for more details. *) -module Server_feature = struct type t = Reconnection end +module Server_feature = struct + type t = Reconnection | Error_indicator | Watch_depth + + (* See xenstore-ring.txt for the required order *) + let bit_mapping = [|Reconnection; Error_indicator; Watch_depth|] + + let bitmap_size = Array.length bit_mapping + + (* See xenstore-ring.txt for bit numbers *) + let feature_to_bit = function + | Reconnection -> + 0 + | Error_indicator -> + 1 + | Watch_depth -> + 2 + + let to_string = function + | Reconnection -> + "Reconnection" + | Error_indicator -> + "Error_indicator" + | Watch_depth -> + "Watch_depth" +end module Server_features = Set.Make (struct type t = Server_feature.t @@ -22,6 +46,25 @@ module Server_features = Set.Make (struct let compare = compare end) +(* Set of features from bitmask *) +let of_cval n = + let features = ref Server_features.empty in + for i = 0 to Server_feature.bitmap_size - 1 do + if (n lsr i) land 1 = 1 then + let feature = Server_feature.bit_mapping.(i) in + features := Server_features.add feature !features + done ; + !features + +(* Bitmask from set of features *) +let to_cval features = + Server_features.fold + (fun feature bitmap -> + let i = Server_feature.feature_to_bit feature in + bitmap lor (1 lsl i) + ) + features 0 + external read : Xenmmap.mmap_interface -> bytes -> int -> int = "ml_interface_read" @@ -37,16 +80,11 @@ external _internal_get_server_features : Xenmmap.mmap_interface -> int [@@noalloc] let get_server_features mmap = - (* NB only one feature currently defined above *) let x = _internal_get_server_features mmap in - if x = 0 then - Server_features.empty - else - Server_features.singleton Server_feature.Reconnection + of_cval x let set_server_features mmap set = - (* NB only one feature currently defined above *) - let x = if set = Server_features.empty then 0 else 1 in + let x = to_cval set in _internal_set_server_features mmap x external close : Xenmmap.mmap_interface -> unit = "ml_interface_close" diff --git a/xenbus/xs_ring.mli b/xenbus/xs_ring.mli new file mode 100644 index 0000000..1cf6ca6 --- /dev/null +++ b/xenbus/xs_ring.mli @@ -0,0 +1,20 @@ +module Server_feature : sig + type t = Reconnection | Error_indicator | Watch_depth + + val to_string : t -> string +end + +module Server_features : module type of Set.Make (struct + type t = Server_feature.t + + let compare = compare end) + +val read : Xenmmap.mmap_interface -> bytes -> int -> int + +val write_substring : Xenmmap.mmap_interface -> string -> int -> int + +val get_server_features : Xenmmap.mmap_interface -> Server_features.t + +val set_server_features : Xenmmap.mmap_interface -> Server_features.t -> unit + +val close : Xenmmap.mmap_interface -> unit