diff --git a/Makefile b/Makefile index 62b219df76f..d8a351bf5a3 100644 --- a/Makefile +++ b/Makefile @@ -40,7 +40,7 @@ install: build doc # ocaml/xapi make -C scripts install cp -f _build/install/default/bin/xapi $(DESTDIR)$(SBINDIR)/xapi - scripts/install.sh 755 ocaml/xapi/quicktest $(DESTDIR)$(OPTDIR)/debug + scripts/install.sh 755 ocaml/quicktest/quicktest $(DESTDIR)$(OPTDIR)/debug cp -f _build/install/default/bin/quicktestbin $(DESTDIR)$(OPTDIR)/debug/quicktestbin scripts/install.sh 644 _build/install/default/share/xapi/rbac_static.csv $(DESTDIR)$(OPTDIR)/debug # ocaml/xsh diff --git a/ocaml/perftest/xmlrpcserver.ml b/ocaml/perftest/xmlrpcserver.ml deleted file mode 100644 index b6f2d81815a..00000000000 --- a/ocaml/perftest/xmlrpcserver.ml +++ /dev/null @@ -1,116 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(* - * extremely basic HTTP XMLRPC server - *) - -open Threadext -open Printf -open Http - -module Server = struct - let dispatch_xml req fd xml = - XMLRPC.Success [Xml.Element("value", [], [ Xml.PCData "foo" ])] -end - -module Json = struct - let xmlrpc_to_json x = "" -end - -let whitelist = List.map (fun (obj,msg) -> Datamodel_utils.wire_name ~sync:true obj msg) Datamodel.whitelist -let emergency_call_list = List.map (fun (obj,msg) -> Datamodel_utils.wire_name ~sync:true obj msg) Datamodel.emergency_calls - -let counter = ref 0 -let counter_m = Mutex.create () - -let callback1 is_json req fd body xml = - let call,_ = XMLRPC.From.methodCall xml in - - (* We now have the body string, the xml and the call name, and can also tell *) - (* if we're a master or slave and whether the call came in on the unix domain socket or the tcp socket *) - (* If we're a slave, and the call is from the unix domain socket, and the call *isn't* session.login_with_password, then forward *) - if !Xapi_globs.slave_emergency_mode && (not (List.mem call emergency_call_list)) - then raise !Xapi_globs.emergency_mode_error; - if ((not (Pool_role.is_master ())) && (Context.is_unix_socket fd) && (not (List.mem call whitelist))) - then - Printf.printf "would forward\n" -(* - forward req body xml -*) - else - - if Mutex.execute counter_m (fun () -> incr counter; !counter) mod 100 = 0 then (Printf.printf "."; flush stdout); - - let response = Server.dispatch_xml req fd xml in - let translated = - match is_json,response with - true,XMLRPC.Success [Xml.Element("value",_,[x])] -> XMLRPC.Success [Xml.Element("value",[],[Xml.PCData (Json.xmlrpc_to_json x)])] - | _ -> response - in - XMLRPC.To.methodResponse translated -(* debug(fmt "response = %s" response); *) - - - -let callback req bio = - let fd = Buf_io.fd_of bio in (* fd only used for writing *) - let body = Http_svr.read_body ~limit:Xapi_globs.http_limit_max_rpc_size req bio in - let xml = Xml.parse_string body in - try - let response = Xml.to_bigbuffer (callback1 false req fd (Some body) xml) in - Http_svr.response_fct req ~hdrs:[ "Content-Type: text/xml" ] fd (Bigbuffer.length response) - (fun fd -> Bigbuffer.to_fct response (fun s -> ignore(Unix.write fd s 0 (String.length s)))) - with - | (Api_errors.Server_error (err, params)) -> - Http_svr.response_str req ~hdrs:[ "Content-Type: text/xml" ] fd - (Xml.to_string (XMLRPC.To.methodResponse (XMLRPC.Failure(err, params)))) - - -let register () = Http_svr.add_handler Post "/" callback - -let get_main_ip_address ~__context = - try Pool_role.get_master_address () with _ -> "127.0.0.1" - -(** Start the XML-RPC server. *) -let _ = - let http_port = ref Xapi_globs.default_cleartext_port in - Arg.parse ([ - "-log", Arg.String (fun s -> - if s = "all" then - Logs.set_default Log.Debug [ "stderr" ] - else - Logs.add s [ "stderr" ]), - "open a logger to stderr to the argument key name"; - "-http-port", Arg.Set_int http_port, "set http port"; - ])(fun x -> printf "Warning, ignoring unknown argument: %s" x) - "Receive file uploads by HTTP"; - - printf "Starting server on port %d\n%!" !http_port; - printf "Whitelist length = %d; emergency call list = %d\n" (List.length whitelist) (List.length emergency_call_list); - try - register (); - let sockaddr = Unix.ADDR_INET(Unix.inet_addr_of_string Xapi_globs.ips_to_listen_on, !http_port) in - let inet_sock = Http_svr.bind sockaddr in - let threads = Http_svr.http_svr [ (inet_sock,"ur_inet") ] in - print_endline "Receiving upload requests on:"; - Printf.printf "http://%s:%d/upload\n" (get_main_ip_address ()) !http_port; - flush stdout; - while true do - Thread.delay 10. - done - with - | exn -> (eprintf "Caught exception: %s\n!" - (Printexc.to_string exn)) - - diff --git a/ocaml/quicktest/jbuild b/ocaml/quicktest/jbuild new file mode 100644 index 00000000000..ab7cb3f2871 --- /dev/null +++ b/ocaml/quicktest/jbuild @@ -0,0 +1,38 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters = ["ppx_deriving_rpc"; "ppx_sexp_conv"] + +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| + +(executable + ((name quicktest) + (public_name quicktestbin) + (package xapi) + (flags (:standard -bin-annot %s -warn-error +a-3-4-6-9-27-28-29-52)) + (libraries ( + xapi_internal + )) +)) +|} (flags rewriters) diff --git a/ocaml/xapi/ocamltest.ml b/ocaml/quicktest/ocamltest.ml similarity index 100% rename from ocaml/xapi/ocamltest.ml rename to ocaml/quicktest/ocamltest.ml diff --git a/ocaml/xapi/ocamltest.mli b/ocaml/quicktest/ocamltest.mli similarity index 100% rename from ocaml/xapi/ocamltest.mli rename to ocaml/quicktest/ocamltest.mli diff --git a/ocaml/xapi/quicktest b/ocaml/quicktest/quicktest similarity index 100% rename from ocaml/xapi/quicktest rename to ocaml/quicktest/quicktest diff --git a/ocaml/xapi/quicktest.ml b/ocaml/quicktest/quicktest.ml similarity index 100% rename from ocaml/xapi/quicktest.ml rename to ocaml/quicktest/quicktest.ml diff --git a/ocaml/xapi/quicktest_bvt.ml b/ocaml/quicktest/quicktest_bvt.ml similarity index 100% rename from ocaml/xapi/quicktest_bvt.ml rename to ocaml/quicktest/quicktest_bvt.ml diff --git a/ocaml/xapi/quicktest_cbt.ml b/ocaml/quicktest/quicktest_cbt.ml similarity index 100% rename from ocaml/xapi/quicktest_cbt.ml rename to ocaml/quicktest/quicktest_cbt.ml diff --git a/ocaml/xapi/quicktest_common.ml b/ocaml/quicktest/quicktest_common.ml similarity index 100% rename from ocaml/xapi/quicktest_common.ml rename to ocaml/quicktest/quicktest_common.ml diff --git a/ocaml/xapi/quicktest_encodings.ml b/ocaml/quicktest/quicktest_encodings.ml similarity index 100% rename from ocaml/xapi/quicktest_encodings.ml rename to ocaml/quicktest/quicktest_encodings.ml diff --git a/ocaml/xapi/quicktest_http.ml b/ocaml/quicktest/quicktest_http.ml similarity index 100% rename from ocaml/xapi/quicktest_http.ml rename to ocaml/quicktest/quicktest_http.ml diff --git a/ocaml/xapi/quicktest_import_raw_vdi.ml b/ocaml/quicktest/quicktest_import_raw_vdi.ml similarity index 100% rename from ocaml/xapi/quicktest_import_raw_vdi.ml rename to ocaml/quicktest/quicktest_import_raw_vdi.ml diff --git a/ocaml/xapi/quicktest_lifecycle.ml b/ocaml/quicktest/quicktest_lifecycle.ml similarity index 100% rename from ocaml/xapi/quicktest_lifecycle.ml rename to ocaml/quicktest/quicktest_lifecycle.ml diff --git a/ocaml/xapi/quicktest_ocamltest.ml b/ocaml/quicktest/quicktest_ocamltest.ml similarity index 100% rename from ocaml/xapi/quicktest_ocamltest.ml rename to ocaml/quicktest/quicktest_ocamltest.ml diff --git a/ocaml/xapi/quicktest_ocamltest.mli b/ocaml/quicktest/quicktest_ocamltest.mli similarity index 100% rename from ocaml/xapi/quicktest_ocamltest.mli rename to ocaml/quicktest/quicktest_ocamltest.mli diff --git a/ocaml/xapi/quicktest_storage.ml b/ocaml/quicktest/quicktest_storage.ml similarity index 100% rename from ocaml/xapi/quicktest_storage.ml rename to ocaml/quicktest/quicktest_storage.ml diff --git a/ocaml/xapi/quicktest_vdi_copy.ml b/ocaml/quicktest/quicktest_vdi_copy.ml similarity index 100% rename from ocaml/xapi/quicktest_vdi_copy.ml rename to ocaml/quicktest/quicktest_vdi_copy.ml diff --git a/ocaml/xapi/quicktest_vm_memory_constraints.ml b/ocaml/quicktest/quicktest_vm_memory_constraints.ml similarity index 100% rename from ocaml/xapi/quicktest_vm_memory_constraints.ml rename to ocaml/quicktest/quicktest_vm_memory_constraints.ml diff --git a/ocaml/xapi/quicktest_vm_placement.ml b/ocaml/quicktest/quicktest_vm_placement.ml similarity index 100% rename from ocaml/xapi/quicktest_vm_placement.ml rename to ocaml/quicktest/quicktest_vm_placement.ml diff --git a/ocaml/xapi/alcotest_comparators.ml b/ocaml/tests/alcotest_comparators.ml similarity index 100% rename from ocaml/xapi/alcotest_comparators.ml rename to ocaml/tests/alcotest_comparators.ml diff --git a/ocaml/xapi/at_least_once_more_test.ml b/ocaml/tests/at_least_once_more_test.ml similarity index 100% rename from ocaml/xapi/at_least_once_more_test.ml rename to ocaml/tests/at_least_once_more_test.ml diff --git a/ocaml/xapi/binpack_test.ml b/ocaml/tests/binpack_test.ml similarity index 100% rename from ocaml/xapi/binpack_test.ml rename to ocaml/tests/binpack_test.ml diff --git a/ocaml/xapi/bootloader_test.ml b/ocaml/tests/bootloader_test.ml similarity index 100% rename from ocaml/xapi/bootloader_test.ml rename to ocaml/tests/bootloader_test.ml diff --git a/ocaml/xapi/cancel_tests.ml b/ocaml/tests/cancel_tests.ml similarity index 100% rename from ocaml/xapi/cancel_tests.ml rename to ocaml/tests/cancel_tests.ml diff --git a/ocaml/xapi/has_vendor_device_test.py b/ocaml/tests/has_vendor_device_test.py similarity index 100% rename from ocaml/xapi/has_vendor_device_test.py rename to ocaml/tests/has_vendor_device_test.py diff --git a/ocaml/xapi/http_test.ml b/ocaml/tests/http_test.ml similarity index 100% rename from ocaml/xapi/http_test.ml rename to ocaml/tests/http_test.ml diff --git a/ocaml/tests/jbuild b/ocaml/tests/jbuild new file mode 100644 index 00000000000..24b012ee2e9 --- /dev/null +++ b/ocaml/tests/jbuild @@ -0,0 +1,58 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> +let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in +let ic = Unix.open_process_in +(cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") +in +let rec go ic acc = +try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc +in +go ic "" + +let rewriters = ["ppx_deriving_rpc"; "ppx_sexp_conv"] + +let coverage_rewriter = +let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in +if is_coverage then +"(preprocess (pps (bisect_ppx -conditional)))" +else +"" + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| + + +(executables +((names (suite suite_alcotest)) +(flags (:standard -bin-annot %s -warn-error +a-3-4-6-9-27-28-29-52)) +(libraries ( + xapi_internal + alcotest + oUnit + stdext + threads + )) +%s) +) + +(alias +((name runtest) + (package xapi) +(deps (suite.exe (files_recursively_in test_data))) +(action (run ${<} -runner sequential -verbose true)) +) +) + +(alias +((name runtest) + (package xapi) +(deps (suite_alcotest.exe (files_recursively_in test_data))) +(action (run ${<})) +) +) +|} (flags rewriters) coverage_rewriter diff --git a/ocaml/xapi/mock.ml b/ocaml/tests/mock.ml similarity index 100% rename from ocaml/xapi/mock.ml rename to ocaml/tests/mock.ml diff --git a/ocaml/xapi/mock_rpc.ml b/ocaml/tests/mock_rpc.ml similarity index 100% rename from ocaml/xapi/mock_rpc.ml rename to ocaml/tests/mock_rpc.ml diff --git a/ocaml/xapi/monitor_fake_plugin.ml b/ocaml/tests/monitor_fake_plugin.ml similarity index 100% rename from ocaml/xapi/monitor_fake_plugin.ml rename to ocaml/tests/monitor_fake_plugin.ml diff --git a/ocaml/xapi/ounit_comparators.ml b/ocaml/tests/ounit_comparators.ml similarity index 100% rename from ocaml/xapi/ounit_comparators.ml rename to ocaml/tests/ounit_comparators.ml diff --git a/ocaml/xapi/quicktest_test_ideas.md b/ocaml/tests/quicktest_test_ideas.md similarity index 100% rename from ocaml/xapi/quicktest_test_ideas.md rename to ocaml/tests/quicktest_test_ideas.md diff --git a/ocaml/xapi/storage_impl_test.ml b/ocaml/tests/storage_impl_test.ml similarity index 100% rename from ocaml/xapi/storage_impl_test.ml rename to ocaml/tests/storage_impl_test.ml diff --git a/ocaml/xapi/suite.ml b/ocaml/tests/suite.ml similarity index 100% rename from ocaml/xapi/suite.ml rename to ocaml/tests/suite.ml diff --git a/ocaml/xapi/suite_alcotest.ml b/ocaml/tests/suite_alcotest.ml similarity index 100% rename from ocaml/xapi/suite_alcotest.ml rename to ocaml/tests/suite_alcotest.ml diff --git a/ocaml/xapi/suite_init.ml b/ocaml/tests/suite_init.ml similarity index 100% rename from ocaml/xapi/suite_init.ml rename to ocaml/tests/suite_init.ml diff --git a/ocaml/xapi/test_agility.ml b/ocaml/tests/test_agility.ml similarity index 100% rename from ocaml/xapi/test_agility.ml rename to ocaml/tests/test_agility.ml diff --git a/ocaml/xapi/test_basic.ml b/ocaml/tests/test_basic.ml similarity index 100% rename from ocaml/xapi/test_basic.ml rename to ocaml/tests/test_basic.ml diff --git a/ocaml/xapi/test_ca121350.ml b/ocaml/tests/test_ca121350.ml similarity index 100% rename from ocaml/xapi/test_ca121350.ml rename to ocaml/tests/test_ca121350.ml diff --git a/ocaml/xapi/test_ca91480.ml b/ocaml/tests/test_ca91480.ml similarity index 100% rename from ocaml/xapi/test_ca91480.ml rename to ocaml/tests/test_ca91480.ml diff --git a/ocaml/xapi/test_common.ml b/ocaml/tests/test_common.ml similarity index 100% rename from ocaml/xapi/test_common.ml rename to ocaml/tests/test_common.ml diff --git a/ocaml/xapi/test_cpuid_helpers.ml b/ocaml/tests/test_cpuid_helpers.ml similarity index 100% rename from ocaml/xapi/test_cpuid_helpers.ml rename to ocaml/tests/test_cpuid_helpers.ml diff --git a/ocaml/xapi/test_daemon_manager.ml b/ocaml/tests/test_daemon_manager.ml similarity index 100% rename from ocaml/xapi/test_daemon_manager.ml rename to ocaml/tests/test_daemon_manager.ml diff --git a/ocaml/xapi/test_data/gvt-g-whitelist-1234 b/ocaml/tests/test_data/gvt-g-whitelist-1234 similarity index 100% rename from ocaml/xapi/test_data/gvt-g-whitelist-1234 rename to ocaml/tests/test_data/gvt-g-whitelist-1234 diff --git a/ocaml/xapi/test_data/gvt-g-whitelist-empty b/ocaml/tests/test_data/gvt-g-whitelist-empty similarity index 100% rename from ocaml/xapi/test_data/gvt-g-whitelist-empty rename to ocaml/tests/test_data/gvt-g-whitelist-empty diff --git a/ocaml/xapi/test_data/gvt-g-whitelist-mixed b/ocaml/tests/test_data/gvt-g-whitelist-mixed similarity index 100% rename from ocaml/xapi/test_data/gvt-g-whitelist-mixed rename to ocaml/tests/test_data/gvt-g-whitelist-mixed diff --git a/ocaml/xapi/test_data/mxgpu-whitelist-1234 b/ocaml/tests/test_data/mxgpu-whitelist-1234 similarity index 100% rename from ocaml/xapi/test_data/mxgpu-whitelist-1234 rename to ocaml/tests/test_data/mxgpu-whitelist-1234 diff --git a/ocaml/xapi/test_data/mxgpu-whitelist-empty b/ocaml/tests/test_data/mxgpu-whitelist-empty similarity index 100% rename from ocaml/xapi/test_data/mxgpu-whitelist-empty rename to ocaml/tests/test_data/mxgpu-whitelist-empty diff --git a/ocaml/xapi/test_data/mxgpu-whitelist-mixed b/ocaml/tests/test_data/mxgpu-whitelist-mixed similarity index 100% rename from ocaml/xapi/test_data/mxgpu-whitelist-mixed rename to ocaml/tests/test_data/mxgpu-whitelist-mixed diff --git a/ocaml/xapi/test_data/nvidia-whitelist.xml b/ocaml/tests/test_data/nvidia-whitelist.xml similarity index 100% rename from ocaml/xapi/test_data/nvidia-whitelist.xml rename to ocaml/tests/test_data/nvidia-whitelist.xml diff --git a/ocaml/xapi/test_data/test_vgpu_nosubdevid.conf b/ocaml/tests/test_data/test_vgpu_nosubdevid.conf similarity index 100% rename from ocaml/xapi/test_data/test_vgpu_nosubdevid.conf rename to ocaml/tests/test_data/test_vgpu_nosubdevid.conf diff --git a/ocaml/xapi/test_data/test_vgpu_subdevid.conf b/ocaml/tests/test_data/test_vgpu_subdevid.conf similarity index 100% rename from ocaml/xapi/test_data/test_vgpu_subdevid.conf rename to ocaml/tests/test_data/test_vgpu_subdevid.conf diff --git a/ocaml/xapi/test_datamodel_utils.ml b/ocaml/tests/test_datamodel_utils.ml similarity index 100% rename from ocaml/xapi/test_datamodel_utils.ml rename to ocaml/tests/test_datamodel_utils.ml diff --git a/ocaml/xapi/test_db_lowlevel.ml b/ocaml/tests/test_db_lowlevel.ml similarity index 100% rename from ocaml/xapi/test_db_lowlevel.ml rename to ocaml/tests/test_db_lowlevel.ml diff --git a/ocaml/xapi/test_dbsync_master.ml b/ocaml/tests/test_dbsync_master.ml similarity index 100% rename from ocaml/xapi/test_dbsync_master.ml rename to ocaml/tests/test_dbsync_master.ml diff --git a/ocaml/xapi/test_event.ml b/ocaml/tests/test_event.ml similarity index 100% rename from ocaml/xapi/test_event.ml rename to ocaml/tests/test_event.ml diff --git a/ocaml/xapi/test_event_common.ml b/ocaml/tests/test_event_common.ml similarity index 100% rename from ocaml/xapi/test_event_common.ml rename to ocaml/tests/test_event_common.ml diff --git a/ocaml/xapi/test_event_common.mli b/ocaml/tests/test_event_common.mli similarity index 100% rename from ocaml/xapi/test_event_common.mli rename to ocaml/tests/test_event_common.mli diff --git a/ocaml/xapi/test_extauth_plugin_ADpbis.ml b/ocaml/tests/test_extauth_plugin_ADpbis.ml similarity index 100% rename from ocaml/xapi/test_extauth_plugin_ADpbis.ml rename to ocaml/tests/test_extauth_plugin_ADpbis.ml diff --git a/ocaml/xapi/test_features.ml b/ocaml/tests/test_features.ml similarity index 100% rename from ocaml/xapi/test_features.ml rename to ocaml/tests/test_features.ml diff --git a/ocaml/xapi/test_gpu_group.ml b/ocaml/tests/test_gpu_group.ml similarity index 100% rename from ocaml/xapi/test_gpu_group.ml rename to ocaml/tests/test_gpu_group.ml diff --git a/ocaml/xapi/test_guest_agent.ml b/ocaml/tests/test_guest_agent.ml similarity index 100% rename from ocaml/xapi/test_guest_agent.ml rename to ocaml/tests/test_guest_agent.ml diff --git a/ocaml/xapi/test_ha_vm_failover.ml b/ocaml/tests/test_ha_vm_failover.ml similarity index 100% rename from ocaml/xapi/test_ha_vm_failover.ml rename to ocaml/tests/test_ha_vm_failover.ml diff --git a/ocaml/xapi/test_helpers.ml b/ocaml/tests/test_helpers.ml similarity index 100% rename from ocaml/xapi/test_helpers.ml rename to ocaml/tests/test_helpers.ml diff --git a/ocaml/xapi/test_host.ml b/ocaml/tests/test_host.ml similarity index 100% rename from ocaml/xapi/test_host.ml rename to ocaml/tests/test_host.ml diff --git a/ocaml/xapi/test_http.ml b/ocaml/tests/test_http.ml similarity index 100% rename from ocaml/xapi/test_http.ml rename to ocaml/tests/test_http.ml diff --git a/ocaml/xapi/test_map_check.ml b/ocaml/tests/test_map_check.ml similarity index 100% rename from ocaml/xapi/test_map_check.ml rename to ocaml/tests/test_map_check.ml diff --git a/ocaml/xapi/test_network.ml b/ocaml/tests/test_network.ml similarity index 100% rename from ocaml/xapi/test_network.ml rename to ocaml/tests/test_network.ml diff --git a/ocaml/xapi/test_network_event_loop.ml b/ocaml/tests/test_network_event_loop.ml similarity index 100% rename from ocaml/xapi/test_network_event_loop.ml rename to ocaml/tests/test_network_event_loop.ml diff --git a/ocaml/xapi/test_no_migrate.ml b/ocaml/tests/test_no_migrate.ml similarity index 100% rename from ocaml/xapi/test_no_migrate.ml rename to ocaml/tests/test_no_migrate.ml diff --git a/ocaml/xapi/test_pci_helpers.ml b/ocaml/tests/test_pci_helpers.ml similarity index 100% rename from ocaml/xapi/test_pci_helpers.ml rename to ocaml/tests/test_pci_helpers.ml diff --git a/ocaml/xapi/test_pgpu.ml b/ocaml/tests/test_pgpu.ml similarity index 100% rename from ocaml/xapi/test_pgpu.ml rename to ocaml/tests/test_pgpu.ml diff --git a/ocaml/xapi/test_pgpu_helpers.ml b/ocaml/tests/test_pgpu_helpers.ml similarity index 100% rename from ocaml/xapi/test_pgpu_helpers.ml rename to ocaml/tests/test_pgpu_helpers.ml diff --git a/ocaml/xapi/test_platformdata.ml b/ocaml/tests/test_platformdata.ml similarity index 100% rename from ocaml/xapi/test_platformdata.ml rename to ocaml/tests/test_platformdata.ml diff --git a/ocaml/xapi/test_pool_apply_edition.ml b/ocaml/tests/test_pool_apply_edition.ml similarity index 100% rename from ocaml/xapi/test_pool_apply_edition.ml rename to ocaml/tests/test_pool_apply_edition.ml diff --git a/ocaml/xapi/test_pool_cpuinfo.ml b/ocaml/tests/test_pool_cpuinfo.ml similarity index 100% rename from ocaml/xapi/test_pool_cpuinfo.ml rename to ocaml/tests/test_pool_cpuinfo.ml diff --git a/ocaml/xapi/test_pool_db_backup.ml b/ocaml/tests/test_pool_db_backup.ml similarity index 100% rename from ocaml/xapi/test_pool_db_backup.ml rename to ocaml/tests/test_pool_db_backup.ml diff --git a/ocaml/xapi/test_pool_license.ml b/ocaml/tests/test_pool_license.ml similarity index 100% rename from ocaml/xapi/test_pool_license.ml rename to ocaml/tests/test_pool_license.ml diff --git a/ocaml/xapi/test_pool_restore_database.ml b/ocaml/tests/test_pool_restore_database.ml similarity index 100% rename from ocaml/xapi/test_pool_restore_database.ml rename to ocaml/tests/test_pool_restore_database.ml diff --git a/ocaml/xapi/test_pool_update.ml b/ocaml/tests/test_pool_update.ml similarity index 100% rename from ocaml/xapi/test_pool_update.ml rename to ocaml/tests/test_pool_update.ml diff --git a/ocaml/xapi/test_pr1510.ml b/ocaml/tests/test_pr1510.ml similarity index 100% rename from ocaml/xapi/test_pr1510.ml rename to ocaml/tests/test_pr1510.ml diff --git a/ocaml/xapi/test_pusb.ml b/ocaml/tests/test_pusb.ml similarity index 100% rename from ocaml/xapi/test_pusb.ml rename to ocaml/tests/test_pusb.ml diff --git a/ocaml/xapi/test_pvs_cache_storage.ml b/ocaml/tests/test_pvs_cache_storage.ml similarity index 100% rename from ocaml/xapi/test_pvs_cache_storage.ml rename to ocaml/tests/test_pvs_cache_storage.ml diff --git a/ocaml/xapi/test_pvs_proxy.ml b/ocaml/tests/test_pvs_proxy.ml similarity index 100% rename from ocaml/xapi/test_pvs_proxy.ml rename to ocaml/tests/test_pvs_proxy.ml diff --git a/ocaml/xapi/test_pvs_server.ml b/ocaml/tests/test_pvs_server.ml similarity index 100% rename from ocaml/xapi/test_pvs_server.ml rename to ocaml/tests/test_pvs_server.ml diff --git a/ocaml/xapi/test_pvs_site.ml b/ocaml/tests/test_pvs_site.ml similarity index 100% rename from ocaml/xapi/test_pvs_site.ml rename to ocaml/tests/test_pvs_site.ml diff --git a/ocaml/xapi/test_sdn_controller.ml b/ocaml/tests/test_sdn_controller.ml similarity index 100% rename from ocaml/xapi/test_sdn_controller.ml rename to ocaml/tests/test_sdn_controller.ml diff --git a/ocaml/xapi/test_sm_features.ml b/ocaml/tests/test_sm_features.ml similarity index 100% rename from ocaml/xapi/test_sm_features.ml rename to ocaml/tests/test_sm_features.ml diff --git a/ocaml/xapi/test_sr_update_vdis.ml b/ocaml/tests/test_sr_update_vdis.ml similarity index 100% rename from ocaml/xapi/test_sr_update_vdis.ml rename to ocaml/tests/test_sr_update_vdis.ml diff --git a/ocaml/xapi/test_state.ml b/ocaml/tests/test_state.ml similarity index 100% rename from ocaml/xapi/test_state.ml rename to ocaml/tests/test_state.ml diff --git a/ocaml/xapi/test_storage_migrate_state.ml b/ocaml/tests/test_storage_migrate_state.ml similarity index 100% rename from ocaml/xapi/test_storage_migrate_state.ml rename to ocaml/tests/test_storage_migrate_state.ml diff --git a/ocaml/xapi/test_valid_ref_list.ml b/ocaml/tests/test_valid_ref_list.ml similarity index 100% rename from ocaml/xapi/test_valid_ref_list.ml rename to ocaml/tests/test_valid_ref_list.ml diff --git a/ocaml/xapi/test_vdi_allowed_operations.ml b/ocaml/tests/test_vdi_allowed_operations.ml similarity index 100% rename from ocaml/xapi/test_vdi_allowed_operations.ml rename to ocaml/tests/test_vdi_allowed_operations.ml diff --git a/ocaml/xapi/test_vdi_cbt.ml b/ocaml/tests/test_vdi_cbt.ml similarity index 100% rename from ocaml/xapi/test_vdi_cbt.ml rename to ocaml/tests/test_vdi_cbt.ml diff --git a/ocaml/xapi/test_vgpu_common.ml b/ocaml/tests/test_vgpu_common.ml similarity index 100% rename from ocaml/xapi/test_vgpu_common.ml rename to ocaml/tests/test_vgpu_common.ml diff --git a/ocaml/xapi/test_vgpu_type.ml b/ocaml/tests/test_vgpu_type.ml similarity index 100% rename from ocaml/xapi/test_vgpu_type.ml rename to ocaml/tests/test_vgpu_type.ml diff --git a/ocaml/xapi/test_vlan.ml b/ocaml/tests/test_vlan.ml similarity index 100% rename from ocaml/xapi/test_vlan.ml rename to ocaml/tests/test_vlan.ml diff --git a/ocaml/xapi/test_vm.ml b/ocaml/tests/test_vm.ml similarity index 100% rename from ocaml/xapi/test_vm.ml rename to ocaml/tests/test_vm.ml diff --git a/ocaml/xapi/test_vm_check_operation_error.ml b/ocaml/tests/test_vm_check_operation_error.ml similarity index 100% rename from ocaml/xapi/test_vm_check_operation_error.ml rename to ocaml/tests/test_vm_check_operation_error.ml diff --git a/ocaml/xapi/test_vm_helpers.ml b/ocaml/tests/test_vm_helpers.ml similarity index 100% rename from ocaml/xapi/test_vm_helpers.ml rename to ocaml/tests/test_vm_helpers.ml diff --git a/ocaml/xapi/test_vm_migrate.ml b/ocaml/tests/test_vm_migrate.ml similarity index 100% rename from ocaml/xapi/test_vm_migrate.ml rename to ocaml/tests/test_vm_migrate.ml diff --git a/ocaml/xapi/test_workload_balancing.ml b/ocaml/tests/test_workload_balancing.ml similarity index 100% rename from ocaml/xapi/test_workload_balancing.ml rename to ocaml/tests/test_workload_balancing.ml diff --git a/ocaml/xapi/test_xapi_db_upgrade.ml b/ocaml/tests/test_xapi_db_upgrade.ml similarity index 100% rename from ocaml/xapi/test_xapi_db_upgrade.ml rename to ocaml/tests/test_xapi_db_upgrade.ml diff --git a/ocaml/xapi/test_xapi_vbd_helpers.ml b/ocaml/tests/test_xapi_vbd_helpers.ml similarity index 100% rename from ocaml/xapi/test_xapi_vbd_helpers.ml rename to ocaml/tests/test_xapi_vbd_helpers.ml diff --git a/ocaml/xapi/test_xapi_xenops.ml b/ocaml/tests/test_xapi_xenops.ml similarity index 100% rename from ocaml/xapi/test_xapi_xenops.ml rename to ocaml/tests/test_xapi_xenops.ml diff --git a/ocaml/xapi/test_xenopsd_metadata.ml b/ocaml/tests/test_xenopsd_metadata.ml similarity index 100% rename from ocaml/xapi/test_xenopsd_metadata.ml rename to ocaml/tests/test_xenopsd_metadata.ml diff --git a/ocaml/xapi/testauth.ml b/ocaml/tests/testauth.ml similarity index 100% rename from ocaml/xapi/testauth.ml rename to ocaml/tests/testauth.ml diff --git a/ocaml/xapi/testauthx.ml b/ocaml/tests/testauthx.ml similarity index 100% rename from ocaml/xapi/testauthx.ml rename to ocaml/tests/testauthx.ml diff --git a/ocaml/xapi/tests/NOTES b/ocaml/tests/tests/NOTES similarity index 100% rename from ocaml/xapi/tests/NOTES rename to ocaml/tests/tests/NOTES diff --git a/ocaml/xapi/tests/looper.py b/ocaml/tests/tests/looper.py similarity index 100% rename from ocaml/xapi/tests/looper.py rename to ocaml/tests/tests/looper.py diff --git a/ocaml/xapi/tests/looper2.py b/ocaml/tests/tests/looper2.py similarity index 100% rename from ocaml/xapi/tests/looper2.py rename to ocaml/tests/tests/looper2.py diff --git a/ocaml/xapi/jbuild b/ocaml/xapi/jbuild index b75ef81902b..db0031b2933 100644 --- a/ocaml/xapi/jbuild +++ b/ocaml/xapi/jbuild @@ -67,13 +67,12 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| ) ) -(executables - ((names (xapi_main suite suite_alcotest quicktest)) - (public_names (xapi - - quicktestbin)) - (package xapi) +(library + ((name xapi_internal) + (wrapped false) (flags (:standard -bin-annot %s -warn-error +a-3-4-6-9-27-28-29-52)) + (modules (:standard \ xapi_main)) (libraries ( - alcotest opasswd pam pciutil @@ -82,7 +81,6 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| message-switch-unix mtime mtime.clock.os - oUnit sha tar tar-unix @@ -115,17 +113,14 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| %s) ) -(alias - ((name runtest) - (deps (suite.exe (files_recursively_in test_data))) - (action (run ${<} -runner sequential -verbose true)) - ) -) - -(alias - ((name runtest) - (deps (suite_alcotest.exe (files_recursively_in test_data))) - (action (run ${<})) - ) -) -|} (flags rewriters) coverage_rewriter +(executable + ((name xapi_main) + (public_name xapi) + (package xapi) + (modules (xapi_main)) + (flags (:standard -bin-annot %s -warn-error +a-3-4-6-9-27-28-29-52)) + (libraries ( + xapi_internal + )) +)) +|}(flags rewriters) coverage_rewriter (flags rewriters) diff --git a/ocaml/xapi/upload_receive.ml b/ocaml/xapi/upload_receive.ml deleted file mode 100644 index 83eec3a6651..00000000000 --- a/ocaml/xapi/upload_receive.ml +++ /dev/null @@ -1,43 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -open Printf -open Threadext - -(** Start the XML-RPC server. *) -let _ = - let http_port = ref Xapi_globs.default_cleartext_port in - Arg.parse ([ - "-log", Arg.String (fun s -> - if s = "all" then - Logs.set_default Log.Debug [ "stderr" ] - else - Logs.add s [ "stderr" ]), - "open a logger to stderr to the argument key name"; - "-http-port", Arg.Set_int http_port, "set http port"; - ] @ Debug.args )(fun x -> printf "Warning, ignoring unknown argument: %s" x) - "Receive file uploads by HTTP"; - - printf "Starting server on port %d\n%!" !http_port; - let server = Http_svr.Server.empty in - try - Http_svr.add_handler server Put "/upload" (Http_svr.BufIO Fileupload.upload_file); - let sockaddr = Unix.ADDR_INET(Unix.inet_addr_of_string Xapi_globs.ips_to_listen_on, !http_port) in - let inet_sock = Http_svr.bind sockaddr "inet_rpc" in - Http_svr.start server inet_sock; - print_endline "Receiving upload requests on:"; - Printf.printf "http://%s:%d/upload\n" (Helpers.get_main_ip_address ()) !http_port; - flush stdout; - with - | exn -> (eprintf "Caught exception: %s\n!" - (ExnHelper.string_of_exn exn)) diff --git a/ocaml/xapi/xenstore_copy.ml b/ocaml/xapi/xenstore_copy.ml deleted file mode 100644 index 451966a97ab..00000000000 --- a/ocaml/xapi/xenstore_copy.ml +++ /dev/null @@ -1,34 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(* Simple example program which recursively copies a xenstore subtree to another path. *) - -open Xenstore_dump -open Xenstore - -let _ = - - let src = ref "" and dest = ref "" in - Arg.parse - [ "-src", Arg.Set_string src, "source path"; - "-dest", Arg.Set_string dest, "destination path" ] - (fun x -> Printf.fprintf stderr "Ignoring unknown parameter: %s\n" x) - "Copy a xenstore subtree to another path"; - if !src = "" || !dest = "" then begin - Printf.fprintf stderr "Usage:\n"; - Printf.fprintf stderr " %s \n" Sys.argv.(0); - exit 1 - end; - let xs = Xs.domain_open () in - restore ~xs !dest (dump ~xs !src) - diff --git a/ocaml/xapi/xenstore_dump.ml b/ocaml/xapi/xenstore_dump.ml deleted file mode 100644 index 342d7a6476a..00000000000 --- a/ocaml/xapi/xenstore_dump.ml +++ /dev/null @@ -1,56 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(** Utility functions to dump and partially restore trees of xenstore data to/from XML - which can be used to preserve selected parts of xenstore across suspend/resume/migrate. - - Permissions have to be handled separately. -*) - -open Xstringext -open Xenstore - -exception Invalid_path of string -let handle_enoent f x = try f x with Xs_protocol.Enoent _ -> raise (Invalid_path x) - -let dump ~xs (path: string) : Xml.xml = - let rec ls_R prefix path = - (* Annoyingly xenstore often returns [ "" ] rather than [ ] *) - let files = List.filter (fun x -> x <> "") (handle_enoent xs.Xs.directory path) in - let children = List.map (fun x -> ls_R (Filename.concat prefix x) (Filename.concat path x)) files in - let relative_paths = List.map (Filename.concat prefix) files in - let absolute_paths = List.map (Filename.concat path) files in - let kvpairs = List.map - (fun (relative, absolute) -> relative, handle_enoent xs.Xs.read absolute) - (List.combine relative_paths absolute_paths) in - - List.concat (kvpairs :: children) - in - let all = ls_R "" path in - let list = List.map (fun (k, v) -> Xml.Element("n", [ "path", k; "value", v ], [])) all in - Xml.Element("xenstore-dump", [ "version", "0.1" ], list) - -let restore ~xs (path: string) (dump: Xml.xml) = match dump with - | Xml.Element("xenstore-dump", [ "version", _ ], nodes) -> - let node = function - | Xml.Element("n", attr, _) -> - if not(List.mem_assoc "path" attr) - then failwith "expected path attribute"; - if not(List.mem_assoc "value" attr) - then failwith "expected value attribute"; - List.assoc "path" attr, List.assoc "value" attr - | _ -> failwith "expected element" in - let nodes = List.map node nodes in - xs.Xs.writev path nodes - | _ -> failwith "expected element" - diff --git a/ocaml/xapi/xenstore_dump.mli b/ocaml/xapi/xenstore_dump.mli deleted file mode 100644 index 9c50a58d2c1..00000000000 --- a/ocaml/xapi/xenstore_dump.mli +++ /dev/null @@ -1,21 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -exception Invalid_path of string - -(** Dump a xenstore subtree as XML *) -val dump : xs:Xenstore.Xs.xsh -> string -> Xml.xml - -(** Restore a xenstore subtree from XML at a new path. Permissions are not restored - and therefore will inherit from the parent node. *) -val restore : xs:Xenstore.Xs.xsh -> string -> Xml.xml -> unit