Left base folder: D:\eng_usr\gsurka\XAPI\mnr25272-ocaml-base
Right base folder: D:\eng_usr\gsurka\XAPI\mnr25272-ocaml-mtc

File: xapi\dbsync_slave.ml
624c624,625
<        let mark_as_attached = is_management_pif || was_pif_brought_up_at_start_of_day in
---
>        let mark_as_attached = is_management_pif || was_pif_brought_up_at_start_of_day || 
>                               (Mtc.is_pif_attached_to_mtc_vms_and_should_not_be_offline ~__context ~self) in

File: xapi\message_forwarding.ml
2699a2700
>               if not (Mtc.is_vdi_accessed_by_protected_VM ~__context ~vdi:self) then begin
2701a2703
>               end;

File: xapi\mtc.ml
33a34,43
> module Internal = struct
> 
> let read_one_line file =
> 	let inchan = open_in file in
> 	try
> 		let result = input_line inchan in
> 		close_in inchan;
> 		result
> 	with exn -> close_in inchan; raise exn
> end
54a65,66
> let mtc_pvm_key = "mtc_pvm"
> let mtc_vdi_share_key = "mtc_vdi_shareable"
243d254
<   if (is_this_vm_protected ~__context ~self) then (
251d261
<   )
257d266
<   if (is_this_vm_protected ~__context ~self) then (
290d298
<   ) else `ACKED 
306a315,385
> 
> 
> 
> (* 
>  * -----------------------------------------------------------------------------
>  *  Network Functions
>  * -----------------------------------------------------------------------------
>  *)
> (* Determine if we should allow the specified PIF to be marked not online when XAPI is
>  * restarted.  Returns TRUE if this is a PIF fielding a VIF attached to an MTC-
>  * protected VM and we don't want it marked offline because we have checked here that the
>  * PIF and its bridge are already up.
>  *)
> let is_pif_attached_to_mtc_vms_and_should_not_be_offline ~__context ~self =
>   try 
> 
>     (* Get the VMs that are hooked up to this PIF *)
>     let network = Db.PIF.get_network ~__context ~self in
>     let vifs = Db.Network.get_VIFs ~__context ~self:network in
> 
> 
>     (* Figure out the VIFs attached to local MTC VMs and then derive their networks, bridges and PIFs *)
>     let vms = List.map (fun vif -> 
>                         Db.VIF.get_VM ~__context ~self:vif)
>                         vifs in
>     let localhost = Helpers.get_localhost ~__context in
>     let resident_vms = List.filter (fun vm  -> 
>                                     localhost = (Db.VM.get_resident_on ~__context ~self:vm)) 
>                                     vms in
>     let protected_vms = List.filter (fun vm  -> 
>                                      List.mem_assoc mtc_pvm_key (Db.VM.get_other_config ~__context ~self:vm)) 
>                                      resident_vms in
> 
>     let protected_vms_uuid = List.map (fun vm  -> 
>                                        Db.VM.get_uuid ~__context ~self:vm) 
>                                        protected_vms in
> 
> 
>     (* If we have protected VMs using this PIF, then decide whether it should be marked offline *)
>     if protected_vms <> [] then begin
>       let current = Netdev.network.Netdev.list () in
>       let bridge = Db.Network.get_bridge ~__context ~self:network in
>       let nic = Db.PIF.get_device ~__context ~self in
>       debug "The following MTC VMs are using %s for PIF %s: [%s]" 
>              nic
>              (Db.PIF.get_uuid ~__context ~self)
>              (String.concat "; " protected_vms_uuid);
> 
>       let nic_device_path = Printf.sprintf "/sys/class/net/%s/operstate" nic in
>       let nic_device_state = Internal.read_one_line nic_device_path in
> 
>       let bridge_device_path = Printf.sprintf "/sys/class/net/%s/operstate" bridge in
>       let bridge_device_state = Internal.read_one_line bridge_device_path in
> 
>       (* The PIF should be marked online if:
>          1) its network has a bridge created in dom0 and
>          2) the bridge link is up and
>          3) the physical NIC is up and
>          4) the bridge operational state is up (unknown is also up).
>        *)
>        let mark_online = (List.mem bridge current) && 
>                          (Netdev.Link.is_up bridge) && 
>                           nic_device_state = "up" &&
>                           (bridge_device_state = "up" ||
>                           bridge_device_state = "unknown") in
> 
>        debug "Its current operational state is %s.  Therefore we'll be marking it as %s" 
>               nic_device_state (if mark_online then "online" else "offline");
>        mark_online
>     end else false
>   with _ -> false
330a410,428
> (* Raises an exception if the destination VM is not in the expected power state:  halted *)
> let verify_dest_vm_power_state ~__context ~vm =
>   let actual = Db.VM.get_power_state ~__context ~self:vm in
>   if actual != `Halted then
>     raise(Api_errors.Server_error(Api_errors.vm_bad_power_state, [Ref.string_of vm; "halted"; (Record_util.power_to_string actual)]))
> 
> (* Returns true if VDI is accessed by an MTC-protected VM *)
> let is_vdi_accessed_by_protected_VM ~__context ~vdi =
> 
>   let uuid = Uuid.of_string (Db.VDI.get_uuid ~__context ~self:vdi) in
> 
>   let protected_vdi = List.mem_assoc mtc_vdi_share_key (Db.VDI.get_other_config ~__context ~self:vdi) in
> 
>   (* Return TRUE if this VDI is attached to a protected VM *)
>   if protected_vdi then begin
>      debug "VDI %s is attached to a Marathon-protected VM" (Uuid.to_string uuid);
>      true 
>   end else
>      false

File: xapi\storage_access.ml
185,186c186,188
< 	   if is_already_attached uuid && (mode <> get_mode uuid) then
---
>            (* MTC: A protected VM needs to have its disks mounted into two VMs: one as R+W and another as RO *)
> 	   if is_already_attached uuid && (mode <> get_mode uuid) && 
>              not (Mtc.is_vdi_accessed_by_protected_VM ~__context ~vdi:self) then

File: xapi\vmops.ml
788c788
< let clean_shutdown_with_reason ?(at = fun _ -> ()) ~xal ~__context ~self domid reason =
---
> let clean_shutdown_with_reason ?(at = fun _ -> ()) ~xal ~__context ~self ?(rel_timeout = 5.) domid reason =
825,826c826,827
<       result := Some (Xal.wait_release xal ~timeout:5. domid);
---
>       debug "MTC: calling xal.wait_release timeout=%f" rel_timeout;
>       result := Some (Xal.wait_release xal ~timeout:rel_timeout domid);

File: xapi\xapi_vm_migrate.ml
111a112,115
> 
>   if TaskHelper.is_cancelling ~__context
>     then raise (Api_errors.Server_error(Api_errors.task_cancelled, [ Ref.string_of (Context.get_task_id __context) ]));
> 
122c126,128
<   Mtc.event_notify_entering_suspend ~__context ~self;
---
> 
>   if TaskHelper.is_cancelling ~__context
>     then raise (Api_errors.Server_error(Api_errors.task_cancelled, [ Ref.string_of (Context.get_task_id __context) ]));
123,124c130,132
<   let ack = Mtc.event_wait_entering_suspend_acked ~timeout:60. ~__context ~self in
---
>   if (Mtc.is_this_vm_protected ~__context ~self) then (
>     Mtc.event_notify_entering_suspend ~__context ~self;
>     let ack = Mtc.event_wait_entering_suspend_acked ~timeout:60. ~__context ~self in
126c134
<   (* If we got the ack, then proceed to shutdown the domain with the suspend
---
>     (* If we got the ack, then proceed to shutdown the domain with the suspend
129,132c137,140
<   if (ack = `ACKED) then begin
<     match Vmops.clean_shutdown_with_reason ~xal ~__context ~self domid Domain.Suspend with
< 	| Xal.Suspended -> () (* good *)
< 	| Xal.Crashed ->
---
>     if (ack = `ACKED) then begin
>       match Vmops.clean_shutdown_with_reason ~xal ~__context ~self ~rel_timeout:0.25 domid Domain.Suspend with
> 	  | Xal.Suspended -> () (* good *)
> 	  | Xal.Crashed ->
134,137c142,145
< 	| Xal.Rebooted ->
< 		  raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of self ]))	
< 	| Xal.Vanished
< 	| Xal.Halted ->
---
> 	  | Xal.Rebooted ->
> 		  raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of self ]))
> 	  | Xal.Vanished
> 	  | Xal.Halted ->
139,141c147,153
< 	| Xal.Shutdown x -> vm_migrate_failed (Printf.sprintf "Domain shutdown for unexpected reason: %d" x)
<   end else 
<     vm_migrate_failed "Failed to receive suspend acknowledgement within timeout period or an abort was requested."
---
> 	  | Xal.Shutdown x -> vm_migrate_failed (Printf.sprintf "Domain shutdown for unexpected reason: %d" x)
>      end else 
>        vm_migrate_failed "Failed to receive suspend acknowledgement within timeout period or an abort was requested."
>   ) else (
>       Vmops.clean_shutdown_with_reason ~xal ~__context ~self domid Domain.Suspend;
>       ()
>   )
254a267,272
> 
>     (* Recover an MTC VM if abort was requested during the suspended phase *)
>     if Mtc.event_check_for_abort_req ~__context ~self:vm then ( 
>        vm_migrate_failed  "An external abort event was detected during the VM suspend phase.";
>     );
> 
304,308c322,328
< 
< 	   (* Now send across the RRD *)
< 	   (try Monitor_rrds.migrate_push ~__context (Db.VM.get_uuid ~__context ~self:vm) host with e ->
< 	     debug "Caught exception while trying to push rrds: %s" (ExnHelper.string_of_exn e);
< 	     log_backtrace ());
---
>            (* MTC: don't send RRDs since MTC VMs are not really migrated. *)
>  	   if not (Mtc.is_this_vm_protected ~__context ~self:vm) then (
> 	     (* Now send across the RRD *)
> 	     (try Monitor_rrds.migrate_push ~__context (Db.VM.get_uuid ~__context ~self:vm) host with e ->
> 	       debug "Caught exception while trying to push rrds: %s" (ExnHelper.string_of_exn e);
> 	       log_backtrace ());
>            );
314c334,339
< 	   Handshake.recv_success fd
---
> 	   Handshake.recv_success fd;
>  	   if Mtc.is_this_vm_protected ~__context ~self:vm then (
> 	     let hvm = Helpers.has_booted_hvm ~__context ~self:vm in
>  	     debug "Sender 7a. resuming source domain";
> 	     Domain.resume ~xc ~xs ~hvm ~cooperative:true domid 
> 	   );
319,320c345,347
< 	   Xapi_vm_lifecycle.force_state_reset ~__context ~self:vm ~value:`Halted;
---
>            (* MTC: don't reset state upon failure.  MTC VMs will simply resume *)
>  	   if not (Mtc.is_this_vm_protected ~__context ~self:vm) then 
>  	     Xapi_vm_lifecycle.force_state_reset ~__context ~self:vm ~value:`Halted;
323a351,353
>  	 if Mtc.is_this_vm_protected ~__context ~self:vm then (
> 	    debug "MTC: Sender won't clean up by destroying remains of local domain";
>          ) else (
331a362
> 	)
569a601,603
>            (* Set the task allowed_operations to include cancel *)
>            TaskHelper.set_cancellable ~__context;
> 
636a671,678
>  	          with_xc_and_xs (fun xc xs -> 
>                       if Mtc.is_this_vm_protected ~__context ~self:vm then (
>  	                debug "MTC: exception encountered.  Resuming source domain";
>                         let domid = Int64.to_int (Db.VM.get_domid ~__context ~self:vm) in
> 			let hvm = Helpers.has_booted_hvm ~__context ~self:vm in
> 			Domain.resume ~xc ~xs ~hvm ~cooperative:true domid 
> 	              ));
> 
804a847,850
>                         (* MTC-3009: The dest VM of a Marathon protected VM MUST be in halted state. *)
>                         if Mtc.is_this_vm_protected ~__context ~self:dest_vm then (
> 		           Mtc.verify_dest_vm_power_state ~__context ~vm:dest_vm
>                         );

File: xenguest\xenguest_main.ml
156a157,158
> 
> 	Sys.set_signal Sys.sigterm (Sys.Signal_handle (fun i -> debug "Signal handler killing PID=%d" pid; Unix.kill pid Sys.sigterm));

File: xenops\device.ml
1400,1401c1401,1405
< 		Watch.wait_for ~xs (Watch.value_to_become pw state)
---
>                (* MTC: The default timeout for this operation was 20mins, which is
>                 * way too long for our software to recover successfully.
>                 * Talk to Citrix about this
>                 *) 
> 		Watch.wait_for ~xs ~timeout:30. (Watch.value_to_become pw state)

File: xenops\domain.ml
99,100c100,101
< 	let flags =
---
> 	let flags = if info.hvm then (
> 	  let default_flags =
102a104,117
> 	   if (List.mem_assoc "hap" info.platformdata) then (
>               if (List.assoc "hap" info.platformdata) = "false" then (
>                  debug "HAP will be disabled for VM %s." (Uuid.to_string uuid);
>                  [ Xc.CDF_HVM ]
>               ) else if (List.assoc "hap" info.platformdata) = "true" then (
>                  debug "HAP will be enabled for VM %s." (Uuid.to_string uuid);
>                  [ Xc.CDF_HVM; Xc.CDF_HAP ] 
>               ) else (
>                  debug "Unrecognized HAP platform value.  Assuming default settings for VM %s." (Uuid.to_string uuid);
>                  default_flags
>               )
>            ) else
>               default_flags
>         ) else [] in