diff --git a/xenmgr/Vm/Actions.hs b/xenmgr/Vm/Actions.hs
index 8eaead5e..631a872c 100644
--- a/xenmgr/Vm/Actions.hs
+++ b/xenmgr/Vm/Actions.hs
@@ -23,7 +23,6 @@ module Vm.Actions
, trashUnusedServiceVms
, createVm, CreateVmPms(..), defaultCreateVmPms
, removeVm
- , restartVm
, startVm
, startVmInternal
, rebootVm
@@ -505,16 +504,11 @@ getVhdReferences vhd = concat <$> (mapM (diskVhdReferences vhd) =<< getVms) wher
references vhd disk = diskPath disk == vhd
startVm :: Uuid -> XM ()
-startVm uuid = _startVm False uuid
-
-restartVm :: Uuid -> XM ()
-restartVm uuid = _startVm True uuid
-
-_startVm :: Bool -> Uuid -> XM ()
-_startVm is_reboot uuid = do
+startVm uuid = do
+ info $ "Starting " ++ show uuid
withPreCreationState uuid $ do
ran <- liftRpc $ runEventScript HardFail uuid getVmRunInsteadofStart [uuidStr uuid]
- when (not ran) $ startVmInternal uuid is_reboot
+ when (not ran) $ startVmInternal uuid
--Add a passthrough rule to vm config
add_pt_rule_bdf uuid dev = modifyVmPciPtRules uuid $ pciAddRule (form_rule_bdf (show (devAddr dev)))
@@ -523,14 +517,14 @@ form_rule_bdf = rule . fromMaybe (error "error parsing rule") . pciAndSlotFromSt
rule (addr,sl) = PciPtRuleBDF addr sl
-- Start a VM! (maybe, because stuff can happen not)
-startVmInternal :: Uuid -> Bool -> XM ()
-startVmInternal uuid is_reboot = do
+startVmInternal :: Uuid -> XM ()
+startVmInternal uuid = do
unlessM (dbExists $ "/vm/" ++ show uuid) $ error ("vm does not have a database entry: " ++ show uuid)
info $ "starting VM " ++ show uuid
liftRpc $ maybePtGpuFuncs uuid
config <- prepareAndCheckConfig uuid
case config of
- Just c -> info ("done checks for VM " ++ show uuid) >> bootVm c is_reboot
+ Just c -> info ("done checks for VM " ++ show uuid) >> bootVm c
Nothing-> return ()
where
@@ -833,8 +827,8 @@ checkAndPerformSnapshotIfReq uuid disks = do
_ -> return disk --other Snapshot types unimplemented for now since UI can't set them
-bootVm :: VmConfig -> Bool -> XM ()
-bootVm config reboot
+bootVm :: VmConfig -> XM ()
+bootVm config
= do
monitor <- vm_monitor <$> xmRunVm uuid vmContext
@@ -875,10 +869,8 @@ bootVm config reboot
then return False
else liftIO (doesFileExist suspend_file)
if not exists
- then do
- if reboot
- then do liftIO $ Xl.signal uuid
- else do liftIO $ Xl.start uuid --we start paused by default
+ then do tapenv <- tapEnvForVm uuid
+ liftIO $ Xl.start uuid tapenv --we start paused by default
else do liftIO $ xsWrite (vmSuspendImageStatePath uuid) "resume"
liftIO $ Xl.resumeFromFile uuid suspend_file False True
return bootstrap
@@ -1020,15 +1012,15 @@ applyVmBackendShift bkuuid = do
-- Reboot a VM
-rebootVm :: Uuid -> Rpc ()
+rebootVm :: Uuid -> XM ()
rebootVm uuid = do
info $ "rebooting VM " ++ show uuid
- -- Write XL configuration file
- writeXlConfig =<< getVmConfig uuid True
- --Let xl take care of bringing down the domain and updating our state
- --When xenmgr sees the 'Rebooted' state, it fires off a startVm call,
- --which performs all the normal guest boot tasks, while xl brings up the domain.
- liftIO $ Xl.reboot uuid
+ debug $ "reboot issuing shutdown to " ++ show uuid
+ liftRpc $ shutdownVm uuid
+ debug $ "reboot done issuing shutdown to " ++ show uuid
+ done <- liftIO $ Xl.waitForState uuid Shutdown (Just 60)
+ debug $ "reboot waitForState returned " ++ show done
+ when done $ startVm uuid
shutdownVm :: Uuid -> Rpc ()
shutdownVm uuid = do
diff --git a/xenmgr/Vm/Config.hs b/xenmgr/Vm/Config.hs
index bc1d9b1f..976b4bd1 100644
--- a/xenmgr/Vm/Config.hs
+++ b/xenmgr/Vm/Config.hs
@@ -606,6 +606,7 @@ getXlConfig cfg =
, "pci_msitranslate=1"
, "pci_seize=1"
, "pci_power_mgmt=1"
+ , "on_reboot='destroy'"
]
++ nameStr
++ hdtype
diff --git a/xenmgr/Vm/React.hs b/xenmgr/Vm/React.hs
index df3467ec..093f4eea 100644
--- a/xenmgr/Vm/React.hs
+++ b/xenmgr/Vm/React.hs
@@ -315,7 +315,7 @@ whenShutdown xm reason = do
maybeCleanupSnapshots
if reason == Reboot
then do
- uuidRpc (backgroundRpc . runXM xm . restartVm)
+ uuidRpc (backgroundRpc . runXM xm . startVm)
else do
runXM xm (maybeKeepVmAlive uuid)
return ()
diff --git a/xenmgr/XenMgr/Connect/Xl.hs b/xenmgr/XenMgr/Connect/Xl.hs
index 6690e5bf..c90646e2 100644
--- a/xenmgr/XenMgr/Connect/Xl.hs
+++ b/xenmgr/XenMgr/Connect/Xl.hs
@@ -20,7 +20,6 @@ module XenMgr.Connect.Xl
, pause
, destroy
, resumeFromSleep
- , reboot
, sleep
, hibernate
, suspendToFile
@@ -30,7 +29,6 @@ module XenMgr.Connect.Xl
, acpiState
, waitForAcpiState
, waitForState
- , signal
--xl/toolstack queries
, domainID
@@ -160,19 +158,25 @@ 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
-reboot :: Uuid -> IO ()
-reboot uuid =
- do
- domid <- getDomainId uuid
- exitCode <- system ("xl reboot " ++ domid)
- case exitCode of
- ExitSuccess -> return ()
- _ -> do _ <- system ("xl reboot -F " ++ domid)
- return ()
-
shutdown :: Uuid -> IO ()
shutdown uuid =
do
@@ -184,8 +188,7 @@ 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")
+ _ -> do forkIO $ pushPowerButton uuid 3
_ <- system ("xl shutdown -F -w " ++ domid)
return ()
Nothing -> do system ("xl shutdown -c -w " ++ domid)
@@ -213,27 +216,12 @@ getXlProcess uuid = do
case ec of
ExitSuccess -> return $ TT.strip str_pid
_ -> return ""
-
-
--- Sends sigusr1 to specified xl process, in order to unblock
--- it from a reboot
-signal :: Uuid -> IO ()
-signal uuid = do
- pid <- getXlProcess uuid
- if pid /= ""
- then do
- info $ "signal xl process for uuid: " ++ (show uuid) ++ " pid: " ++ pid
- readProcessOrDie "kill" ["-s", "SIGUSR1", pid] ""
- return ()
- else do
- info $ "Couldn't find xl process for uuid: " ++ (show uuid)
- return ()
--It should be noted that by design, we start our domains paused to ensure all the
--backend components are created and xenstore nodes are written before the domain
--begins running.
-start :: Uuid -> IO ()
-start uuid =
+start :: Uuid -> [(String, String)] -> IO ()
+start uuid extraEnv =
do
--if domain already has a pid don't try to create another.
pid <- getXlProcess uuid
@@ -241,19 +229,23 @@ start uuid =
if pid == ""
then do
case state of
- Shutdown -> do
- (_, _, Just err, handle) <- createProcess (proc "xl" ["create", configPath uuid, "-p"]){std_err = CreatePipe,
- close_fds = True}
- ec <- waitForProcess handle
- stderr <- hGetContents err
- case ec of
- ExitSuccess -> return ()
- _ -> do
- updateVmDomainStateIO uuid Shutdown
- throw $ XlException $ L.intercalate "
" $ L.lines stderr
+ Shutdown -> _start
+ Rebooted -> _start
_ -> do return ()
else do
throw $ XlException "Don't try to start a guest twice"
+ where
+ _start = do
+ (_, _, Just err, handle) <- createProcess (proc "xl" ["create", configPath uuid, "-p"]){std_err = CreatePipe,
+ close_fds = True,
+ env = Just extraEnv}
+ ec <- waitForProcess handle
+ stderr <- hGetContents err
+ case ec of
+ ExitSuccess -> return ()
+ _ -> do
+ updateVmDomainStateIO uuid Shutdown
+ throw $ XlException $ L.intercalate "
" $ L.lines stderr
--if domain has no domid, the domain is already dead. But we should make sure
--the xenstore state is set to 'shutdown'. Sometimes when domains crash on startup,
diff --git a/xenmgr/XenMgr/Expose/VmObject.hs b/xenmgr/XenMgr/Expose/VmObject.hs
index 001efd67..faa8ad63 100644
--- a/xenmgr/XenMgr/Expose/VmObject.hs
+++ b/xenmgr/XenMgr/Expose/VmObject.hs
@@ -103,8 +103,8 @@ implementationFor xm uuid = self where
, comCitrixXenclientXenmgrVmDelete = unlessM policyQueryVmDeletion failActionSuppressedByPolicy >> removeVm uuid
, comCitrixXenclientXenmgrVmSwitch = switchVm uuid >> return ()
, comCitrixXenclientXenmgrVmStart = runXM xm (startVm uuid) >> return ()
- , comCitrixXenclientXenmgrVmStartInternal = runXM xm (startVmInternal uuid False) >> return ()
- , comCitrixXenclientXenmgrVmReboot = rebootVm uuid
+ , comCitrixXenclientXenmgrVmStartInternal = runXM xm (startVmInternal uuid) >> return ()
+ , comCitrixXenclientXenmgrVmReboot = runXM xm (rebootVm uuid) >> return ()
, comCitrixXenclientXenmgrVmShutdown = runvm invokeShutdownVm
, comCitrixXenclientXenmgrVmDestroy = runvm invokeForceShutdownVm
, comCitrixXenclientXenmgrVmSleep = sleepVm uuid
diff --git a/xenmgr/XenMgr/PowerManagement.hs b/xenmgr/XenMgr/PowerManagement.hs
index fee77f8c..7b13ed4e 100644
--- a/xenmgr/XenMgr/PowerManagement.hs
+++ b/xenmgr/XenMgr/PowerManagement.hs
@@ -283,7 +283,7 @@ resumeS3' uuid S3Pv = do
void . liftIO $ Xl.resumeFromSleep uuid
info $ "PM: Successfully resumed " ++ show uuid ++ " from S3"
resumeS3' uuid S3Restart = do
- liftRpc $ rebootVm uuid
+ a <- rebootVm uuid
info $ "PM: Restarted " ++ show uuid ++ " after S3"
resumeS3' uuid S3Snapshot =