Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Hypervisor / Xen / XmParser.hs @ b8585908

History | View | Annotate | Download (5.1 kB)

1
{-# LANGUAGE OverloadedStrings #-}
2
{-| Parser for the output of the @xm list --long@ command of Xen
3

    
4
-}
5
{-
6

    
7
Copyright (C) 2013 Google Inc.
8

    
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

    
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

    
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

    
24
-}
25
module Ganeti.Hypervisor.Xen.XmParser
26
  ( xmListParser
27
  , lispConfigParser
28
  ) where
29

    
30
import Control.Applicative
31
import Control.Monad
32
import qualified Data.Attoparsec.Combinator as AC
33
import qualified Data.Attoparsec.Text as A
34
import Data.Attoparsec.Text (Parser)
35
import Data.Char
36
import Data.List
37
import Data.Text (unpack)
38
import qualified Data.Map as Map
39

    
40
import Ganeti.BasicTypes
41
import Ganeti.Hypervisor.Xen.Types
42

    
43
-- | A parser for parsing generic config files written in the (LISP-like)
44
-- format that is the output of the @xm list --long@ command.
45
-- This parser only takes care of the syntactic parse, but does not care
46
-- about the semantics.
47
-- Note: parsing the double requires checking for the next character in order
48
-- to prevent string like "9a" to be recognized as the number 9.
49
lispConfigParser :: Parser LispConfig
50
lispConfigParser =
51
  A.skipSpace *>
52
    (   listConfigP
53
    <|> doubleP
54
    <|> stringP
55
    )
56
  <* A.skipSpace
57
    where listConfigP = LCList <$> (A.char '(' *> liftA2 (++)
58
            (many middleP)
59
            (((:[]) <$> finalP) <|> (rparen *> pure [])))
60
          doubleP = LCDouble <$> A.double <* A.skipSpace <* A.endOfInput
61
          innerDoubleP = LCDouble <$> A.double
62
          stringP = LCString . unpack <$> A.takeWhile1 (not . (\c -> isSpace c
63
            || c `elem` "()"))
64
          wspace = AC.many1 A.space
65
          rparen = A.skipSpace *> A.char ')'
66
          finalP =   listConfigP <* rparen
67
                 <|> innerDoubleP <* rparen
68
                 <|> stringP <* rparen
69
          middleP =   listConfigP <* wspace
70
                  <|> innerDoubleP <* wspace
71
                  <|> stringP <* wspace
72

    
73

    
74
-- | Find a configuration having the given string as its first element,
75
-- from a list of configurations.
76
findConf :: String -> [LispConfig] -> Result LispConfig
77
findConf key configs =
78
  case find (isNamed key) configs of
79
    (Just c) -> Ok c
80
    _ -> Bad "Configuration not found"
81

    
82
-- | Get the value of of a configuration having the given string as its
83
-- first element.
84
-- The value is the content of the configuration, discarding the name itself.
85
getValue :: (FromLispConfig a) => String -> [LispConfig] -> Result a
86
getValue key configs = findConf key configs >>= fromLispConfig
87

    
88
-- | Extract the values of a configuration containing a list of them.
89
extractValues :: LispConfig -> Result [LispConfig]
90
extractValues c = tail `fmap` fromLispConfig c
91

    
92
-- | Verify whether the given configuration has a certain name or not.fmap
93
-- The name of a configuration is its first parameter, if it is a string.
94
isNamed :: String -> LispConfig -> Bool
95
isNamed key (LCList (LCString x:_)) = x == key
96
isNamed _ _ = False
97

    
98
-- | Parser for recognising the current state of a Xen domain.
99
parseState :: String -> ActualState
100
parseState s =
101
  case s of
102
    "r-----" -> ActualRunning
103
    "-b----" -> ActualBlocked
104
    "--p---" -> ActualPaused
105
    "---s--" -> ActualShutdown
106
    "----c-" -> ActualCrashed
107
    "-----d" -> ActualDying
108
    _ -> ActualUnknown
109

    
110
-- | Extract the configuration data of a Xen domain from a generic LispConfig
111
-- data structure. Fail if the LispConfig does not represent a domain.
112
getDomainConfig :: LispConfig -> Result Domain
113
getDomainConfig configData = do
114
  domainConf <-
115
    if isNamed "domain" configData
116
      then extractValues configData
117
      else Bad $ "Not a domain configuration: " ++ show configData
118
  domid <- getValue "domid" domainConf
119
  name <- getValue "name" domainConf
120
  cpuTime <- getValue "cpu_time" domainConf
121
  state <- getValue "state" domainConf
122
  let actualState = parseState state
123
  return $ Domain domid name cpuTime actualState Nothing
124

    
125
-- | A parser for parsing the output of the @xm list --long@ command.
126
-- It adds the semantic layer on top of lispConfigParser.
127
-- It returns a map of domains, with their name as the key.
128
-- FIXME: This is efficient under the assumption that only a few fields of the
129
-- domain configuration are actually needed. If many of them are required, a
130
-- parser able to directly extract the domain config would actually be better.
131
xmListParser :: Parser (Map.Map String Domain)
132
xmListParser = do
133
  configs <- lispConfigParser `AC.manyTill` A.endOfInput
134
  let domains = map getDomainConfig configs
135
      foldResult m (Ok val) = Ok $ Map.insert (domName val) val m
136
      foldResult _ (Bad msg) = Bad msg
137
  case foldM foldResult Map.empty domains of
138
    Ok d -> return d
139
    Bad msg -> fail msg