1 {-| Parsing data from text-files.
3 This module holds the code for loading the cluster state from text
4 files, as produced by @gnt-node@ and @gnt-instance@ @list@ command.
10 Copyright (C) 2009, 2010, 2011 Google Inc.
12 This program is free software; you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation; either version 2 of the License, or
15 (at your option) any later version.
17 This program is distributed in the hope that it will be useful, but
18 WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with this program; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 module Ganeti.HTools.Text
43 import Text.Printf (printf)
45 import Ganeti.HTools.Utils
46 import Ganeti.HTools.Loader
47 import Ganeti.HTools.Types
48 import qualified Ganeti.HTools.Container as Container
49 import qualified Ganeti.HTools.Group as Group
50 import qualified Ganeti.HTools.Node as Node
51 import qualified Ganeti.HTools.Instance as Instance
53 -- * Serialisation functions
55 -- | Serialize a single group.
56 serializeGroup :: Group.Group -> String
58 printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
59 (allocPolicyToRaw (Group.allocPolicy grp))
61 -- | Generate group file data from a group list.
62 serializeGroups :: Group.List -> String
63 serializeGroups = unlines . map serializeGroup . Container.elems
65 -- | Serialize a single node.
66 serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
67 -> Node.Node -- ^ The node to be serialised
69 serializeNode gl node =
70 printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node)
71 (Node.tMem node) (Node.nMem node) (Node.fMem node)
72 (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
73 (if Node.offline node then 'Y' else 'N')
75 where grp = Container.find (Node.group node) gl
77 -- | Generate node file data from node objects.
78 serializeNodes :: Group.List -> Node.List -> String
79 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
81 -- | Serialize a single instance.
82 serializeInstance :: Node.List -- ^ The node list (needed for
84 -> Instance.Instance -- ^ The instance to be serialised
86 serializeInstance nl inst =
87 let iname = Instance.name inst
88 pnode = Container.nameOf nl (Instance.pNode inst)
89 sidx = Instance.sNode inst
90 snode = (if sidx == Node.noSecondary
92 else Container.nameOf nl sidx)
93 in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s"
94 iname (Instance.mem inst) (Instance.dsk inst)
95 (Instance.vcpus inst) (instanceStatusToRaw (Instance.runSt inst))
96 (if Instance.autoBalance inst then "Y" else "N")
97 pnode snode (diskTemplateToRaw (Instance.diskTemplate inst))
98 (intercalate "," (Instance.tags inst))
100 -- | Generate instance file data from instance objects.
101 serializeInstances :: Node.List -> Instance.List -> String
102 serializeInstances nl =
103 unlines . map (serializeInstance nl) . Container.elems
105 -- | Generate complete cluster data from node and instance lists.
106 serializeCluster :: ClusterData -> String
107 serializeCluster (ClusterData gl nl il ctags _) =
108 let gdata = serializeGroups gl
109 ndata = serializeNodes gl nl
110 idata = serializeInstances nl il
111 -- note: not using 'unlines' as that adds too many newlines
112 in intercalate "\n" [gdata, ndata, idata, unlines ctags]
114 -- * Parsing functions
116 -- | Load a group from a field list.
117 loadGroup :: (Monad m) => [String]
118 -> m (String, Group.Group) -- ^ The result, a tuple of group
119 -- UUID and group object
120 loadGroup [name, gid, apol] = do
121 xapol <- allocPolicyFromRaw apol
122 return (gid, Group.create name gid xapol)
124 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
126 -- | Load a node from a field list.
127 loadNode :: (Monad m) =>
128 NameAssoc -- ^ Association list with current groups
129 -> [String] -- ^ Input data as a list of fields
130 -> m (String, Node.Node) -- ^ The result, a tuple o node name
132 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
133 gdx <- lookupGroup ktg name gu
135 if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
136 return $ Node.create name 0 0 0 0 0 0 True gdx
138 vtm <- tryRead name tm
139 vnm <- tryRead name nm
140 vfm <- tryRead name fm
141 vtd <- tryRead name td
142 vfd <- tryRead name fd
143 vtc <- tryRead name tc
144 return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx
145 return (name, new_node)
146 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
148 -- | Load an instance from a field list.
149 loadInst :: NameAssoc -- ^ Association list with the current nodes
150 -> [String] -- ^ Input data as a list of fields
151 -> Result (String, Instance.Instance) -- ^ A tuple of
153 -- the instance object
154 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
156 pidx <- lookupNode ktn name pnode
157 sidx <- if null snode
158 then return Node.noSecondary
159 else lookupNode ktn name snode
160 vmem <- tryRead name mem
161 vdsk <- tryRead name dsk
162 vvcpus <- tryRead name vcpus
163 vstatus <- instanceStatusFromRaw status
164 auto_balance <- case auto_bal of
167 _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
168 "' for instance " ++ name
169 disk_template <- annotateResult ("Instance " ++ name)
170 (diskTemplateFromRaw dt)
171 when (sidx == pidx) $ fail $ "Instance " ++ name ++
172 " has same primary and secondary node - " ++ pnode
173 let vtags = sepSplit ',' tags
174 newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
175 auto_balance pidx sidx disk_template
176 return (name, newinst)
177 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
179 -- | Convert newline and delimiter-separated text.
181 -- This function converts a text in tabular format as generated by
182 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
183 -- a supplied conversion function.
184 loadTabular :: (Monad m, Element a) =>
185 [String] -- ^ Input data, as a list of lines
186 -> ([String] -> m (String, a)) -- ^ Conversion function
188 , Container.Container a ) -- ^ A tuple of an
189 -- association list (name
190 -- to object) and a set as
192 -- "Ganeti.HTools.Container"
194 loadTabular lines_data convert_fn = do
195 let rows = map (sepSplit '|') lines_data
196 kerows <- mapM convert_fn rows
197 return $ assignIndices kerows
199 -- | Load the cluser data from disk.
201 -- This is an alias to 'readFile' just for consistency with the other
203 readData :: String -- ^ Path to the text file
204 -> IO String -- ^ Contents of the file
207 -- | Builds the cluster data from text input.
208 parseData :: String -- ^ Text data
209 -> Result ClusterData
211 let flines = lines fdata
212 (glines, nlines, ilines, ctags) <-
213 case sepSplit "" flines of
214 [a, b, c, d] -> Ok (a, b, c, d)
215 xs -> Bad $ printf "Invalid format of the input file: %d sections\
216 \ instead of 4" (length xs)
217 {- group file: name uuid -}
218 (ktg, gl) <- loadTabular glines loadGroup
219 {- node file: name t_mem n_mem f_mem t_disk f_disk -}
220 (ktn, nl) <- loadTabular nlines (loadNode ktg)
221 {- instance file: name mem disk status pnode snode -}
222 (_, il) <- loadTabular ilines (loadInst ktn)
223 {- the tags are simply line-based, no processing needed -}
224 return (ClusterData gl nl il ctags defIPolicy)
226 -- | Top level function for data loading.
227 loadData :: String -- ^ Path to the text file
228 -> IO (Result ClusterData)
229 loadData = fmap parseData . readData