On Mon, Feb 04, 2013 at 04:30:58PM +0100, Michele Tartara wrote:
> On Mon, Feb 4, 2013 at 12:01 PM, Iustin Pop <[email protected]> wrote:
>
> > 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…
> >
> >
> I agree it's too generic. But it's not "xm list --long" specific either.
> It's just a generic "lisp-like" configuration format, so I wanted the name
> to be a little bit generic. I probably overdid that a little bit.
> What about LispConfig?
Sounds good.
Wait Wait Wait. You're definitg a String constructor? And a Double
constructor? NACK.
> > > +-- | 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?
> >
>
> It's not just pretty printing: it's actually used in the tests, when an
> arbitrary Config is serialized using this. On the other hand, then, it is
> not read with Read, but with my own parser written with Attoparsec, so I
> wasn't entirely sure either about this being a correct use of Show or not.
> For sure, it's something intended to represent the printed value
> completely, and in such a way to be possible to use that dump to rebuild
> the value. And this quite fits in the definition of what Show should be.
> So... I'm open to suggestions as to whether I should keep it like this or
> change it.
Unless you implement a Read instance for it as well, I'd just make this
a plain function. And if you only use it in tests, I'd move it to the
test code.
> > > +-- | 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…
> >
>
> It's not Xen specifc, but it is Config specific, and up to now it is used
> only by Xen, so I decided to put it here.
> On the other hand, Config is generic enough that we might end up needing it
> for something else sooner or later. So, even this is quite borderline:
> should I keep Config here (and it can be moved if/when something else
> actually needs it), or should I move it somewhere else?
I think it's fine to leave Config here. But again, I disagree that
isAlmostEqual is config specific… wait, the String and Double
constructor are for your own data types?
OK, so this is Config specific. If it's not used at runtime, move it to
the Xen test files, if it's used, leave it here.
> > > +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.
> >
>
> Ok, I'll change it, thanks for the info.
>
>
> >
> > > +
> > > +-}
> > > +{-
> > > +
> > > +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.
> >
>
> Do you mean just here for some specific reason, or do you suggest using the
> infix fmap in general?
> Anyway, OK, I'll change it.
No need to change. I just find that in some situations (like when the
right side is not a simple value), the infix version is cleaner, as you
don't have to use '$'.
> > > +-- | 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.
> >
>
> Ops, sorry, I missed it.
> I'll add it.
>
>
> >
> > > +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?
> >
>
> We don't really NEED to, but it seemed like a nice thing to do. But on the
> other hand I don't have a strong argument in favor of either solutions. If
> you think a Maybe can be better, I can use it.
Nope, I don't have preference either way, was just thinking if the
reason you have ActualUnknown is that Xen can return it sometimes, or…
> > > +-- | 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.
> >
>
> Mmmh... I'll try to rewrite it in a different way.
Not necessarily needed. Was just commenting that this looks like a
standard pattern, I would expect it to be doable via something already
defined. If not, then you can leave it as it is.
> > > + case foldr foldResult (Ok Map.empty) domains of
> > > + (Ok d) -> return d
> > > + (Bad msg) -> fail msg
> >
> > No need for parentheses here.
> >
>
> Ok.
>
>
> >
> > > 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?
> >
>
> I put it here because of AdminState, but you are right. AdminState is
> generic, whereas this is Xen specific.
> I'll move it.
I see. Thanks.
> > > $(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.
> >
> >
> Ups... I just noticed I read the "release" line in "xm info" while looking
> for the version number, but that's the kernel.
> Xen is 4.0: it's the one installed on the test clusters. I'll fix the file
> names.
Thanks!
iustin
