Commit c5a957c3 authored by Michele Tartara's avatar Michele Tartara

Add Haskell parser for "xm uptime"

In order to fetch precise information about the uptime of the VMs
running in Xen, we need to analyze the output of the "xm uptime" command.

This commit adds the parser to do that, and its tests.
Signed-off-by: default avatarMichele Tartara <mtartara@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent b8585908
......@@ -1070,6 +1070,7 @@ TEST_FILES = \
test/data/xen-xm-list-4.0.1-dom0-only.txt \
test/data/xen-xm-list-4.0.1-four-instances.txt \
test/data/xen-xm-list-long-4.0.1.txt \
test/data/xen-xm-uptime-4.0.1.txt \
test/py/ganeti-cli.test \
test/py/gnt-cli.test \
test/py/import-export_unittest-helper
......
......@@ -26,6 +26,7 @@ module Ganeti.Hypervisor.Xen.Types
( LispConfig(..)
, Domain(..)
, FromLispConfig(..)
, UptimeInfo(..)
, ActualState(..)
) where
......@@ -84,6 +85,13 @@ instance FromLispConfig [LispConfig] where
Bad $ "Unable to extract a List from this configuration: "
++ show c
-- Data type representing the information that can be obtained from @xm uptime@
data UptimeInfo = UptimeInfo
{ uInfoName :: String
, uInfoID :: Int
, uInfoUptime :: String
} deriving (Eq, Show)
data ActualState = ActualRunning -- ^ The instance is running
| ActualBlocked -- ^ The instance is not running or runnable
| ActualPaused -- ^ The instance has been paused
......
......@@ -25,6 +25,8 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Hypervisor.Xen.XmParser
( xmListParser
, lispConfigParser
, xmUptimeParser
, uptimeLineParser
) where
import Control.Applicative
......@@ -137,3 +139,20 @@ xmListParser = do
case foldM foldResult Map.empty domains of
Ok d -> return d
Bad msg -> fail msg
-- | A parser for parsing the output of the @xm uptime@ command.
xmUptimeParser :: Parser (Map.Map Int UptimeInfo)
xmUptimeParser = do
_ <- headerParser
uptimes <- uptimeLineParser `AC.manyTill` A.endOfInput
return $ Map.fromList [(uInfoID u, u) | u <- uptimes]
where headerParser = A.string "Name" <* A.skipSpace <* A.string "ID"
<* A.skipSpace <* A.string "Uptime" <* A.skipSpace
-- | A helper for parsing a single line of the @xm uptime@ output.
uptimeLineParser :: Parser UptimeInfo
uptimeLineParser = do
name <- A.takeTill isSpace <* A.skipSpace
idNum <- A.decimal <* A.skipSpace
uptime <- A.takeTill (`elem` "\n\r") <* A.skipSpace
return . UptimeInfo (unpack name) idNum $ unpack uptime
Name ID Uptime
Domain-0 0 98 days, 2:27:44
instance1.example.com 119 15 days, 20:57:07
......@@ -39,6 +39,7 @@ import qualified Data.Attoparsec.Text as A
import Data.Text (pack)
import Data.Char
import qualified Data.Map as Map
import Text.Printf
import Ganeti.Hypervisor.Xen.Types
import Ganeti.Hypervisor.Xen.XmParser
......@@ -70,15 +71,40 @@ canBeNumber (c:xs) = canBeNumberChar c && canBeNumber xs
canBeNumberChar :: Char -> Bool
canBeNumberChar c = isDigit c || (c `elem` "eE-")
-- | Generates an arbitrary @xm uptime@ output line.
instance Arbitrary UptimeInfo where
arbitrary = do
name <- genFQDN
NonNegative idNum <- arbitrary :: Gen (NonNegative Int)
NonNegative days <- arbitrary :: Gen (NonNegative Int)
hours <- choose (0, 23) :: Gen Int
mins <- choose (0, 59) :: Gen Int
secs <- choose (0, 59) :: Gen Int
let uptime :: String
uptime =
if days /= 0
then printf "%d days, %d:%d:%d" days hours mins secs
else printf "%d:%d:%d" hours mins secs
return $ UptimeInfo name idNum uptime
-- * Helper functions for tests
-- | Function for testing whether a domain configuration is parsed correctly.
testDomain :: String -> Map.Map String Domain -> Assertion
testDomain fileName expectedContent = do
fileContent <- readTestData fileName
case A.parseOnly xmListParser $ pack fileContent of
Left msg -> assertFailure $ "Parsing failed: " ++ msg
Right obtained -> assertEqual fileName expectedContent obtained
fileContent <- readTestData fileName
case A.parseOnly xmListParser $ pack fileContent of
Left msg -> assertFailure $ "Parsing failed: " ++ msg
Right obtained -> assertEqual fileName expectedContent obtained
-- | Function for testing whether a @xm uptime@ output (stored in a file)
-- is parsed correctly.
testUptimeInfo :: String -> Map.Map Int UptimeInfo -> Assertion
testUptimeInfo fileName expectedContent = do
fileContent <- readTestData fileName
case A.parseOnly xmUptimeParser $ pack fileContent of
Left msg -> assertFailure $ "Parsing failed: " ++ msg
Right obtained -> assertEqual fileName expectedContent obtained
-- | Determines whether two LispConfig are equal, with the exception of Double
-- values, that just need to be "almost equal".
......@@ -102,6 +128,12 @@ serializeConf (LCList c) = "(" ++ unwords (map serializeConf c) ++ ")"
serializeConf (LCString s) = s
serializeConf (LCDouble d) = show d
-- | Function to serialize UptimeInfos in such a way that they can be rebuilt
-- againg by the uptimeLineParser.
serializeUptime :: UptimeInfo -> String
serializeUptime (UptimeInfo name idNum uptime) =
printf "%s\t%d\t%s" name idNum uptime
-- | Test whether a randomly generated config can be parsed.
-- Implicitly, this also tests that the Show instance of Config is correct.
prop_config :: LispConfig -> Property
......@@ -110,6 +142,13 @@ prop_config conf =
Left msg -> fail $ "Parsing failed: " ++ msg
Right obtained -> property $ isAlmostEqual obtained conf
-- | Test whether a randomly generated UptimeInfo text line can be parsed.
prop_uptimeInfo :: UptimeInfo -> Property
prop_uptimeInfo uInfo =
case A.parseOnly uptimeLineParser . pack . serializeUptime $ uInfo of
Left msg -> fail $ "Parsing failed: " ++ msg
Right obtained -> obtained ==? uInfo
-- | Test a Xen 4.0.1 @xm list --long@ output.
case_xen401list :: Assertion
case_xen401list = testDomain "xen-xm-list-long-4.0.1.txt" $
......@@ -119,7 +158,17 @@ case_xen401list = testDomain "xen-xm-list-long-4.0.1.txt" $
ActualBlocked Nothing)
]
-- | Test a Xen 4.0.1 @xm uptime@ output.
case_xen401uptime :: Assertion
case_xen401uptime = testUptimeInfo "xen-xm-uptime-4.0.1.txt" $
Map.fromList
[ (0, UptimeInfo "Domain-0" 0 "98 days, 2:27:44")
, (119, UptimeInfo "instance1.example.com" 119 "15 days, 20:57:07")
]
testSuite "Hypervisor/Xen/XmParser"
[ 'prop_config
, 'prop_uptimeInfo
, 'case_xen401list
, 'case_xen401uptime
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment