xenmgr: Push ACPI power button multiple times

Sometimes the shutdown command does not work.  It seems like the longer
the VM is up, the more likely it is to not shutdown.  This is based on
Windows 10 without PV drivers.

The button press is seen by the VM to some extent because a DPMS off
(black) screen will turn back on, but shutdown is not initiated.  A
second press will trigger it - that was the intent to the xl trigger
power line added in commit 1cfb6aa "xenmgr: Add xl trigger power to
HVM shutdown".

Re-work the code so a background thread is started that will push the
power buttons* 3 times each with a 1 second delay.  This will hopefully
let the VM recognize the button press without going on for too long.

*HVMs have two power and two sleep buttons.  One is Xen emulating
buttons for HVMs, and the second is from QEMU's acpi-pm-features.patch
and ACPI changes.  xl trigger power is pushing the Xen one and the
xenstore hvm-shutdown write is triggering the QEMU one.

With forkIO, the `xl shutdown -F -ww` runs before the `xl trigger power`
commands.  xl shutdown first tries PV shutdown and then (-F) fallback to
ACPI.  So this would push the Xen ACPI button before the QEMU one in
pushPowerButton.

Signed-off-by: Jason Andryuk <[email protected]>

Author: jandryuk

xenmgr/XenMgr/Connect/Xl.hs

@@ -158,6 +158,22 @@ domainXsPath uuid = do
       "" -> return $ "/local/domain/unknown"
       _  -> return $ "/local/domain/" ++ domid
 
+pushPowerButton :: Uuid -> Int -> IO ()
+pushPowerButton uuid count = do
+      domid <- getDomainId uuid
+      stubdomid <- getStubDomainID uuid
+      let xs_path = "/local/domain/" ++ stubdomid ++ "/device-model/" ++ domid
+      _pushPowerButton uuid domid xs_path 1 count
+    where
+      _pushPowerButton :: Uuid -> String -> String -> Int -> Int -> IO ()
+      _pushPowerButton uuid domid xs_path i max = do
+          debug $ "push power button " ++ show uuid ++ " " ++ show i ++ " of " ++ show max
+          xsWrite (xs_path ++ "/hvm-shutdown") "poweroff"
+          system_ ("xl trigger " ++ domid ++ " power")
+          if i < max
+              then do threadDelay $ 10^6
+                      _pushPowerButton uuid domid xs_path ( i + 1 ) max
+              else return ()
 
 --The following functions are all domain lifecycle operations, and self-explanatory
 
@@ -172,9 +188,8 @@ shutdown uuid =
         Just g  -> do exitCode  <- system ("xl shutdown -w " ++ domid)
                       case exitCode of
                         ExitSuccess   -> return ()
-                        _             -> do xsWrite (xs_path ++ "/hvm-shutdown") "poweroff"
-                                            _ <- system ("xl trigger " ++ domid ++ " power")
-                                            _ <- system ("xl shutdown -F -w " ++ domid)
+                        _             -> do forkIO $ pushPowerButton uuid 3
+                                            _ <- system_ ("xl shutdown -F -w " ++ domid)
                                             return ()
         Nothing -> do system ("xl shutdown -c -w " ++ domid)
                       return ()