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