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
44 import Text.Printf (printf)
46 import Ganeti.HTools.Utils
47 import Ganeti.HTools.Loader
48 import Ganeti.HTools.Types
49 import qualified Ganeti.HTools.Container as Container
50 import qualified Ganeti.HTools.Group as Group
51 import qualified Ganeti.HTools.Node as Node
52 import qualified Ganeti.HTools.Instance as Instance
54 -- * Serialisation functions
56 -- | Serialize a single group.
57 serializeGroup :: Group.Group -> String
59 printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
60 (allocPolicyToString (Group.allocPolicy grp))
62 -- | Generate group file data from a group list.
63 serializeGroups :: Group.List -> String
64 serializeGroups = unlines . map serializeGroup . Container.elems
66 -- | Serialize a single node.
67 serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
68 -> Node.Node -- ^ The node to be serialised
70 serializeNode gl node =
71 printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node)
72 (Node.tMem node) (Node.nMem node) (Node.fMem node)
73 (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
74 (if Node.offline node then 'Y' else 'N')
76 where grp = Container.find (Node.group node) gl
78 -- | Generate node file data from node objects.
79 serializeNodes :: Group.List -> Node.List -> String
80 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
82 -- | Serialize a single instance.
83 serializeInstance :: Node.List -- ^ The node list (needed for
85 -> Instance.Instance -- ^ The instance to be serialised
87 serializeInstance nl inst =
89 iname = Instance.name inst
90 pnode = Container.nameOf nl (Instance.pNode inst)
91 sidx = Instance.sNode inst
92 snode = (if sidx == Node.noSecondary
94 else Container.nameOf nl sidx)
96 printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s"
97 iname (Instance.mem inst) (Instance.dsk inst)
98 (Instance.vcpus inst) (Instance.runSt inst)
99 (if Instance.autoBalance inst then "Y" else "N")
100 pnode snode (diskTemplateToString (Instance.diskTemplate inst))
101 (intercalate "," (Instance.tags inst))
103 -- | Generate instance file data from instance objects.
104 serializeInstances :: Node.List -> Instance.List -> String
105 serializeInstances nl =
106 unlines . map (serializeInstance nl) . Container.elems
108 -- | Generate complete cluster data from node and instance lists.
109 serializeCluster :: ClusterData -> String
110 serializeCluster (ClusterData gl nl il ctags) =
111 let gdata = serializeGroups gl
112 ndata = serializeNodes gl nl
113 idata = serializeInstances nl il
114 -- note: not using 'unlines' as that adds too many newlines
115 in intercalate "\n" [gdata, ndata, idata, unlines ctags]
117 -- * Parsing functions
119 -- | Load a group from a field list.
120 loadGroup :: (Monad m) => [String]
121 -> m (String, Group.Group) -- ^ The result, a tuple of group
122 -- UUID and group object
123 loadGroup [name, gid, apol] = do
124 xapol <- allocPolicyFromString apol
125 return (gid, Group.create name gid xapol)
127 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
129 -- | Load a node from a field list.
130 loadNode :: (Monad m) =>
131 NameAssoc -- ^ Association list with current groups
132 -> [String] -- ^ Input data as a list of fields
133 -> m (String, Node.Node) -- ^ The result, a tuple o node name
135 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
136 gdx <- lookupGroup ktg name gu
138 if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
139 return $ Node.create name 0 0 0 0 0 0 True gdx
141 vtm <- tryRead name tm
142 vnm <- tryRead name nm
143 vfm <- tryRead name fm
144 vtd <- tryRead name td
145 vfd <- tryRead name fd
146 vtc <- tryRead name tc
147 return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx
148 return (name, new_node)
149 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
151 -- | Load an instance from a field list.
152 loadInst :: NameAssoc -- ^ Association list with the current nodes
153 -> [String] -- ^ Input data as a list of fields
154 -> Result (String, Instance.Instance) -- ^ A tuple of
156 -- the instance object
157 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
159 pidx <- lookupNode ktn name pnode
160 sidx <- (if null snode then return Node.noSecondary
161 else lookupNode ktn name snode)
162 vmem <- tryRead name mem
163 vdsk <- tryRead name dsk
164 vvcpus <- tryRead name vcpus
165 auto_balance <- case auto_bal of
168 _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
169 "' for instance " ++ name
170 disk_template <- annotateResult ("Instance " ++ name)
171 (diskTemplateFromString dt)
172 when (sidx == pidx) $ fail $ "Instance " ++ name ++
173 " has same primary and secondary node - " ++ pnode
174 let vtags = sepSplit ',' tags
175 newinst = Instance.create name vmem vdsk vvcpus status vtags
176 auto_balance pidx sidx disk_template
177 return (name, newinst)
178 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
180 -- | Convert newline and delimiter-separated text.
182 -- This function converts a text in tabular format as generated by
183 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
184 -- a supplied conversion function.
185 loadTabular :: (Monad m, Element a) =>
186 [String] -- ^ Input data, as a list of lines
187 -> ([String] -> m (String, a)) -- ^ Conversion function
189 , Container.Container a ) -- ^ A tuple of an
190 -- association list (name
191 -- to object) and a set as
193 -- "Ganeti.HTools.Container"
195 loadTabular lines_data convert_fn = do
196 let rows = map (sepSplit '|') lines_data
197 kerows <- mapM convert_fn rows
198 return $ assignIndices kerows
200 -- | Load the cluser data from disk.
202 -- This is an alias to 'readFile' just for consistency with the other
204 readData :: String -- ^ Path to the text file
205 -> IO String -- ^ Contents of the file
208 -- | Builds the cluster data from text input.
209 parseData :: String -- ^ Text data
210 -> Result ClusterData
212 let flines = lines fdata
213 (glines, nlines, ilines, ctags) <-
214 case sepSplit "" flines of
215 [a, b, c, d] -> Ok (a, b, c, d)
216 xs -> Bad $ printf "Invalid format of the input file: %d sections\
217 \ instead of 4" (length xs)
218 {- group file: name uuid -}
219 (ktg, gl) <- loadTabular glines loadGroup
220 {- node file: name t_mem n_mem f_mem t_disk f_disk -}
221 (ktn, nl) <- loadTabular nlines (loadNode ktg)
222 {- instance file: name mem disk status pnode snode -}
223 (_, il) <- loadTabular ilines (loadInst ktn)
224 {- the tags are simply line-based, no processing needed -}
225 return (ClusterData gl nl il ctags)
227 -- | Top level function for data loading.
228 loadData :: String -- ^ Path to the text file
229 -> IO (Result ClusterData)
230 loadData = fmap parseData . readData