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"
 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))
 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 = ispec
 122       strings = [show mem_s, show cpu_c, show disk_s, show disk_c, show nic_c]
 123   in intercalate "," strings
 124
 125 -- | Generate disk template data.
 126 serializeDiskTemplates :: [DiskTemplate] -> String
 127 serializeDiskTemplates = intercalate "," . map diskTemplateToRaw
 128
 129 -- | Generate policy data from a given policy object.
 130 serializeIPolicy :: String -> IPolicy -> String
 131 serializeIPolicy owner ipol =
 132   let IPolicy stdspec minspec maxspec dts vcpu_ratio spindle_ratio = ipol
 133       strings = [ owner
 134                 , serializeISpec stdspec
 135                 , serializeISpec minspec
 136                 , serializeISpec maxspec
 137                 , serializeDiskTemplates dts
 138                 , show vcpu_ratio
 139                 , show spindle_ratio
 140                 ]
 141   in intercalate "|" strings
 142
 143 -- | Generates the entire ipolicy section from the cluster and group
 144 -- objects.
 145 serializeAllIPolicies :: IPolicy -> Group.List -> String
 146 serializeAllIPolicies cpol gl =
 147   let groups = Container.elems gl
 148       allpolicies = [("", cpol)] ++
 149                     map (\g -> (Group.name g, Group.iPolicy g)) groups
 150       strings = map (uncurry serializeIPolicy) allpolicies
 151   in unlines strings
 152
 153 -- | Generate complete cluster data from node and instance lists.
 154 serializeCluster :: ClusterData -> String
 155 serializeCluster (ClusterData gl nl il ctags cpol) =
 156   let gdata = serializeGroups gl
 157       ndata = serializeNodes gl nl
 158       idata = serializeInstances nl il
 159       pdata = serializeAllIPolicies cpol gl
 160   -- note: not using 'unlines' as that adds too many newlines
 161   in intercalate "\n" [gdata, ndata, idata, unlines ctags, pdata]
 162
 163 -- * Parsing functions
 164
 165 -- | Load a group from a field list.
 166 loadGroup :: (Monad m) => [String]
 167           -> m (String, Group.Group) -- ^ The result, a tuple of group
 168                                      -- UUID and group object
 169 loadGroup [name, gid, apol] = do
 170   xapol <- allocPolicyFromRaw apol
 171   return (gid, Group.create name gid xapol defIPolicy)
 172
 173 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
 174
 175 -- | Load a node from a field list.
 176 loadNode :: (Monad m) =>
 177             NameAssoc             -- ^ Association list with current groups
 178          -> [String]              -- ^ Input data as a list of fields
 179          -> m (String, Node.Node) -- ^ The result, a tuple o node name
 180                                   -- and node object
 181 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, spindles] = do
 182   gdx <- lookupGroup ktg name gu
 183   new_node <-
 184       if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
 185           return $ Node.create name 0 0 0 0 0 0 True 0 gdx
 186       else do
 187         vtm <- tryRead name tm
 188         vnm <- tryRead name nm
 189         vfm <- tryRead name fm
 190         vtd <- tryRead name td
 191         vfd <- tryRead name fd
 192         vtc <- tryRead name tc
 193         vspindles <- tryRead name spindles
 194         return $ Node.create name vtm vnm vfm vtd vfd vtc False vspindles gdx
 195   return (name, new_node)
 196
 197 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] =
 198   loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu, "1"]
 199
 200 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
 201
 202 -- | Load an instance from a field list.
 203 loadInst :: NameAssoc -- ^ Association list with the current nodes
 204          -> [String]  -- ^ Input data as a list of fields
 205          -> Result (String, Instance.Instance) -- ^ A tuple of
 206                                                -- instance name and
 207                                                -- the instance object
 208 loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
 209              , dt, tags ] = do
 210   pidx <- lookupNode ktn name pnode
 211   sidx <- if null snode
 212             then return Node.noSecondary
 213             else lookupNode ktn name snode
 214   vmem <- tryRead name mem
 215   vdsk <- tryRead name dsk
 216   vvcpus <- tryRead name vcpus
 217   vstatus <- instanceStatusFromRaw status
 218   auto_balance <- case auto_bal of
 219                     "Y" -> return True
 220                     "N" -> return False
 221                     _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
 222                          "' for instance " ++ name
 223   disk_template <- annotateResult ("Instance " ++ name)
 224                    (diskTemplateFromRaw dt)
 225   when (sidx == pidx) $ fail $ "Instance " ++ name ++
 226            " has same primary and secondary node - " ++ pnode
 227   let vtags = commaSplit tags
 228       newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
 229                 auto_balance pidx sidx disk_template
 230   return (name, newinst)
 231 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
 232
 233 -- | Loads a spec from a field list.
 234 loadISpec :: String -> [String] -> Result ISpec
 235 loadISpec owner [mem_s, cpu_c, dsk_s, dsk_c, nic_c] = do
 236   xmem_s <- tryRead (owner ++ "/memsize") mem_s
 237   xcpu_c <- tryRead (owner ++ "/cpucount") cpu_c
 238   xdsk_s <- tryRead (owner ++ "/disksize") dsk_s
 239   xdsk_c <- tryRead (owner ++ "/diskcount") dsk_c
 240   xnic_c <- tryRead (owner ++ "/niccount") nic_c
 241   return $ ISpec xmem_s xcpu_c xdsk_s xdsk_c xnic_c
 242 loadISpec owner s = fail $ "Invalid ispec data for " ++ owner ++ ": " ++ show s
 243
 244 -- | Loads an ipolicy from a field list.
 245 loadIPolicy :: [String] -> Result (String, IPolicy)
 246 loadIPolicy [owner, stdspec, minspec, maxspec, dtemplates,
 247              vcpu_ratio, spindle_ratio] = do
 248   xstdspec <- loadISpec (owner ++ "/stdspec") (commaSplit stdspec)
 249   xminspec <- loadISpec (owner ++ "/minspec") (commaSplit minspec)
 250   xmaxspec <- loadISpec (owner ++ "/maxspec") (commaSplit maxspec)
 251   xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates
 252   xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio
 253   xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio
 254   return $ (owner, IPolicy xstdspec xminspec xmaxspec xdts
 255             xvcpu_ratio xspindle_ratio)
 256 loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'"
 257
 258 loadOnePolicy :: (IPolicy, Group.List) -> String
 259               -> Result (IPolicy, Group.List)
 260 loadOnePolicy (cpol, gl) line = do
 261   (owner, ipol) <- loadIPolicy (sepSplit '|' line)
 262   case owner of
 263     "" -> return (ipol, gl) -- this is a cluster policy (no owner)
 264     _ -> do
 265       grp <- Container.findByName gl owner
 266       let grp' = grp { Group.iPolicy = ipol }
 267           gl' = Container.add (Group.idx grp') grp' gl
 268       return (cpol, gl')
 269
 270 -- | Loads all policies from the policy section
 271 loadAllIPolicies :: Group.List -> [String] -> Result (IPolicy, Group.List)
 272 loadAllIPolicies gl =
 273   foldM loadOnePolicy (defIPolicy, gl)
 274
 275 -- | Convert newline and delimiter-separated text.
 276 --
 277 -- This function converts a text in tabular format as generated by
 278 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
 279 -- a supplied conversion function.
 280 loadTabular :: (Monad m, Element a) =>
 281                [String] -- ^ Input data, as a list of lines
 282             -> ([String] -> m (String, a)) -- ^ Conversion function
 283             -> m ( NameAssoc
 284                  , Container.Container a ) -- ^ A tuple of an
 285                                            -- association list (name
 286                                            -- to object) and a set as
 287                                            -- used in
 288                                            -- "Ganeti.HTools.Container"
 289
 290 loadTabular lines_data convert_fn = do
 291   let rows = map (sepSplit '|') lines_data
 292   kerows <- mapM convert_fn rows
 293   return $ assignIndices kerows
 294
 295 -- | Load the cluser data from disk.
 296 --
 297 -- This is an alias to 'readFile' just for consistency with the other
 298 -- modules.
 299 readData :: String    -- ^ Path to the text file
 300          -> IO String -- ^ Contents of the file
 301 readData = readFile
 302
 303 -- | Builds the cluster data from text input.
 304 parseData :: String -- ^ Text data
 305           -> Result ClusterData
 306 parseData fdata = do
 307   let flines = lines fdata
 308   (glines, nlines, ilines, ctags, pollines) <-
 309       case sepSplit "" flines of
 310         [a, b, c, d, e] -> Ok (a, b, c, d, e)
 311         [a, b, c, d] -> Ok (a, b, c, d, [])
 312         xs -> Bad $ printf "Invalid format of the input file: %d sections\
 313                            \ instead of 4 or 5" (length xs)
 314   {- group file: name uuid -}
 315   (ktg, gl) <- loadTabular glines loadGroup
 316   {- node file: name t_mem n_mem f_mem t_disk f_disk -}
 317   (ktn, nl) <- loadTabular nlines (loadNode ktg)
 318   {- instance file: name mem disk status pnode snode -}
 319   (_, il) <- loadTabular ilines (loadInst ktn)
 320   {- the tags are simply line-based, no processing needed -}
 321   {- process policies -}
 322   (cpol, gl') <- loadAllIPolicies gl pollines
 323   return (ClusterData gl' nl il ctags cpol)
 324
 325 -- | Top level function for data loading.
 326 loadData :: String -- ^ Path to the text file
 327          -> IO (Result ClusterData)
 328 loadData = fmap parseData . readData