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.
   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     (
  31       loadData
  32     , parseData
  33     , loadInst
  34     , loadNode
  35     , serializeInstances
  36     , serializeNode
  37     , serializeNodes
  38     , serializeCluster
  39     ) where
  40
  41 import Control.Monad
  42 import Data.List
  43
  44 import Text.Printf (printf)
  45
  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
  53
  54 -- | Serialize a single group
  55 serializeGroup :: Group.Group -> String
  56 serializeGroup grp =
  57     printf "%s|%s|%s" (Group.name grp) (Group.uuid grp)
  58                (apolToString (Group.allocPolicy grp))
  59
  60 -- | Generate group file data from a group list
  61 serializeGroups :: Group.List -> String
  62 serializeGroups = unlines . map serializeGroup . Container.elems
  63
  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')
  71                (Group.uuid grp)
  72     where grp = Container.find (Node.group node) gl
  73
  74 -- | Generate node file data from node objects
  75 serializeNodes :: Group.List -> Node.List -> String
  76 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
  77
  78 -- | Serialize a single instance
  79 serializeInstance :: Node.List -> Instance.Instance -> String
  80 serializeInstance nl inst =
  81     let
  82         iname = Instance.name inst
  83         pnode = Container.nameOf nl (Instance.pNode inst)
  84         sidx = Instance.sNode inst
  85         snode = (if sidx == Node.noSecondary
  86                     then ""
  87                     else Container.nameOf nl sidx)
  88     in
  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))
  94
  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
  99
 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]
 108
 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)
 114
 115 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
 116
 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
 121   new_node <-
 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
 124       else do
 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 ++ "'"
 134
 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
 146                     "Y" -> return True
 147                     "N" -> return False
 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 ++ "'"
 157
 158 -- | Convert newline and delimiter-separated text.
 159 --
 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
 170
 171 -- | Load the cluser data from disk.
 172 readData :: String -- ^ Path to the text file
 173          -> IO String
 174 readData = readFile
 175
 176 -- | Builds the cluster data from text input.
 177 parseData :: String -- ^ Text data
 178           -> Result ClusterData
 179 parseData fdata = do
 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)
 194
 195 -- | Top level function for data loading
 196 loadData :: String -- ^ Path to the text file
 197          -> IO (Result ClusterData)
 198 loadData = fmap parseData . readData