Merge commit 'f0f8d51673920e6a541cc0b8694dc5f1772a56c4'

Makefile

@@ -15,6 +15,7 @@ XEN_RELEASE?=unknown
 endif
 
 BASE_PATH=$(shell scripts/base-path scripts/xapi.conf)
+DISTROTY=$(shell scripts/detect_distro.sh)
 
 JQUERY=$(CARBON_DISTFILES)/javascript/jquery/jquery-1.1.3.1.pack.js
 JQUERY_TREEVIEW=$(CARBON_DISTFILES)/javascript/jquery/treeview/jquery.treeview.zip
@@ -24,7 +25,30 @@ COMPILE_BYTE ?= no
 export COMPILE_NATIVE COMPILE_BYTE
 
 # FHS stuff
-VARDIR=/var/xapi
+ifeq ($(DISTROTY),Debianlike)
+VARDIR=/var/lib/xcp
+VARPATCHDIR=/var/lib/xcp/patch
+ETCDIR=/etc/xcp
+OPTDIR=/usr/lib/xcp
+PLUGINDIR=/usr/lib/xcp/plugins
+HOOKSDIR=/etc/xcp/hook-scripts
+INVENTORY=/etc/xcp/inventory
+XAPICONF=/etc/xcp/xapi.conf
+RRDDCONF=/etc/xcp/rrdd.conf
+LIBEXECDIR=/usr/lib/xcp/lib
+SCRIPTSDIR=/usr/lib/xcp/scripts
+SHAREDIR=/usr/share/xcp
+WEBDIR=/var/www/html
+XHADIR=/opt/xensource/xha
+BINDIR=/usr/lib/xcp/bin
+SBINDIR=/usr/sbin
+UDEVDIR=/lib/udev
+
+OCAMLPATH=/usr/lib/xen-4.1/lib/ocaml:/usr/lib/ocaml/xcp
+EXTRA_INSTALL_PATH=/xcp
+
+else
+VARDIR=/var/lib/xcp
 VARPATCHDIR=/var/patch
 ETCDIR=/etc/xensource
 OPTDIR=/opt/xensource
@@ -40,8 +64,15 @@ WEBDIR=/opt/xensource/www
 XHADIR=/opt/xensource/xha
 BINDIR=/opt/xensource/bin
 SBINDIR=/opt/xensource/bin
+UDEVDIR=/etc/udev
+
+OCAMLPATH=
+EXTRA_INSTALL_PATH=
+
+endif
+
 
-export VARDIR ETCDIR OPTDIR PLUGINDIR HOOKSDIR INVENTORY VARPATCHDIR LIBEXECDIR XAPICONF RRDDCONF SCRIPTSDIR SHAREDIR WEBDIR XHADIR BINDIR SBINDIR
+export VARDIR ETCDIR OPTDIR PLUGINDIR HOOKSDIR INVENTORY VARPATCHDIR LIBEXECDIR XAPICONF RRDDCONF SCRIPTSDIR SHAREDIR WEBDIR XHADIR BINDIR SBINDIR UDEVDIR OCAMLPATH EXTRA_INSTALL_PATH
 
 .PHONY: all
 all: version ocaml/fhs.ml
@@ -144,6 +175,8 @@ version:
 
 ocaml/fhs.ml :
 	@printf "(* This file is autogenerated by xen-api.git/Makefile *)\n \
+	type t = Debianlike | Centoslike\n \
+	let distroty = $(DISTROTY)\n \
 	let vardir=\"$(VARDIR)\"\n \
 	let etcdir=\"$(ETCDIR)\"\n \
 	let optdir=\"$(OPTDIR)\"\n \

OMakefile

@@ -47,7 +47,7 @@ if $(not $(defined-env DESTDIR))
 
 
 if $(not $(defined-env VARDIR))
-  VARDIR=/var/xapi
+  VARDIR=/var/lib/xcp
   export
 if $(not $(defined-env VARPATCHDIR))
   VARPATCHDIR=/var/patch
@@ -163,8 +163,6 @@ OCAML_PHASE3_XEN = \
 	ocaml/xenops/cancel_utils_test \
 	ocaml/xenguest/xenguest \
 	ocaml/xenguest/dumpcore \
-	ocaml/xiu/libxenctrl_xiu.so \
-	ocaml/xiu/xiu \
 	ocaml/xapi/quicktestbin \
 	ocaml/xapi/sparse_dd \
 	ocaml/xapi/storage_impl_test \

ocaml/OMakefile

@@ -27,7 +27,6 @@ OCamlLibrary(fhs, fhs)
 	database \
 	toplevel \
 	xstest \
-	xiu \
 	cdrommon \
 	gpg \
 	db_process \

ocaml/idl/OMakefile

@@ -103,7 +103,7 @@ META: META.in
 	sed 's/@VERSION@/$(PRODUCT_VERSION)/g' < $< > $@
 
 if $(defined-env DESTDIR)
-	INSTALL_PATH = $(DESTDIR)/$(shell ocamlfind printconf destdir)
+	INSTALL_PATH = $(DESTDIR)/$(shell ocamlc -where)$(EXTRA_INSTALL_PATH)
 	export
 else
 	INSTALL_PATH = $(shell ocamlfind printconf destdir)

ocaml/idl/datamodel.ml

@@ -441,9 +441,9 @@ let _ =
   error Api_errors.pif_does_not_allow_unplug [ "PIF" ]
     ~doc:"The operation you requested cannot be performed because the specified PIF does not allow unplug." ();
   error Api_errors.pif_has_no_network_configuration [ ]
-    ~doc:"PIF has no IP configuration (mode curently set to 'none')" ();
+    ~doc:"PIF has no IP configuration (mode currently set to 'none')" ();
   error Api_errors.pif_has_no_v6_network_configuration [ ]
-    ~doc:"PIF has no IPv6 configuration (mode curently set to 'none')" ();
+    ~doc:"PIF has no IPv6 configuration (mode currently set to 'none')" ();
   error Api_errors.pif_incompatible_primary_address_type [ ]
     ~doc:"The primary address types are not compatible" ();
   error Api_errors.cannot_plug_bond_slave ["PIF"]
@@ -5719,7 +5719,7 @@ let pool_recover_slaves = call
   ~in_oss_since:None
   ~in_product_since:rel_rio
   ~params:[]
-  ~result:(Set (Ref _host), "list of hosts whose master address were succesfully reset")
+  ~result:(Set (Ref _host), "list of hosts whose master address were successfully reset")
   ~doc:"Instruct a pool master, M, to try and contact its slaves and, if slaves are in emergency mode, reset their master address to M."
   ~allowed_roles:_R_POOL_OP
   ()

ocaml/idl/ocaml_backend/OMakefile

@@ -155,7 +155,7 @@ META: META.in
 	sed 's/@VERSION@/$(PRODUCT_VERSION)/g' < $< > $@
 
 if $(defined-env DESTDIR)
-	INSTALL_PATH = $(DESTDIR)/$(shell ocamlfind printconf destdir)
+	INSTALL_PATH = $(DESTDIR)/$(shell ocamlc -where)$(EXTRA_INSTALL_PATH)
 	export
 else
 	INSTALL_PATH = $(shell ocamlfind printconf destdir)
@@ -164,7 +164,7 @@ else
 DATAMODEL_PACK_DIR=/tmp/xapi-datamodel
 
 lib-install: META
-	mkdir -p $(INSTALL_PATH)
+	mkdir -p $(INSTALL_PATH)/stublibs
 	ocamlfind install -destdir $(INSTALL_PATH) -ldconf ignore xapi-client META $(addsuffixes .cmi, $(XAPI_CLIENT_OBJS)) $(if $(BYTE_ENABLED), xapi_client.cma) $(if $(NATIVE_ENABLED), xapi_client.cmxa xapi_client.a $(addsuffixes .cmx, $(XAPI_CLIENT_OBJS)))
 
 .PHONY: lib-uninstall

ocaml/network/network_utils.ml

@@ -28,7 +28,7 @@ let ovs_vsctl = "/usr/bin/ovs-vsctl"
 let ovs_ofctl = "/usr/bin/ovs-ofctl"
 let ovs_appctl = "/usr/bin/ovs-appctl"
 let ovs_vlan_bug_workaround = "/usr/sbin/ovs-vlan-bug-workaround"
-let brctl = "/usr/sbin/brctl"
+let brctl = match Fhs.distroty with | Fhs.Debianlike -> "/sbin/brctl" | Fhs.Centoslike -> "/usr/sbin/brctl"
 let modprobe = "/sbin/modprobe"
 let ethtool = "/sbin/ethtool"
 let bonding_dir = "/proc/net/bonding/"

ocaml/rrdd/rrdd_server.ml

@@ -312,13 +312,16 @@ module Plugin = struct
 			Hashtbl.add open_files path fd;
 			fd
 
-	(* A function that reads using Unix.read a string of specified length from
-	 * the specified file. *)
+	(* A function that reads using Unixext.really_read a string of specified
+	 * length from the specified file. *)
 	let read_string ~(fd : Unix.file_descr) ~(length : int) : string =
-		let buffer = String.create length in
-		let read = Unix.read fd buffer 0 length in
-		if read <> length then raise Read_error;
-		buffer
+		try
+			(* CA-92154: use Unixext.really_read since Unix.read will
+			 * not read a string longer than 16384 bytes *)
+			Unixext.really_read_string fd length
+		with _ ->
+			log_backtrace ();
+			raise Read_error
 
 	(* The payload type that corresponds to the plugin output file format. *)
 	type payload = {

ocaml/rrdd/rrdd_stats.ml

@@ -139,11 +139,20 @@ let print_system_stats () =
 	let current_offset = Unix.gettimeofday () -. (Int64.to_float (Oclock.gettime Oclock.monotonic) /. 1e9) in
 	debug "Clock drift: %.0f" (current_offset -. initial_offset)
 
+let pidof_path = 
+	try 
+		let path = List.hd (List.filter (fun x -> try ignore (Unix.stat x); true with _ -> false) ["/sbin/pidof";"/bin/pidof"]) in
+		debug "Located pidof: %s" path;
+		Some path
+	with _ -> 
+		None
+
+
 (* Obtains process IDs for the specified program.
  * This should probably be moved into xen-api-libs. *)
 let pidof ~(program : string) : int list =
 	try
-		let pidof_path = "/sbin/pidof" in
+		let pidof_path = Opt.unbox pidof_path in
 		let out, _ = Forkhelpers.execute_command_get_output pidof_path [program] in
 		let lines = String.split '\n' out in
 		let get_pids_from_line acc line =
@@ -154,7 +163,9 @@ let pidof ~(program : string) : int list =
 			acc @ pids
 		in
 		List.fold_left get_pids_from_line [] lines
-	with Forkhelpers.Spawn_internal_error (_, _, _) -> []
+	with
+		| Forkhelpers.Spawn_internal_error (_, _, _) -> []
+		| Not_found -> []
 
 let print_stats_for ~program =
 	let pids = pidof ~program in

ocaml/test/OMakefile

@@ -27,5 +27,6 @@ OCAML_OBJS = \
 	test_basic \
 	test_pool_db_backup \
 	test_xapi_db_upgrade \
+	test_ca91480 \
 
 OCamlProgram(suite, suite $(OCAML_OBJS) )

ocaml/test/suite.ml

@@ -45,6 +45,7 @@ let base_suite =
 			test_basic;
 			test_db_backup;
 			test_db_upgrade;
+			Test_ca91480.test;
 		]
 
 let _ = run_test_tt_main base_suite

ocaml/test/test_ca91480.ml

@@ -0,0 +1,32 @@
+(* Fixture: Create DB with VM. VM has records for Blobs, Appliances,
+   VBDs, VIFs, VGPUs, PCIs, VM_metrics, and VM_guest_metrics, but none
+   of these objects should actually exist in the DB.  *)
+
+open OUnit
+open Test_common
+
+let setup_fixture () =
+	let __context = make_test_database () in
+	let self = make_vm ~__context () in
+
+	let fake_v f = f ~__context ~self ~value:(Ref.make ())
+	and fake_m f = f ~__context ~self ~key:"fake" ~value:(Ref.make ())
+	and fake_l f = f ~__context ~self ~value:[(Ref.make ())] in
+
+	fake_m Db.VM.add_to_blobs ;
+	fake_v Db.VM.set_appliance ;
+	fake_l Db.VM.set_attached_PCIs ;
+	fake_v Db.VM.set_metrics ;
+	fake_v Db.VM.set_guest_metrics ;
+
+	__context, self
+
+let test_vm_destroy () =
+	let __context, self = setup_fixture () in
+	Xapi_vm_helpers.destroy ~__context ~self
+
+let test =
+	"test_ca91480" >:::
+		[
+			"test_vm_destroy" >:: test_vm_destroy;
+		]

ocaml/xapi/cancel_tasks.ml

@@ -32,18 +32,22 @@ let update_all_allowed_operations ~__context =
 	and all_srs = Db.SR.get_all ~__context
 	and all_pbds = Db.PBD.get_all ~__context
 	and all_hosts = Db.Host.get_all ~__context in
+	(* VM *)
 	time_this "Cancel_tasks.update_all_allowed_operations: VM" (fun () ->
 		debug "Updating allowed operations: VM";
 		List.iter (safe_wrapper "allowed_ops - VMs" (fun self -> Xapi_vm_lifecycle.update_allowed_operations ~__context ~self)) all_vms;
 		debug "Finished updating allowed operations: VM");
+	(* VBD *)
 	time_this "Cancel_tasks.update_all_allowed_operations: VBD" (fun () ->
 		debug "Updating allowed operations: VBD";
 		List.iter (safe_wrapper "allowed_ops - VBDs" (fun self -> Xapi_vbd_helpers.update_allowed_operations ~__context ~self)) all_vbds;
 		debug "Finished updating allowed operations: VBD");
+	(* VIF *)
 	time_this "Cancel_tasks.update_all_allowed_operations: VIF" (fun () ->
 		debug "Updating allowed operations: VIF";
 		List.iter (safe_wrapper "allowed_ops - VIFs" (fun self -> Xapi_vif_helpers.update_allowed_operations ~__context ~self)) all_vifs;
 		debug "Finished updating allowed operations: VIF");
+	(* VDI *)
 	time_this "Cancel_tasks.update_all_allowed_operations: VDI" (fun () ->
 		debug "Updating allowed operations: VDI";
 		let sr_records = List.map (fun sr -> (sr, Db.SR.get_record_internal ~__context ~self:sr)) all_srs in
@@ -52,15 +56,18 @@ let update_all_allowed_operations ~__context =
 		List.iter (safe_wrapper "allowed_ops - VDIs"
 			(fun self -> Xapi_vdi.update_allowed_operations_internal ~__context ~self ~sr_records ~pbd_records ~vbd_records)) all_vdis;
 		debug "Finished updating allowed operations: VDI");
+	(* SR *)
 	time_this "Cancel_tasks.update_all_allowed_operations: SR" (fun () ->
 		debug "Updating allowed operations: SR";
 		List.iter (safe_wrapper "allowed_ops" (fun self ->
 			Db.SR.set_current_operations ~__context ~self ~value:[];
 			Xapi_sr_operations.update_allowed_operations ~__context ~self)) all_srs;
-			debug "Finished updating allowed operations: SR";
-			debug "Updating allowed operations: host";
-			List.iter (safe_wrapper "allowed_ops - host" (fun self -> Xapi_host_helpers.update_allowed_operations ~__context ~self)) all_hosts;
-			debug "Finished updating allowed operations: host")
+		debug "Finished updating allowed operations: SR");
+	(* Host *)
+	time_this "Cancel_tasks.update_all_allowed_operations: host" (fun () ->
+		debug "Updating allowed operations: host";
+		List.iter (safe_wrapper "allowed_ops - host" (fun self -> Xapi_host_helpers.update_allowed_operations ~__context ~self)) all_hosts;
+		debug "Finished updating allowed operations: host")
 
 (* !!! This code was written in a world when tasks, current_operations and allowed_operations were persistent.
    This is no longer the case (we changed this to reduce writes to flash for OEM case + to simplify xapi logic elsewhere).

ocaml/xapi/import.ml

@@ -1328,6 +1328,12 @@ let handler (req: Request.t) s _ =
 															List.iter (fun (extid, intid, size) -> debug "Expecting to import VDI %s into %s (size=%Ld)" extid (Ref.string_of intid) size) vdis;
 															let checksum_table = Stream_vdi.recv_all refresh_session s __context rpc session_id header.version force vdis in
 
+															(* CA-48768: Stream_vdi.recv_all only checks for task cancellation
+															   every ten seconds, so we need to check again now. After this
+															   point, we disable cancellation for this task. *)
+															TaskHelper.exn_if_cancelling ~__context;
+															TaskHelper.set_not_cancellable ~__context;
+
 															(* Pre-miami GA exports have a checksum table at the end of the export. Check the calculated checksums *)
 															(* against the table here. Nb. Rio GA-Miami B2 exports get their checksums checked twice! *)
 															if header.version.export_vsn < 2 then

ocaml/xapi/message_forwarding.ml

@@ -2860,7 +2860,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
 			do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.PIF.scan rpc session_id host)
 
 		let introduce ~__context ~host ~mAC ~device =
-			info "PIF.introduce: host = '%s'; MAC adress = '%s'; device = '%s'" (host_uuid ~__context host) mAC device;
+			info "PIF.introduce: host = '%s'; MAC address = '%s'; device = '%s'" (host_uuid ~__context host) mAC device;
 			let local_fn = Local.PIF.introduce ~host ~mAC ~device in
 			do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.PIF.introduce rpc session_id host mAC device)
 

ocaml/xapi/pool_db_backup.ml

@@ -44,7 +44,7 @@ let write_database (s: Unix.file_descr) ~__context =
 let version_check db =
 	let major, minor = Manifest.schema (Database.manifest db) in
 	if major <> Datamodel.schema_major_vsn || minor <> Datamodel.schema_minor_vsn then begin
-		error "Pool backup file was created with incompatable product version";
+		error "Pool backup file was created with incompatible product version";
 		raise (Api_errors.Server_error(Api_errors.restore_incompatible_version, []))
     end 
 

ocaml/xapi/storage_impl.ml

@@ -831,7 +831,7 @@ module Local_domain_socket = struct
 end
 
 open Xmlrpc_client
-let local_url = Http.Url.(File { path = "/var/xapi/storage" }, { uri = "/"; query_params = [] })
+let local_url = Http.Url.(File { path = Filename.concat Fhs.vardir "storage" }, { uri = "/"; query_params = [] })
 
 let rpc ~srcstr ~dststr url call =
 	XMLRPC_protocol.rpc ~transport:(transport_of_url url)

ocaml/xapi/storage_migrate.ml

@@ -24,7 +24,7 @@ open Pervasiveext
 open Xmlrpc_client
 open Threadext
 
-let local_url = Http.Url.(File { path = "/var/xapi/storage" }, { uri = "/"; query_params = [] })
+let local_url = Http.Url.(File { path = Filename.concat Fhs.vardir "storage" }, { uri = "/"; query_params = [] })
 let remote_url ip = Http.Url.(Http { host=ip; auth=None; port=None; ssl=true }, { uri = "/services/SM"; query_params=["pool_secret",!Xapi_globs.pool_secret] } )
 
 open Storage_interface

ocaml/xapi/xapi_message.ml

@@ -305,7 +305,7 @@ let write ~__context ~_ref ~message =
 			gen := Db_cache_types.Manifest.generation (Db_cache_types.Database.manifest db);
 			Db_cache_types.Database.increment db));
 
-	Unixext.mkdir_safe message_dir 0o700;
+	Unixext.mkdir_rec message_dir 0o700;
 	let timestamp = ref (Date.to_float (message.API.message_timestamp)) in
 
 	if message_exists () then (Some (message_gen ()))

ocaml/xapi/xapi_mgmt_iface.ml

@@ -36,7 +36,7 @@ let update_mh_info interface =
 
 let restart_stunnel () =
 	let (_ : Thread.t) = Thread.create (fun () ->
-		Forkhelpers.execute_command_get_output "/sbin/service" [ "xapissl"; "restart" ]) () in
+		Forkhelpers.execute_command_get_output (Filename.concat Fhs.libexecdir "xapissl") [ "restart" ]) () in
 	()
 
 let stop () =

ocaml/xapi/xapi_pool.ml

@@ -1307,7 +1307,7 @@ let revalidate_subjects ~__context =
 (* calling Host.enable_external_auth with the specified parameters in turn on each of the hosts in the pool
     * The call fails immediately if any of the pool hosts already have external auth enabled (must disable first)
     * If a call to a single host to enable external auth fails, then Pool.enable_external_auth fails, and there is
-      a best-effort attempt to disable any hosts who had their external auth succesfully enabled before the failure occured
+      a best-effort attempt to disable any hosts who had their external auth successfully enabled before the failure occured
 *)
 let enable_external_auth ~__context ~pool ~config ~service_name ~auth_type =