From c5a957c38be6398a1783f856f7737325751ef278 Mon Sep 17 00:00:00 2001 From: Michele Tartara Date: Wed, 6 Feb 2013 09:24:49 +0100 Subject: [PATCH 1/1] 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: Michele Tartara Reviewed-by: Iustin Pop --- Makefile.am | 1 + src/Ganeti/Hypervisor/Xen/Types.hs | 8 ++++ src/Ganeti/Hypervisor/Xen/XmParser.hs | 19 ++++++++ test/data/xen-xm-uptime-4.0.1.txt | 3 ++ test/hs/Test/Ganeti/Hypervisor/Xen/XmParser.hs | 57 ++++++++++++++++++++++-- 5 files changed, 84 insertions(+), 4 deletions(-) create mode 100644 test/data/xen-xm-uptime-4.0.1.txt diff --git a/Makefile.am b/Makefile.am index eb61fdd..60118fe 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/src/Ganeti/Hypervisor/Xen/Types.hs b/src/Ganeti/Hypervisor/Xen/Types.hs index 239f267..f37dc86 100644 --- a/src/Ganeti/Hypervisor/Xen/Types.hs +++ b/src/Ganeti/Hypervisor/Xen/Types.hs @@ -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 diff --git a/src/Ganeti/Hypervisor/Xen/XmParser.hs b/src/Ganeti/Hypervisor/Xen/XmParser.hs index fe8fede..a5459f2 100644 --- a/src/Ganeti/Hypervisor/Xen/XmParser.hs +++ b/src/Ganeti/Hypervisor/Xen/XmParser.hs @@ -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 diff --git a/test/data/xen-xm-uptime-4.0.1.txt b/test/data/xen-xm-uptime-4.0.1.txt new file mode 100644 index 0000000..8e1d5b6 --- /dev/null +++ b/test/data/xen-xm-uptime-4.0.1.txt @@ -0,0 +1,3 @@ +Name ID Uptime +Domain-0 0 98 days, 2:27:44 +instance1.example.com 119 15 days, 20:57:07 diff --git a/test/hs/Test/Ganeti/Hypervisor/Xen/XmParser.hs b/test/hs/Test/Ganeti/Hypervisor/Xen/XmParser.hs index 62a8605..cc41435 100644 --- a/test/hs/Test/Ganeti/Hypervisor/Xen/XmParser.hs +++ b/test/hs/Test/Ganeti/Hypervisor/Xen/XmParser.hs @@ -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 ] -- 1.7.10.4