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.
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 -- | Serialize a single group
55 serializeGroup :: Group.Group -> String
57 printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
58 (apolToString (Group.allocPolicy grp))
60 -- | Generate group file data from a group list
61 serializeGroups :: Group.List -> String
62 serializeGroups = unlines . map serializeGroup . Container.elems
64 -- | Serialize a single node
65 serializeNode :: Group.List -> Node.Node -> String
66 serializeNode gl node =
67 printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node)
68 (Node.tMem node) (Node.nMem node) (Node.fMem node)
69 (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
70 (if Node.offline node then 'Y' else 'N')
72 where grp = Container.find (Node.group node) gl
74 -- | Generate node file data from node objects
75 serializeNodes :: Group.List -> Node.List -> String
76 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
78 -- | Serialize a single instance
79 serializeInstance :: Node.List -> Instance.Instance -> String
80 serializeInstance nl inst =
82 iname = Instance.name inst
83 pnode = Container.nameOf nl (Instance.pNode inst)
84 sidx = Instance.sNode inst
85 snode = (if sidx == Node.noSecondary
87 else Container.nameOf nl sidx)
89 printf "%s|%d|%d|%d|%s|%s|%s|%s|%s"
90 iname (Instance.mem inst) (Instance.dsk inst)
91 (Instance.vcpus inst) (Instance.runSt inst)
92 (if Instance.auto_balance inst then "Y" else "N")
93 pnode snode (intercalate "," (Instance.tags inst))
95 -- | Generate instance file data from instance objects
96 serializeInstances :: Node.List -> Instance.List -> String
97 serializeInstances nl =
98 unlines . map (serializeInstance nl) . Container.elems
100 -- | Generate complete cluster data from node and instance lists
101 serializeCluster :: ClusterData -> String
102 serializeCluster (ClusterData gl nl il ctags) =
103 let gdata = serializeGroups gl
104 ndata = serializeNodes gl nl
105 idata = serializeInstances nl il
106 -- note: not using 'unlines' as that adds too many newlines
107 in intercalate "\n" [gdata, ndata, idata, unlines ctags]
109 -- | Load a group from a field list.
110 loadGroup :: (Monad m) => [String] -> m (String, Group.Group)
111 loadGroup [name, gid, apol] = do
112 xapol <- apolFromString apol
113 return (gid, Group.create name gid xapol)
115 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
117 -- | Load a node from a field list.
118 loadNode :: (Monad m) => NameAssoc -> [String] -> m (String, Node.Node)
119 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
120 gdx <- lookupGroup ktg name gu
122 if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
123 return $ Node.create name 0 0 0 0 0 0 True gdx
125 vtm <- tryRead name tm
126 vnm <- tryRead name nm
127 vfm <- tryRead name fm
128 vtd <- tryRead name td
129 vfd <- tryRead name fd
130 vtc <- tryRead name tc
131 return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx
132 return (name, new_node)
133 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
135 -- | Load an instance from a field list.
136 loadInst :: (Monad m) =>
137 NameAssoc -> [String] -> m (String, Instance.Instance)
138 loadInst ktn [name, mem, dsk, vcpus, status, auto_bal, pnode, snode, tags] = do
139 pidx <- lookupNode ktn name pnode
140 sidx <- (if null snode then return Node.noSecondary
141 else lookupNode ktn name snode)
142 vmem <- tryRead name mem
143 vdsk <- tryRead name dsk
144 vvcpus <- tryRead name vcpus
145 auto_balance <- case auto_bal of
148 _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
149 "' for instance " ++ name
150 when (sidx == pidx) $ fail $ "Instance " ++ name ++
151 " has same primary and secondary node - " ++ pnode
152 let vtags = sepSplit ',' tags
153 newinst = Instance.create name vmem vdsk vvcpus status vtags
154 auto_balance pidx sidx
155 return (name, newinst)
156 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
158 -- | Convert newline and delimiter-separated text.
160 -- This function converts a text in tabular format as generated by
161 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
162 -- a supplied conversion function.
163 loadTabular :: (Monad m, Element a) =>
164 [String] -> ([String] -> m (String, a))
165 -> m (NameAssoc, Container.Container a)
166 loadTabular lines_data convert_fn = do
167 let rows = map (sepSplit '|') lines_data
168 kerows <- mapM convert_fn rows
169 return $ assignIndices kerows
171 -- | Load the cluser data from disk.
172 readData :: String -- ^ Path to the text file
176 -- | Builds the cluster data from text input.
177 parseData :: String -- ^ Text data
178 -> Result ClusterData
180 let flines = lines fdata
181 (glines, nlines, ilines, ctags) <-
182 case sepSplit "" flines of
183 [a, b, c, d] -> Ok (a, b, c, d)
184 xs -> Bad $ printf "Invalid format of the input file: %d sections\
185 \ instead of 4" (length xs)
186 {- group file: name uuid -}
187 (ktg, gl) <- loadTabular glines loadGroup
188 {- node file: name t_mem n_mem f_mem t_disk f_disk -}
189 (ktn, nl) <- loadTabular nlines (loadNode ktg)
190 {- instance file: name mem disk status pnode snode -}
191 (_, il) <- loadTabular ilines (loadInst ktn)
192 {- the tags are simply line-based, no processing needed -}
193 return (ClusterData gl nl il ctags)
195 -- | Top level function for data loading
196 loadData :: String -- ^ Path to the text file
197 -> IO (Result ClusterData)
198 loadData = fmap parseData . readData