module Ganeti.Hypervisor.Xen
( getDomainsInfo
, getInferredDomInfo
, getUptimeInfo
, Domain(..)
, UptimeInfo(..)
) where
import qualified Control.Exception as E
import Data.Attoparsec.Text as A
import qualified Data.Map as Map
import Data.Text (pack)
import System.Process
import qualified Ganeti.BasicTypes as BT
import qualified Ganeti.Constants as C
import Ganeti.Hypervisor.Xen.Types
import Ganeti.Hypervisor.Xen.XmParser
import Ganeti.Logging
import Ganeti.Utils
getDomainsInfo :: IO (BT.Result (Map.Map String Domain))
getDomainsInfo = do
contents <-
(E.try $ readProcess C.xenCmdXm ["list", "--long"] "")
:: IO (Either IOError String)
return $
either (BT.Bad . show) (
\c ->
case A.parseOnly xmListParser $ pack c of
Left msg -> BT.Bad msg
Right dom -> BT.Ok dom
) contents
inferDomInfos :: Map.Map String Domain -> Domain -> Domain
inferDomInfos domMap dom1 =
case Map.lookup (domName dom1) domMap of
Just dom2 ->
dom1 { domIsHung = Just $ domCpuTime dom1 == domCpuTime dom2 }
Nothing -> dom1 { domIsHung = Nothing }
getInferredDomInfo :: IO (BT.Result (Map.Map String Domain))
getInferredDomInfo = do
domMap1 <- getDomainsInfo
domMap2 <- getDomainsInfo
case (domMap1, domMap2) of
(BT.Bad m1, BT.Bad m2) -> return . BT.Bad $ m1 ++ "\n" ++ m2
(BT.Bad m, BT.Ok d) -> do
logWarning $ "Unable to retrieve domains info the first time" ++ m
return $ BT.Ok d
(BT.Ok d, BT.Bad m) -> do
logWarning $ "Unable to retrieve domains info the second time" ++ m
return $ BT.Ok d
(BT.Ok d1, BT.Ok d2) -> return . BT.Ok $ fmap (inferDomInfos d2) d1
getUptimeInfo :: IO (Map.Map Int UptimeInfo)
getUptimeInfo = do
contents <-
((E.try $ readProcess C.xenCmdXm ["uptime"] "")
:: IO (Either IOError String)) >>=
exitIfBad "running command" . either (BT.Bad . show) BT.Ok
case A.parseOnly xmUptimeParser $ pack contents of
Left msg -> exitErr msg
Right uInfo -> return uInfo