root / src / Ganeti / Hypervisor / Xen / XmParser.hs @ c5a957c3
History | View | Annotate | Download (5.9 kB)
1 | b8585908 | Michele Tartara | {-# LANGUAGE OverloadedStrings #-} |
---|---|---|---|
2 | b8585908 | Michele Tartara | {-| Parser for the output of the @xm list --long@ command of Xen |
3 | b8585908 | Michele Tartara | |
4 | b8585908 | Michele Tartara | -} |
5 | b8585908 | Michele Tartara | {- |
6 | b8585908 | Michele Tartara | |
7 | b8585908 | Michele Tartara | Copyright (C) 2013 Google Inc. |
8 | b8585908 | Michele Tartara | |
9 | b8585908 | Michele Tartara | This program is free software; you can redistribute it and/or modify |
10 | b8585908 | Michele Tartara | it under the terms of the GNU General Public License as published by |
11 | b8585908 | Michele Tartara | the Free Software Foundation; either version 2 of the License, or |
12 | b8585908 | Michele Tartara | (at your option) any later version. |
13 | b8585908 | Michele Tartara | |
14 | b8585908 | Michele Tartara | This program is distributed in the hope that it will be useful, but |
15 | b8585908 | Michele Tartara | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | b8585908 | Michele Tartara | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | b8585908 | Michele Tartara | General Public License for more details. |
18 | b8585908 | Michele Tartara | |
19 | b8585908 | Michele Tartara | You should have received a copy of the GNU General Public License |
20 | b8585908 | Michele Tartara | along with this program; if not, write to the Free Software |
21 | b8585908 | Michele Tartara | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | b8585908 | Michele Tartara | 02110-1301, USA. |
23 | b8585908 | Michele Tartara | |
24 | b8585908 | Michele Tartara | -} |
25 | b8585908 | Michele Tartara | module Ganeti.Hypervisor.Xen.XmParser |
26 | b8585908 | Michele Tartara | ( xmListParser |
27 | b8585908 | Michele Tartara | , lispConfigParser |
28 | c5a957c3 | Michele Tartara | , xmUptimeParser |
29 | c5a957c3 | Michele Tartara | , uptimeLineParser |
30 | b8585908 | Michele Tartara | ) where |
31 | b8585908 | Michele Tartara | |
32 | b8585908 | Michele Tartara | import Control.Applicative |
33 | b8585908 | Michele Tartara | import Control.Monad |
34 | b8585908 | Michele Tartara | import qualified Data.Attoparsec.Combinator as AC |
35 | b8585908 | Michele Tartara | import qualified Data.Attoparsec.Text as A |
36 | b8585908 | Michele Tartara | import Data.Attoparsec.Text (Parser) |
37 | b8585908 | Michele Tartara | import Data.Char |
38 | b8585908 | Michele Tartara | import Data.List |
39 | b8585908 | Michele Tartara | import Data.Text (unpack) |
40 | b8585908 | Michele Tartara | import qualified Data.Map as Map |
41 | b8585908 | Michele Tartara | |
42 | b8585908 | Michele Tartara | import Ganeti.BasicTypes |
43 | b8585908 | Michele Tartara | import Ganeti.Hypervisor.Xen.Types |
44 | b8585908 | Michele Tartara | |
45 | b8585908 | Michele Tartara | -- | A parser for parsing generic config files written in the (LISP-like) |
46 | b8585908 | Michele Tartara | -- format that is the output of the @xm list --long@ command. |
47 | b8585908 | Michele Tartara | -- This parser only takes care of the syntactic parse, but does not care |
48 | b8585908 | Michele Tartara | -- about the semantics. |
49 | b8585908 | Michele Tartara | -- Note: parsing the double requires checking for the next character in order |
50 | b8585908 | Michele Tartara | -- to prevent string like "9a" to be recognized as the number 9. |
51 | b8585908 | Michele Tartara | lispConfigParser :: Parser LispConfig |
52 | b8585908 | Michele Tartara | lispConfigParser = |
53 | b8585908 | Michele Tartara | A.skipSpace *> |
54 | b8585908 | Michele Tartara | ( listConfigP |
55 | b8585908 | Michele Tartara | <|> doubleP |
56 | b8585908 | Michele Tartara | <|> stringP |
57 | b8585908 | Michele Tartara | ) |
58 | b8585908 | Michele Tartara | <* A.skipSpace |
59 | b8585908 | Michele Tartara | where listConfigP = LCList <$> (A.char '(' *> liftA2 (++) |
60 | b8585908 | Michele Tartara | (many middleP) |
61 | b8585908 | Michele Tartara | (((:[]) <$> finalP) <|> (rparen *> pure []))) |
62 | b8585908 | Michele Tartara | doubleP = LCDouble <$> A.double <* A.skipSpace <* A.endOfInput |
63 | b8585908 | Michele Tartara | innerDoubleP = LCDouble <$> A.double |
64 | b8585908 | Michele Tartara | stringP = LCString . unpack <$> A.takeWhile1 (not . (\c -> isSpace c |
65 | b8585908 | Michele Tartara | || c `elem` "()")) |
66 | b8585908 | Michele Tartara | wspace = AC.many1 A.space |
67 | b8585908 | Michele Tartara | rparen = A.skipSpace *> A.char ')' |
68 | b8585908 | Michele Tartara | finalP = listConfigP <* rparen |
69 | b8585908 | Michele Tartara | <|> innerDoubleP <* rparen |
70 | b8585908 | Michele Tartara | <|> stringP <* rparen |
71 | b8585908 | Michele Tartara | middleP = listConfigP <* wspace |
72 | b8585908 | Michele Tartara | <|> innerDoubleP <* wspace |
73 | b8585908 | Michele Tartara | <|> stringP <* wspace |
74 | b8585908 | Michele Tartara | |
75 | b8585908 | Michele Tartara | |
76 | b8585908 | Michele Tartara | -- | Find a configuration having the given string as its first element, |
77 | b8585908 | Michele Tartara | -- from a list of configurations. |
78 | b8585908 | Michele Tartara | findConf :: String -> [LispConfig] -> Result LispConfig |
79 | b8585908 | Michele Tartara | findConf key configs = |
80 | b8585908 | Michele Tartara | case find (isNamed key) configs of |
81 | b8585908 | Michele Tartara | (Just c) -> Ok c |
82 | b8585908 | Michele Tartara | _ -> Bad "Configuration not found" |
83 | b8585908 | Michele Tartara | |
84 | b8585908 | Michele Tartara | -- | Get the value of of a configuration having the given string as its |
85 | b8585908 | Michele Tartara | -- first element. |
86 | b8585908 | Michele Tartara | -- The value is the content of the configuration, discarding the name itself. |
87 | b8585908 | Michele Tartara | getValue :: (FromLispConfig a) => String -> [LispConfig] -> Result a |
88 | b8585908 | Michele Tartara | getValue key configs = findConf key configs >>= fromLispConfig |
89 | b8585908 | Michele Tartara | |
90 | b8585908 | Michele Tartara | -- | Extract the values of a configuration containing a list of them. |
91 | b8585908 | Michele Tartara | extractValues :: LispConfig -> Result [LispConfig] |
92 | b8585908 | Michele Tartara | extractValues c = tail `fmap` fromLispConfig c |
93 | b8585908 | Michele Tartara | |
94 | b8585908 | Michele Tartara | -- | Verify whether the given configuration has a certain name or not.fmap |
95 | b8585908 | Michele Tartara | -- The name of a configuration is its first parameter, if it is a string. |
96 | b8585908 | Michele Tartara | isNamed :: String -> LispConfig -> Bool |
97 | b8585908 | Michele Tartara | isNamed key (LCList (LCString x:_)) = x == key |
98 | b8585908 | Michele Tartara | isNamed _ _ = False |
99 | b8585908 | Michele Tartara | |
100 | b8585908 | Michele Tartara | -- | Parser for recognising the current state of a Xen domain. |
101 | b8585908 | Michele Tartara | parseState :: String -> ActualState |
102 | b8585908 | Michele Tartara | parseState s = |
103 | b8585908 | Michele Tartara | case s of |
104 | b8585908 | Michele Tartara | "r-----" -> ActualRunning |
105 | b8585908 | Michele Tartara | "-b----" -> ActualBlocked |
106 | b8585908 | Michele Tartara | "--p---" -> ActualPaused |
107 | b8585908 | Michele Tartara | "---s--" -> ActualShutdown |
108 | b8585908 | Michele Tartara | "----c-" -> ActualCrashed |
109 | b8585908 | Michele Tartara | "-----d" -> ActualDying |
110 | b8585908 | Michele Tartara | _ -> ActualUnknown |
111 | b8585908 | Michele Tartara | |
112 | b8585908 | Michele Tartara | -- | Extract the configuration data of a Xen domain from a generic LispConfig |
113 | b8585908 | Michele Tartara | -- data structure. Fail if the LispConfig does not represent a domain. |
114 | b8585908 | Michele Tartara | getDomainConfig :: LispConfig -> Result Domain |
115 | b8585908 | Michele Tartara | getDomainConfig configData = do |
116 | b8585908 | Michele Tartara | domainConf <- |
117 | b8585908 | Michele Tartara | if isNamed "domain" configData |
118 | b8585908 | Michele Tartara | then extractValues configData |
119 | b8585908 | Michele Tartara | else Bad $ "Not a domain configuration: " ++ show configData |
120 | b8585908 | Michele Tartara | domid <- getValue "domid" domainConf |
121 | b8585908 | Michele Tartara | name <- getValue "name" domainConf |
122 | b8585908 | Michele Tartara | cpuTime <- getValue "cpu_time" domainConf |
123 | b8585908 | Michele Tartara | state <- getValue "state" domainConf |
124 | b8585908 | Michele Tartara | let actualState = parseState state |
125 | b8585908 | Michele Tartara | return $ Domain domid name cpuTime actualState Nothing |
126 | b8585908 | Michele Tartara | |
127 | b8585908 | Michele Tartara | -- | A parser for parsing the output of the @xm list --long@ command. |
128 | b8585908 | Michele Tartara | -- It adds the semantic layer on top of lispConfigParser. |
129 | b8585908 | Michele Tartara | -- It returns a map of domains, with their name as the key. |
130 | b8585908 | Michele Tartara | -- FIXME: This is efficient under the assumption that only a few fields of the |
131 | b8585908 | Michele Tartara | -- domain configuration are actually needed. If many of them are required, a |
132 | b8585908 | Michele Tartara | -- parser able to directly extract the domain config would actually be better. |
133 | b8585908 | Michele Tartara | xmListParser :: Parser (Map.Map String Domain) |
134 | b8585908 | Michele Tartara | xmListParser = do |
135 | b8585908 | Michele Tartara | configs <- lispConfigParser `AC.manyTill` A.endOfInput |
136 | b8585908 | Michele Tartara | let domains = map getDomainConfig configs |
137 | b8585908 | Michele Tartara | foldResult m (Ok val) = Ok $ Map.insert (domName val) val m |
138 | b8585908 | Michele Tartara | foldResult _ (Bad msg) = Bad msg |
139 | b8585908 | Michele Tartara | case foldM foldResult Map.empty domains of |
140 | b8585908 | Michele Tartara | Ok d -> return d |
141 | b8585908 | Michele Tartara | Bad msg -> fail msg |
142 | c5a957c3 | Michele Tartara | |
143 | c5a957c3 | Michele Tartara | -- | A parser for parsing the output of the @xm uptime@ command. |
144 | c5a957c3 | Michele Tartara | xmUptimeParser :: Parser (Map.Map Int UptimeInfo) |
145 | c5a957c3 | Michele Tartara | xmUptimeParser = do |
146 | c5a957c3 | Michele Tartara | _ <- headerParser |
147 | c5a957c3 | Michele Tartara | uptimes <- uptimeLineParser `AC.manyTill` A.endOfInput |
148 | c5a957c3 | Michele Tartara | return $ Map.fromList [(uInfoID u, u) | u <- uptimes] |
149 | c5a957c3 | Michele Tartara | where headerParser = A.string "Name" <* A.skipSpace <* A.string "ID" |
150 | c5a957c3 | Michele Tartara | <* A.skipSpace <* A.string "Uptime" <* A.skipSpace |
151 | c5a957c3 | Michele Tartara | |
152 | c5a957c3 | Michele Tartara | -- | A helper for parsing a single line of the @xm uptime@ output. |
153 | c5a957c3 | Michele Tartara | uptimeLineParser :: Parser UptimeInfo |
154 | c5a957c3 | Michele Tartara | uptimeLineParser = do |
155 | c5a957c3 | Michele Tartara | name <- A.takeTill isSpace <* A.skipSpace |
156 | c5a957c3 | Michele Tartara | idNum <- A.decimal <* A.skipSpace |
157 | c5a957c3 | Michele Tartara | uptime <- A.takeTill (`elem` "\n\r") <* A.skipSpace |
158 | c5a957c3 | Michele Tartara | return . UptimeInfo (unpack name) idNum $ unpack uptime |