module Ganeti.Hypervisor.Xen.XmParser
( xmListParser
, lispConfigParser
+ , xmUptimeParser
+ , uptimeLineParser
) where
import Control.Applicative
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
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
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".
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
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" $
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
]