CA-62302

ocaml/idl/datamodel.ml

@@ -2712,6 +2712,14 @@ let host_detach_static_vdis = call
   ~allowed_roles:_R_LOCAL_ROOT_ONLY
   ()
 
+let host_declare_dead = call
+  ~name:"declare_dead"
+	~in_product_since:rel_clearwater
+  ~doc:"Declare that a host is dead. This is a dangerous operation, and should only be called if the administrator is absolutely sure the host is definitely dead"
+  ~params:[Ref _host, "host", "The Host to declare is dead"]
+  ~allowed_roles:_R_POOL_OP
+  ()
+
 let host_forget_data_source_archives = call
   ~name:"forget_data_source_archives"
   ~in_oss_since:None
@@ -4185,6 +4193,7 @@ let host =
 		 host_sync_tunnels;
 		 host_sync_pif_currently_attached;
 		 host_migrate_receive;
+		 host_declare_dead;
 		 ]
       ~contents:
         ([ uid _host;

ocaml/xapi/cli_frontend.ml

@@ -423,6 +423,15 @@ let rec cmdtable_data : (string*cmd_spec) list =
       flags=[];
     };
 
+   "host-declare-dead",
+    {
+      reqd=["uuid"];
+      optn=[];
+      help="Declare that the the host is dead without contacting it explicitly. WARNING: This call is dangerous and can cause data loss if the host is not actually dead";
+      implementation=With_fd Cli_operations.host_declare_dead;
+      flags=[];
+    };
+
    "host-disable",
     {
       reqd=[];

ocaml/xapi/cli_operations.ml

@@ -2765,7 +2765,7 @@ let vm_cd_insert printer rpc session_id params =
 	in
 	ignore(do_vm_op printer rpc session_id op params ["cd-name"])
 
-let host_forget fd printer rpc session_id params =
+let host_careful_op op fd printer rpc session_id params =
 	let uuid = List.assoc "uuid" params in
 	let host = Client.Host.get_by_uuid rpc session_id uuid in
 	let pool = List.hd (Client.Pool.get_all rpc session_id) in
@@ -2774,7 +2774,7 @@ let host_forget fd printer rpc session_id params =
 
 	let force = get_bool_param params "force" in
 
-	let go () = ignore (Client.Host.destroy rpc session_id host) in
+	let go () = ignore (op ~rpc ~session_id ~self:host) in
 
 	if force
 	then go ()
@@ -2788,6 +2788,9 @@ let host_forget fd printer rpc session_id params =
 		then go ()
 	end
 
+let host_forget x = host_careful_op Client.Host.destroy x
+let host_declare_dead x = host_careful_op (fun ~rpc ~session_id ~self -> Client.Host.declare_dead ~rpc ~session_id ~host:self) x
+
 let host_license_view printer rpc session_id params =
 	let host =
 		if List.mem_assoc "host-uuid" params then

ocaml/xapi/message_forwarding.ml

@@ -2107,6 +2107,11 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
 			do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.Host.disable rpc session_id host);
 			Xapi_host_helpers.update_allowed_operations ~__context ~self:host
 
+		let declare_dead ~__context ~host =
+			info "Host.declare_dead: host = '%s'" (host_uuid ~__context host);
+			Local.Host.declare_dead ~__context ~host;
+			Xapi_host_helpers.update_allowed_operations ~__context ~self:host
+
 		let enable ~__context ~host =
 			info "Host.enable: host = '%s'" (host_uuid ~__context host);
 			let local_fn = Local.Host.enable ~host in

ocaml/xapi/xapi_hooks.ml

@@ -37,6 +37,8 @@ let scriptname__host_post_declare_dead = "host-post-declare-dead"
 (* Host Script hook reason codes *)
 let reason__assume_failed = "assume-failed"
 let reason__fenced = "fenced"
+let reason__dbdestroy = "dbdestroy"
+let reason__user = "user"
 (* or clean-shutdown or clean-reboot *)
 
 (* Names of Pool script hooks *)

ocaml/xapi/xapi_host.ml

@@ -615,34 +615,58 @@ let create ~__context ~uuid ~name_label ~name_description ~hostname ~address ~ex
   Db.Host_metrics.set_live ~__context ~self:metrics ~value:(uuid=(Helpers.get_localhost_uuid ()));
   host
 
-let destroy ~__context ~self =
+let precheck_destroy_declare_dead ~__context ~self call =
   (* Fail if the host is still online: the user should either isolate the machine from the network
 	 or use Pool.eject. *)
   let hostname = Db.Host.get_hostname ~__context ~self in
   if is_host_alive ~__context ~host:self then begin
-	error "Host.destroy successfully contacted host %s; host is not offline; refusing to destroy record" hostname;
+	error "Host.%s successfully contacted host %s; host is not offline; refusing to %s" call hostname call;
 	raise (Api_errors.Server_error(Api_errors.host_is_live, [ Ref.string_of self ]))
   end;
 
   (* This check is probably redundant since the Pool master should always be 'alive': *)
   (* It doesn't make any sense to destroy the master's own record *)
   let me = Helpers.get_localhost ~__context in
-  if self=me then raise (Api_errors.Server_error(Api_errors.host_cannot_destroy_self, [ Ref.string_of self ]));
+  if self=me then raise (Api_errors.Server_error(Api_errors.host_is_live, [ Ref.string_of self ]))
+
+
+(* Returns a tuple of lists: The first containing the control domains, and the second containing the regular VMs *)
+let get_resident_vms ~__context ~self =
+  let my_resident_vms = Db.Host.get_resident_VMs ~__context ~self in
+  List.partition (fun vm -> Db.VM.get_is_control_domain ~__context ~self:vm) my_resident_vms
+
+let destroy ~__context ~self =
+  precheck_destroy_declare_dead ~__context ~self "destroy";
 
   (* CA-23732: Block if HA is enabled *)
   let pool = Helpers.get_pool ~__context in
   if Db.Pool.get_ha_enabled ~__context ~self:pool
   then raise (Api_errors.Server_error(Api_errors.ha_is_enabled, []));
 
-  let my_resident_vms = Db.Host.get_resident_VMs ~__context ~self in
-  let my_control_domains, my_regular_vms = List.partition (fun vm -> Db.VM.get_is_control_domain ~__context ~self:vm) my_resident_vms in
+  let my_control_domains, my_regular_vms = get_resident_vms ~__context ~self in
 
   if List.length my_regular_vms > 0
   then raise (Api_errors.Server_error(Api_errors.host_has_resident_vms, [ Ref.string_of self ]));
 
+  (* Call the hook before we destroy the stuff as it will likely need the
+     database records *)
+  Xapi_hooks.host_post_declare_dead ~__context ~host:self ~reason:Xapi_hooks.reason__dbdestroy;
+
   Db.Host.destroy ~__context ~self;
   List.iter (fun vm -> Db.VM.destroy ~__context ~self:vm) my_control_domains
 
+let declare_dead ~__context ~host =
+	precheck_destroy_declare_dead ~__context ~self:host "declare_dead";
+
+	let my_control_domains, my_regular_vms = get_resident_vms ~__context ~self:host in
+
+	Helpers.call_api_functions ~__context (fun rpc session_id -> 
+		List.iter (fun vm -> Client.Client.VM.power_state_reset rpc session_id vm) my_regular_vms);
+
+	Db.Host.set_enabled ~__context ~self:host ~value:false;
+
+	Xapi_hooks.host_post_declare_dead ~__context ~host ~reason:Xapi_hooks.reason__user
+
 let ha_disable_failover_decisions ~__context ~host = Xapi_ha.ha_disable_failover_decisions __context host
 let ha_disarm_fencing ~__context ~host = Xapi_ha.ha_disarm_fencing __context host
 let ha_stop_daemon ~__context ~host = Xapi_ha.ha_stop_daemon __context host

ocaml/xapi/xapi_host.mli

@@ -89,6 +89,7 @@ val create :
   chipset_info:(string * string) list ->
   [ `host ] Ref.t
 val destroy : __context:Context.t -> self:API.ref_host -> unit
+val declare_dead : __context:Context.t -> host:API.ref_host -> unit
 val ha_disable_failover_decisions : __context:'a -> host:'b -> unit
 val ha_disarm_fencing : __context:'a -> host:'b -> unit
 val ha_stop_daemon : __context:'a -> host:'b -> unit

scripts/10resetvdis

@@ -6,15 +6,28 @@
 HOSTUUID=$2
 REASON=$4
 
-# Only reset the VDIs if the host is actually fenced!
-if [ ! $REASON = "fenced" ]; then
-  exit 0
+function reset {
+	echo Resetting VDIs on host $HOSTUUID
+	IFS=","
+	for i in `xe pbd-list host-uuid=$HOSTUUID --minimal`
+	do
+		SR=`xe pbd-param-get uuid=$i param-name=sr-uuid`  
+		"@OPTDIR@/sm/resetvdis.py" $HOSTUUID $SR
+	done
+}
+
+# Only reset the VDIs if the host is actually fenced, or the user has requested it.
+if [ $REASON = "fenced" ]; then
+	reset
+fi
+
+if [ $REASON = "user" ]; then
+	reset
 fi
 
-echo Resetting VDIs on host $HOSTUUID
-IFS=","
-for i in `xe pbd-list host-uuid=$HOSTUUID --minimal`
-do
-   SR=`xe pbd-param-get uuid=$i param-name=sr-uuid`  
-   "@OPTDIR@/sm/resetvdis.py" $HOSTUUID $SR
-done
+if [ $REASON = "dbdestroy" ]; then
+        reset
+fi
+
+
+