On Mon, Feb 04, 2013 at 10:44:41AM +0100, Michele Tartara wrote:
> In order to fetch precise information about the status of the VMs running in
> Xen, we need to analyze the output of the "xm list --long" command.
>
> This commit adds the parser to do that, and its tests.
>
> Signed-off-by: Michele Tartara <[email protected]>
> ---
> Makefile.am | 10 ++
> src/Ganeti/Hypervisor/Xen/Types.hs | 106 ++++++++++++++++
> src/Ganeti/Hypervisor/Xen/XmListParser.hs | 128 ++++++++++++++++++++
> src/Ganeti/Objects.hs | 23 ++++
> test/data/xen-xm-list-long-3.0.txt | 134
> +++++++++++++++++++++
> test/hs/Test/Ganeti/Hypervisor/Xen/XmListParser.hs | 93 ++++++++++++++
> test/hs/htest.hs | 2 +
> 7 files changed, 496 insertions(+)
> create mode 100644 src/Ganeti/Hypervisor/Xen/Types.hs
> create mode 100644 src/Ganeti/Hypervisor/Xen/XmListParser.hs
> create mode 100644 test/data/xen-xm-list-long-3.0.txt
> create mode 100644 test/hs/Test/Ganeti/Hypervisor/Xen/XmListParser.hs
>
> diff --git a/Makefile.am b/Makefile.am
> index 92fc57c..9af1f87 100644
> --- a/Makefile.am
> +++ b/Makefile.am
> @@ -65,6 +65,8 @@ HS_DIRS = \
> src/Ganeti/HTools \
> src/Ganeti/HTools/Backend \
> src/Ganeti/HTools/Program \
> + src/Ganeti/Hypervisor \
> + src/Ganeti/Hypervisor/Xen \
> src/Ganeti/Query \
> test/hs \
> test/hs/Test \
> @@ -74,6 +76,8 @@ HS_DIRS = \
> test/hs/Test/Ganeti/Confd \
> test/hs/Test/Ganeti/HTools \
> test/hs/Test/Ganeti/HTools/Backend \
> + test/hs/Test/Ganeti/Hypervisor \
> + test/hs/Test/Ganeti/Hypervisor/Xen \
> test/hs/Test/Ganeti/Query
>
> DIRS = \
> @@ -121,6 +125,8 @@ ALL_APIDOC_HS_DIRS = \
> $(APIDOC_HS_DIR)/Ganeti/HTools \
> $(APIDOC_HS_DIR)/Ganeti/HTools/Backend \
> $(APIDOC_HS_DIR)/Ganeti/HTools/Program \
> + $(APIDOC_HS_DIR)/Ganeti/Hypervisor \
> + $(APIDOC_HS_DIR)/Ganeti/Hypervisor/Xen \
> $(APIDOC_HS_DIR)/Ganeti/Query
>
> BUILDTIME_DIR_AUTOCREATE = \
> @@ -514,6 +520,8 @@ HS_LIB_SRCS = \
> src/Ganeti/HTools/Program/Hroller.hs \
> src/Ganeti/HTools/Program/Main.hs \
> src/Ganeti/HTools/Types.hs \
> + src/Ganeti/Hypervisor/Xen/XmListParser.hs \
> + src/Ganeti/Hypervisor/Xen/Types.hs \
> src/Ganeti/Hash.hs \
> src/Ganeti/JQueue.hs \
> src/Ganeti/JSON.hs \
> @@ -563,6 +571,7 @@ HS_TEST_SRCS = \
> test/hs/Test/Ganeti/HTools/Node.hs \
> test/hs/Test/Ganeti/HTools/PeerMap.hs \
> test/hs/Test/Ganeti/HTools/Types.hs \
> + test/hs/Test/Ganeti/Hypervisor/Xen/XmListParser.hs \
> test/hs/Test/Ganeti/JSON.hs \
> test/hs/Test/Ganeti/Jobs.hs \
> test/hs/Test/Ganeti/JQueue.hs \
> @@ -1043,6 +1052,7 @@ TEST_FILES = \
> test/data/xen-xm-info-4.0.1.txt \
> 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-3.0.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
> new file mode 100644
> index 0000000..3b10b30
> --- /dev/null
> +++ b/src/Ganeti/Hypervisor/Xen/Types.hs
> @@ -0,0 +1,106 @@
> +{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-}
> +{-| Data types for Xen-specific hypervisor functionalities.
> +
> +-}
> +{-
> +
> +Copyright (C) 2013 Google Inc.
> +
> +This program is free software; you can redistribute it and/or modify
> +it under the terms of the GNU General Public License as published by
> +the Free Software Foundation; either version 2 of the License, or
> +(at your option) any later version.
> +
> +This program is distributed in the hope that it will be useful, but
> +WITHOUT ANY WARRANTY; without even the implied warranty of
> +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
> +General Public License for more details.
> +
> +You should have received a copy of the GNU General Public License
> +along with this program; if not, write to the Free Software
> +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
> +02110-1301, USA.
> +
> +-}
> +module Ganeti.Hypervisor.Xen.Types
> + ( Config(..)
> + , Domain(..)
> + , FromConfig(..)
> + , isAlmostEqual
> + ) where
> +
> +import Ganeti.BasicTypes
> +import Ganeti.Objects
> +
> +-- | Data type representing configuration data as produced by the
> +-- "xm list --long" command.
> +data Config = List [Config]
> + | String String
> + | Double Double
> + deriving (Eq)
I find this name a bit too generic (in the Xen/Types.hs file), given
that it refers rather to xm list configuration; it might conflict with
the Xen config file format, when/if we add that…
> +-- | The Show instance for Config
> +instance Show Config where
> + show (List c) = "(" ++ unwords (map show c) ++ ")"
> + show (String s) = s
> + show (Double d) = show d
Does this have to be a Show instance? I.e., are you using it together
with a later Read instance, or just for pretty-printing?
> +-- | Determines whether two Config are equal, with the exception of Double
> +-- values, that just need to be "almost equal".
> +-- Meant mainly for testing purposes, given that Double values may be
> slightly
> +-- rounded during parsing.
Then should it be in some generic test module? It's not Xen-specific…
> +isAlmostEqual :: Config -> Config -> Bool
> +isAlmostEqual (List c1) (List c2) =
> + (length c1 == length c2) &&
> + foldr
> + (\current acc -> (acc && uncurry isAlmostEqual current))
> + True
> + (zip c1 c2)
> +isAlmostEqual (String s1) (String s2) = s1 == s2
> +isAlmostEqual (Double d1) (Double d2) = abs (d1-d2) <= 1e-12
> +isAlmostEqual _ _ = False
> +
> +-- | Data type representing a Xen Domain.
> +data Domain = Domain
> + { domId :: Int
> + , domName :: String
> + , domCpuTime :: Double
> + , domState :: ActualState
> + , domIsHung :: Maybe Bool
> + } deriving (Show, Eq)
> +
> +-- | Class representing all the types that can be extracted from Config.
> +class FromConfig a where
> + fromConfig :: Config -> Result a
> +
> +-- | Instance of FromConfig for Int.
> +instance FromConfig Int where
> + fromConfig (Double d) = Ok $ floor d
> + fromConfig (List (String _:Double d:[])) = Ok $ floor d
> + fromConfig c =
> + Bad $ "Unable to extract a Int from this configuration: "
> + ++ show c
> +
> +-- | Instance of FromConfig for Double.
> +instance FromConfig Double where
> + fromConfig (Double d) = Ok d
> + fromConfig (List (String _:Double d:[])) = Ok d
> + fromConfig c =
> + Bad $ "Unable to extract a Double from this configuration: "
> + ++ show c
> +
> +-- | Instance of FromConfig for String
> +instance FromConfig String where
> + fromConfig (String s) = Ok s
> + fromConfig (List (String _:String s:[])) = Ok s
> + fromConfig c =
> + Bad $ "Unable to extract a String from this configuration: "
> + ++ show c
> +
> +-- | Instance of FromConfig for [Config]
> +instance FromConfig [Config] where
> + fromConfig (List l) = Ok l
> + fromConfig c =
> + Bad $ "Unable to extract a List from this configuration: "
> + ++ show c
> diff --git a/src/Ganeti/Hypervisor/Xen/XmListParser.hs
> b/src/Ganeti/Hypervisor/Xen/XmListParser.hs
> new file mode 100644
> index 0000000..3ef5def
> --- /dev/null
> +++ b/src/Ganeti/Hypervisor/Xen/XmListParser.hs
> @@ -0,0 +1,128 @@
> +{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}
> +{-| Parser for the output of the "xm list --long" command of Xen
FYI, " are special chars in haddock; some versions will deal correctly
with this, some not, so escaping them would be better.
> +
> +-}
> +{-
> +
> +Copyright (C) 2013 Google Inc.
> +
> +This program is free software; you can redistribute it and/or modify
> +it under the terms of the GNU General Public License as published by
> +the Free Software Foundation; either version 2 of the License, or
> +(at your option) any later version.
> +
> +This program is distributed in the hope that it will be useful, but
> +WITHOUT ANY WARRANTY; without even the implied warranty of
> +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
> +General Public License for more details.
> +
> +You should have received a copy of the GNU General Public License
> +along with this program; if not, write to the Free Software
> +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
> +02110-1301, USA.
> +
> +-}
> +module Ganeti.Hypervisor.Xen.XmListParser (xmListParser, configParser) where
> +
> +import Control.Applicative ((*>), (<*), (<|>), pure)
> +import qualified Data.Attoparsec.Text as A
> +import qualified Data.Attoparsec.Combinator as AC
> +import Data.Attoparsec.Text (Parser)
> +import Data.Char (isSpace)
> +import Data.List
> +import qualified Data.Map as Map
> +import Data.Text (unpack)
> +
> +import Ganeti.BasicTypes
> +import Ganeti.Hypervisor.Xen.Types
> +import Ganeti.Objects
> +
> +-- | A parser for parsing generic config files written in the (LISP-like)
> +-- format that is the output of the "xm list --long" command.
> +-- This parser only takes care of the syntactic parse, but does not care
> +-- about the semantics.
> +configParser :: Parser Config
> +configParser =
> + A.skipSpace *>
> + ( configP
> + <|> doubleP
> + <|> stringP
> + )
> + <* A.skipSpace
> + where configP =
> + (A.char '(' *> configParser `AC.manyTill` A.char ')')
> + >>= pure . List
> + doubleP = A.double >>= pure . Double
> + stringP =
> + A.takeWhile1 (
> + \c -> (not . isSpace) c
> + && (c /= ')')
> + && (c /= '(')
> + ) >>= (pure . String . unpack )
> +
> +-- | Find a configuration having the given string as its first element,
> +-- from a list of configurations.
> +findConf :: String -> [Config] -> Result Config
> +findConf key configs =
> + case find (isNamed key) configs of
> + (Just c) -> Ok c
> + _ -> Bad "Configuration not found"
> +
> +-- | Get the value of of a configuration having the given string as its
> +-- first element.
> +-- The value is the content of the configuration, discarding the name itself.
> +getValue :: (FromConfig a) => String -> [Config] -> Result a
> +getValue key configs = findConf key configs >>= fromConfig
> +
> +-- | Extract the values of a configuration containing a list of them.
> +extractValues :: Config -> Result [Config]
> +extractValues c = fmap tail $ fromConfig c
FYI, this can be written slightly cleaner (IMHO) as tail `fmap`
fromConfig c.
> +-- | Verify whether the given configuration has a certain name or not.
> +-- The name of a configuration is its first parameter, if it is a string.
> +isNamed :: String -> Config -> Bool
> +isNamed key (List (String x:_)) = x == key
> +isNamed _ _ = False
> +
> +parseState :: String -> ActualState
docstring please.
> +parseState s =
> + case s of
> + "r-----" -> ActualRunning
> + "-b----" -> ActualBlocked
> + "--p---" -> ActualPaused
> + "---s--" -> ActualShutdown
> + "----c-" -> ActualCrashed
> + "-----d" -> ActualDying
> + _ -> ActualUnknown
Question: do we need to represent failure via ActualUnknown, as opposed
to a monadic/error result?
> +-- | Extract the configuration data of a Xen domain from a generic Config
> +-- data structure. Fail if the Config does not represent a domain.
> +getDomainConfig :: Config -> Result Domain
> +getDomainConfig configData = do
> + domainConf <-
> + if isNamed "domain" configData
> + then extractValues configData
> + else Bad $ "Not a domain configuration: " ++ show configData
> + domid <- getValue "domid" domainConf
> + name <- getValue "name" domainConf
> + cpuTime <- getValue "cpu_time" domainConf
> + state <- getValue "state" domainConf
> + let actualState = parseState state
> + return $ Domain domid name cpuTime actualState Nothing
> +
> +-- | A parser for parsing the output of the "xm list --long" command.
> +-- It adds the semantic layer on top of configParser.
> +-- It returns a map of domains, with their name as the key.
> +-- FIXME: This is efficient under the assumption that only a few fields of
> the
> +-- domain configuration are actually needed. If many of them are required, a
> +-- parser able to directly extract the domain config would actually be
> better.
> +xmListParser :: Parser (Map.Map String Domain)
> +xmListParser = do
> + configs <- configParser `AC.manyTill` A.endOfInput
> + let domains = map getDomainConfig configs
> + foldResult (Ok val) (Ok m) = Ok $ Map.insert (domName val) val m
> + foldResult _ badMap@(Bad _) = badMap
> + foldResult (Bad msg) _ = Bad msg
This seems to be a standard pattern of dealing with monadic values…
surprised it's not already doable via foldM or similar.
> + case foldr foldResult (Ok Map.empty) domains of
> + (Ok d) -> return d
> + (Bad msg) -> fail msg
No need for parentheses here.
> diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs
> index 26ccea6..5e2ec44 100644
> --- a/src/Ganeti/Objects.hs
> +++ b/src/Ganeti/Objects.hs
> @@ -51,6 +51,7 @@ module Ganeti.Objects
> , allBeParamFields
> , AdminState(..)
> , adminStateFromRaw
> + , ActualState(..)
> , Instance(..)
> , toDictInstance
> , PartialNDParams(..)
> @@ -376,6 +377,28 @@ $(declareSADT "AdminState"
> ])
> $(makeJSONInstance ''AdminState)
>
> +data ActualState = ActualRunning -- The instance is running
> + | ActualBlocked -- The instance is not running or runnable
> + | ActualPaused -- The instance has been paused
> + | ActualShutdown -- The instance is shut down
> + | ActualCrashed -- The instance has crashed
> + | ActualDying -- The instance is in process of dying
> + | ActualHung -- The instance is hung
> + | ActualUnknown -- Unknown state. Parsing error.
> + deriving (Show, Eq)
> +
> +instance JSON ActualState where
> + showJSON ActualRunning = showJSON "running"
> + showJSON ActualBlocked = showJSON "blocked"
> + showJSON ActualPaused = showJSON "paused"
> + showJSON ActualShutdown = showJSON "shutdown"
> + showJSON ActualCrashed = showJSON "crashed"
> + showJSON ActualDying = showJSON "dying"
> + showJSON ActualHung = showJSON "hung"
> + showJSON ActualUnknown = showJSON "unknown"
> +
> + readJSON = error "JSON read instance not implemented for type ActualState"
> +
This seems to be out of place in Objects.hs. This file is about Ganeti
configuration objects. And also, the name is very wrong (in this file).
Can you put it directly in Xen/Types?
> $(buildParam "Be" "bep"
> [ simpleField "minmem" [t| Int |]
> , simpleField "maxmem" [t| Int |]
> diff --git a/test/data/xen-xm-list-long-3.0.txt
> b/test/data/xen-xm-list-long-3.0.txt
Question: are these 3.0 files as found on a 3.0 node? (As in, I'm
surprised you still have one running :). Wondering if we should add
4.0/4.1 as well.
> new file mode 100644
> index 0000000..404e98b
> --- /dev/null
> +++ b/test/data/xen-xm-list-long-3.0.txt
> @@ -0,0 +1,134 @@
> +(domain
> + (domid 0)
> + (cpu_weight 2048)
> + (cpu_cap 0)
> + (bootloader )
> + (on_crash restart)
> + (uuid 00000000-0000-0000-0000-000000000000)
> + (bootloader_args )
> + (vcpus 24)
> + (name Domain-0)
> + (cpus
> + ((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
> + )
> + )
> + (on_reboot restart)
> + (on_poweroff destroy)
> + (maxmem 16777215)
> + (memory 1023)
> + (shadow_memory 0)
> + (features )
> + (on_xend_start ignore)
> + (on_xend_stop ignore)
> + (cpu_time 184000.41332)
> + (online_vcpus 1)
> + (image (linux (kernel ) (superpages 0) (nomigrate 0) (tsc_mode 0)))
> + (status 2)
> + (state r-----)
> +)
> +(domain
> + (domid 119)
> + (cpu_weight 256)
> + (cpu_cap 0)
> + (bootloader )
> + (on_crash restart)
> + (uuid e430b4b8-dc91-9390-dfe0-b83c138ea0aa)
> + (bootloader_args )
> + (vcpus 1)
> + (description )
> + (name instance1.example.com)
> + (cpus (()))
> + (on_reboot restart)
> + (on_poweroff destroy)
> + (maxmem 128)
> + (memory 128)
> + (shadow_memory 0)
> + (features )
> + (on_xend_start ignore)
> + (on_xend_stop ignore)
> + (start_time 1357749308.05)
> + (cpu_time 24.116146647)
> + (online_vcpus 1)
> + (image
> + (linux
> + (kernel /boot/vmlinuz-ganetixenu)
> + (args 'root=/dev/xvda1 ro')
> + (superpages 0)
> + (videoram 4)
> + (pci ())
> + (nomigrate 0)
> + (tsc_mode 0)
> + (notes
> + (HV_START_LOW 18446603336221196288)
> + (FEATURES '!writable_page_tables|pae_pgdir_above_4gb')
> + (VIRT_BASE 18446744071562067968)
> + (GUEST_VERSION 2.6)
> + (PADDR_OFFSET 0)
> + (GUEST_OS linux)
> + (HYPERCALL_PAGE 18446744071578849280)
> + (LOADER generic)
> + (SUSPEND_CANCEL 1)
> + (PAE_MODE yes)
> + (ENTRY 18446744071592116736)
> + (XEN_VERSION xen-3.0)
> + )
> + )
> + )
> + (status 2)
> + (state -b----)
> + (store_mfn 8836555)
> + (console_mfn 8735251)
> + (device
> + (vif
> + (bridge xen-br0)
> + (mac aa:00:00:30:8d:9d)
> + (script /etc/xen/scripts/vif-bridge)
> + (uuid f57c4758-cf0a-8227-6d13-fe26ece82d75)
> + (backend 0)
> + )
> + )
> + (device
> + (console
> + (protocol vt100)
> + (location 2)
> + (uuid 7695737a-ffc2-4e0d-7f6d-734143b8afc4)
> + )
> + )
> + (device
> + (vbd
> + (protocol x86_64-abi)
> + (uuid 409e1ff8-435a-4704-80bb-4bfe800d932e)
> + (bootable 1)
> + (dev sda:disk)
> + (uname
> + phy:/var/run/ganeti/instance-disks/instance1.example.com:0
> + )
> + (mode w)
> + (backend 0)
> + (VDI )
> + )
> + )
> +)
> diff --git a/test/hs/Test/Ganeti/Hypervisor/Xen/XmListParser.hs
> b/test/hs/Test/Ganeti/Hypervisor/Xen/XmListParser.hs
> new file mode 100644
> index 0000000..b37a18e
> --- /dev/null
> +++ b/test/hs/Test/Ganeti/Hypervisor/Xen/XmListParser.hs
> @@ -0,0 +1,93 @@
> +{-# LANGUAGE TemplateHaskell #-}
> +{-# OPTIONS_GHC -fno-warn-orphans #-}
> +
> +{-| Unittests for "xm list --long" parser -}
Same note about ".
thanks,
iustin
