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