code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/Text.hs

   1 {-| Parsing data from text-files.
   2
   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.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
  11
  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.
  16
  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.
  21
  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
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Ganeti.HTools.Text
  30   ( loadData
  31   , parseData
  32   , loadInst
  33   , loadNode
  34   , loadISpec
  35   , loadIPolicy
  36   , serializeInstances
  37   , serializeNode
  38   , serializeNodes
  39   , serializeGroup
  40   , serializeISpec
  41   , serializeIPolicy
  42   , serializeCluster
  43   ) where
  44
  45 import Control.Monad
  46 import Data.List
  47
  48 import Text.Printf (printf)
  49
  50 import Ganeti.HTools.Utils
  51 import Ganeti.HTools.Loader
  52 import Ganeti.HTools.Types
  53 import qualified Ganeti.HTools.Container as Container
  54 import qualified Ganeti.HTools.Group as Group
  55 import qualified Ganeti.HTools.Node as Node
  56 import qualified Ganeti.HTools.Instance as Instance
  57
  58 -- * Helper functions
  59
  60 -- | Simple wrapper over sepSplit
  61 commaSplit :: String -> [String]
  62 commaSplit = sepSplit ','
  63
  64 -- * Serialisation functions
  65
  66 -- | Serialize a single group.
  67 serializeGroup :: Group.Group -> String
  68 serializeGroup grp =
  69   printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
  70            (allocPolicyToRaw (Group.allocPolicy grp))
  71
  72 -- | Generate group file data from a group list.
  73 serializeGroups :: Group.List -> String
  74 serializeGroups = unlines . map serializeGroup . Container.elems
  75
  76 -- | Serialize a single node.
  77 serializeNode :: Group.List -- ^ The list of groups (needed for group uuid)
  78               -> Node.Node  -- ^ The node to be serialised
  79               -> String
  80 serializeNode gl node =
  81   printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s|%d" (Node.name node)
  82            (Node.tMem node) (Node.nMem node) (Node.fMem node)
  83            (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
  84            (if Node.offline node then 'Y' else 'N')
  85            (Group.uuid grp)
  86            (Node.spindleCount node)
  87     where grp = Container.find (Node.group node) gl
  88
  89 -- | Generate node file data from node objects.
  90 serializeNodes :: Group.List -> Node.List -> String
  91 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
  92
  93 -- | Serialize a single instance.
  94 serializeInstance :: Node.List         -- ^ The node list (needed for
  95                                        -- node names)
  96                   -> Instance.Instance -- ^ The instance to be serialised
  97                   -> String
  98 serializeInstance nl inst =
  99   let iname = Instance.name inst
 100       pnode = Container.nameOf nl (Instance.pNode inst)
 101       sidx = Instance.sNode inst
 102       snode = (if sidx == Node.noSecondary
 103                  then ""
 104                  else Container.nameOf nl sidx)
 105   in printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s|%d"
 106        iname (Instance.mem inst) (Instance.dsk inst)
 107        (Instance.vcpus inst) (instanceStatusToRaw (Instance.runSt inst))
 108        (if Instance.autoBalance inst then "Y" else "N")
 109        pnode snode (diskTemplateToRaw (Instance.diskTemplate inst))
 110        (intercalate "," (Instance.tags inst)) (Instance.spindleUse inst)
 111
 112 -- | Generate instance file data from instance objects.
 113 serializeInstances :: Node.List -> Instance.List -> String
 114 serializeInstances nl =
 115   unlines . map (serializeInstance nl) . Container.elems
 116
 117 -- | Generate a spec data from a given ISpec object.
 118 serializeISpec :: ISpec -> String
 119 serializeISpec ispec =
 120   -- this needs to be kept in sync with the object definition
 121   let ISpec mem_s cpu_c disk_s disk_c nic_c su = ispec
 122       strings = [show mem_s, show cpu_c, show disk_s, show disk_c, show nic_c,
 123                  show su]
 124   in intercalate "," strings
 125
 126 -- | Generate disk template data.
 127 serializeDiskTemplates :: [DiskTemplate] -> String
 128 serializeDiskTemplates = intercalate "," . map diskTemplateToRaw
 129
 130 -- | Generate policy data from a given policy object.
 131 serializeIPolicy :: String -> IPolicy -> String
 132 serializeIPolicy owner ipol =
 133   let IPolicy stdspec minspec maxspec dts vcpu_ratio spindle_ratio = ipol
 134       strings = [ owner
 135                 , serializeISpec stdspec
 136                 , serializeISpec minspec
 137                 , serializeISpec maxspec
 138                 , serializeDiskTemplates dts
 139                 , show vcpu_ratio
 140                 , show spindle_ratio
 141                 ]
 142   in intercalate "|" strings
 143
 144 -- | Generates the entire ipolicy section from the cluster and group
 145 -- objects.
 146 serializeAllIPolicies :: IPolicy -> Group.List -> String
 147 serializeAllIPolicies cpol gl =
 148   let groups = Container.elems gl
 149       allpolicies = [("", cpol)] ++
 150                     map (\g -> (Group.name g, Group.iPolicy g)) groups
 151       strings = map (uncurry serializeIPolicy) allpolicies
 152   in unlines strings
 153
 154 -- | Generate complete cluster data from node and instance lists.
 155 serializeCluster :: ClusterData -> String
 156 serializeCluster (ClusterData gl nl il ctags cpol) =
 157   let gdata = serializeGroups gl
 158       ndata = serializeNodes gl nl
 159       idata = serializeInstances nl il
 160       pdata = serializeAllIPolicies cpol gl
 161   -- note: not using 'unlines' as that adds too many newlines
 162   in intercalate "\n" [gdata, ndata, idata, unlines ctags, pdata]
 163
 164 -- * Parsing functions
 165
 166 -- | Load a group from a field list.
 167 loadGroup :: (Monad m) => [String]
 168           -> m (String, Group.Group) -- ^ The result, a tuple of group
 169                                      -- UUID and group object
 170 loadGroup [name, gid, apol] = do
 171   xapol <- allocPolicyFromRaw apol
 172   return (gid, Group.create name gid xapol defIPolicy)
 173
 174 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
 175
 176 -- | Load a node from a field list.
 177 loadNode :: (Monad m) =>
 178             NameAssoc             -- ^ Association list with current groups
 179          -> [String]              -- ^ Input data as a list of fields
 180          -> m (String, Node.Node) -- ^ The result, a tuple o node name
 181                                   -- and node object
 182 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] = do
 183   gdx <- lookupGroup ktg name gu
 184   new_node <-
 185       if "?" `elem` [tm,nm,fm,td,fd,tc] || fo == "Y" then
 186           return $ Node.create name 0 0 0 0 0 0 True 0 gdx
 187       else do
 188         vtm <- tryRead name tm
 189         vnm <- tryRead name nm
 190         vfm <- tryRead name fm
 191         vtd <- tryRead name td
 192         vfd <- tryRead name fd
 193         vtc <- tryRead name tc
 194         vspindles <- tryRead name spindles
 195         return $ Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
 196   return (name, new_node)
 197
 198 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] =
 199   loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, "1"]
 200
 201 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
 202
 203 -- | Load an instance from a field list.
 204 loadInst :: NameAssoc -- ^ Association list with the current nodes
 205          -> [String]  -- ^ Input data as a list of fields
 206          -> Result (String, Instance.Instance) -- ^ A tuple of
 207                                                -- instance name and
 208                                                -- the instance object
 209 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
 210              , dt, tags, su ] = do
 211   pidx <- lookupNode ktn name pnode
 212   sidx <- if null snode
 213             then return Node.noSecondary
 214             else lookupNode ktn name snode
 215   vmem <- tryRead name mem
 216   vdsk <- tryRead name dsk
 217   vvcpus <- tryRead name vcpus
 218   vstatus <- instanceStatusFromRaw status
 219   auto_balance <- case auto_bal of
 220                     "Y" -> return True
 221                     "N" -> return False
 222                     _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
 223                          "' for instance " ++ name
 224   disk_template <- annotateResult ("Instance " ++ name)
 225                    (diskTemplateFromRaw dt)
 226   spindle_use <- tryRead name su
 227   when (sidx == pidx) . fail $ "Instance " ++ name ++
 228            " has same primary and secondary node - " ++ pnode
 229   let vtags = commaSplit tags
 230       newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
 231                 auto_balance pidx sidx disk_template spindle_use
 232   return (name, newinst)
 233
 234 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
 235              , dt, tags ] = loadInst ktn [ name, mem, dsk, vcpus, status,
 236                                            auto_bal, pnode, snode, dt, tags,
 237                                            "1" ]
 238 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
 239
 240 -- | Loads a spec from a field list.
 241 loadISpec :: String -> [String] -> Result ISpec
 242 loadISpec owner [mem_s, cpu_c, dsk_s, dsk_c, nic_c, su] = do
 243   xmem_s <- tryRead (owner ++ "/memsize") mem_s
 244   xcpu_c <- tryRead (owner ++ "/cpucount") cpu_c
 245   xdsk_s <- tryRead (owner ++ "/disksize") dsk_s
 246   xdsk_c <- tryRead (owner ++ "/diskcount") dsk_c
 247   xnic_c <- tryRead (owner ++ "/niccount") nic_c
 248   xsu    <- tryRead (owner ++ "/spindleuse") su
 249   return $ ISpec xmem_s xcpu_c xdsk_s xdsk_c xnic_c xsu
 250 loadISpec owner s = fail $ "Invalid ispec data for " ++ owner ++ ": " ++ show s
 251
 252 -- | Loads an ipolicy from a field list.
 253 loadIPolicy :: [String] -> Result (String, IPolicy)
 254 loadIPolicy [owner, stdspec, minspec, maxspec, dtemplates,
 255              vcpu_ratio, spindle_ratio] = do
 256   xstdspec <- loadISpec (owner ++ "/stdspec") (commaSplit stdspec)
 257   xminspec <- loadISpec (owner ++ "/minspec") (commaSplit minspec)
 258   xmaxspec <- loadISpec (owner ++ "/maxspec") (commaSplit maxspec)
 259   xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates
 260   xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio
 261   xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio
 262   return $ (owner, IPolicy xstdspec xminspec xmaxspec xdts
 263             xvcpu_ratio xspindle_ratio)
 264 loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'"
 265
 266 loadOnePolicy :: (IPolicy, Group.List) -> String
 267               -> Result (IPolicy, Group.List)
 268 loadOnePolicy (cpol, gl) line = do
 269   (owner, ipol) <- loadIPolicy (sepSplit '|' line)
 270   case owner of
 271     "" -> return (ipol, gl) -- this is a cluster policy (no owner)
 272     _ -> do
 273       grp <- Container.findByName gl owner
 274       let grp' = grp { Group.iPolicy = ipol }
 275           gl' = Container.add (Group.idx grp') grp' gl
 276       return (cpol, gl')
 277
 278 -- | Loads all policies from the policy section
 279 loadAllIPolicies :: Group.List -> [String] -> Result (IPolicy, Group.List)
 280 loadAllIPolicies gl =
 281   foldM loadOnePolicy (defIPolicy, gl)
 282
 283 -- | Convert newline and delimiter-separated text.
 284 --
 285 -- This function converts a text in tabular format as generated by
 286 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
 287 -- a supplied conversion function.
 288 loadTabular :: (Monad m, Element a) =>
 289                [String] -- ^ Input data, as a list of lines
 290             -> ([String] -> m (String, a)) -- ^ Conversion function
 291             -> m ( NameAssoc
 292                  , Container.Container a ) -- ^ A tuple of an
 293                                            -- association list (name
 294                                            -- to object) and a set as
 295                                            -- used in
 296                                            -- "Ganeti.HTools.Container"
 297
 298 loadTabular lines_data convert_fn = do
 299   let rows = map (sepSplit '|') lines_data
 300   kerows <- mapM convert_fn rows
 301   return $ assignIndices kerows
 302
 303 -- | Load the cluser data from disk.
 304 --
 305 -- This is an alias to 'readFile' just for consistency with the other
 306 -- modules.
 307 readData :: String    -- ^ Path to the text file
 308          -> IO String -- ^ Contents of the file
 309 readData = readFile
 310
 311 -- | Builds the cluster data from text input.
 312 parseData :: String -- ^ Text data
 313           -> Result ClusterData
 314 parseData fdata = do
 315   let flines = lines fdata
 316   (glines, nlines, ilines, ctags, pollines) <-
 317       case sepSplit "" flines of
 318         [a, b, c, d, e] -> Ok (a, b, c, d, e)
 319         [a, b, c, d] -> Ok (a, b, c, d, [])
 320         xs -> Bad $ printf "Invalid format of the input file: %d sections\
 321                            \ instead of 4 or 5" (length xs)
 322   {- group file: name uuid -}
 323   (ktg, gl) <- loadTabular glines loadGroup
 324   {- node file: name t_mem n_mem f_mem t_disk f_disk -}
 325   (ktn, nl) <- loadTabular nlines (loadNode ktg)
 326   {- instance file: name mem disk status pnode snode -}
 327   (_, il) <- loadTabular ilines (loadInst ktn)
 328   {- the tags are simply line-based, no processing needed -}
 329   {- process policies -}
 330   (cpol, gl') <- loadAllIPolicies gl pollines
 331   return (ClusterData gl' nl il ctags cpol)
 332
 333 -- | Top level function for data loading.
 334 loadData :: String -- ^ Path to the text file
 335          -> IO (Result ClusterData)
 336 loadData = fmap parseData . readData