code.grnet.gr Git - ganeti-local/blob - 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 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" (Group.name grp) (Group.uuid grp)
  58
  59 -- | Generate group file data from a group list
  60 serializeGroups :: Group.List -> String
  61 serializeGroups = unlines . map serializeGroup . Container.elems
  62
  63 -- | Serialize a single node
  64 serializeNode :: Group.List -> Node.Node -> String
  65 serializeNode gl node =
  66     printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (Node.name node)
  67                (Node.tMem node) (Node.nMem node) (Node.fMem node)
  68                (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
  69                (if Node.offline node then 'Y' else 'N')
  70                (Group.uuid grp)
  71     where grp = Container.find (Node.group node) gl
  72
  73 -- | Generate node file data from node objects
  74 serializeNodes :: Group.List -> Node.List -> String
  75 serializeNodes gl = unlines . map (serializeNode gl) . Container.elems
  76
  77 -- | Serialize a single instance
  78 serializeInstance :: Node.List -> Instance.Instance -> String
  79 serializeInstance nl inst =
  80     let
  81         iname = Instance.name inst
  82         pnode = Container.nameOf nl (Instance.pNode inst)
  83         sidx = Instance.sNode inst
  84         snode = (if sidx == Node.noSecondary
  85                     then ""
  86                     else Container.nameOf nl sidx)
  87     in
  88       printf "%s|%d|%d|%d|%s|%s|%s|%s"
  89              iname (Instance.mem inst) (Instance.dsk inst)
  90              (Instance.vcpus inst) (Instance.runSt inst)
  91              pnode snode (intercalate "," (Instance.tags inst))
  92
  93 -- | Generate instance file data from instance objects
  94 serializeInstances :: Node.List -> Instance.List -> String
  95 serializeInstances nl =
  96     unlines . map (serializeInstance nl) . Container.elems
  97
  98 -- | Generate complete cluster data from node and instance lists
  99 serializeCluster :: Group.List -> Node.List -> Instance.List -> String
 100 serializeCluster gl nl il =
 101   let gdata = serializeGroups gl
 102       ndata = serializeNodes gl nl
 103       idata = serializeInstances nl il
 104   in gdata ++ ['\n'] ++ ndata ++ ['\n'] ++ idata
 105
 106 -- | Load a group from a field list.
 107 loadGroup :: (Monad m) => [String] -> m (String, Group.Group)
 108 loadGroup [name, gid] =
 109   return $ (gid, Group.create name gid AllocPreferred)
 110
 111 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
 112
 113 -- | Load a node from a field list.
 114 loadNode :: (Monad m) => NameAssoc -> [String] -> m (String, Node.Node)
 115 loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
 116   gdx <- lookupGroup ktg name gu
 117   new_node <-
 118       if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
 119           return $ Node.create name 0 0 0 0 0 0 True gdx
 120       else do
 121         vtm <- tryRead name tm
 122         vnm <- tryRead name nm
 123         vfm <- tryRead name fm
 124         vtd <- tryRead name td
 125         vfd <- tryRead name fd
 126         vtc <- tryRead name tc
 127         return $ Node.create name vtm vnm vfm vtd vfd vtc False gdx
 128   return (name, new_node)
 129 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
 130
 131 -- | Load an instance from a field list.
 132 loadInst :: (Monad m) =>
 133             NameAssoc -> [String] -> m (String, Instance.Instance)
 134 loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode, tags] = do
 135   pidx <- lookupNode ktn name pnode
 136   sidx <- (if null snode then return Node.noSecondary
 137            else lookupNode ktn name snode)
 138   vmem <- tryRead name mem
 139   vdsk <- tryRead name dsk
 140   vvcpus <- tryRead name vcpus
 141   when (sidx == pidx) $ fail $ "Instance " ++ name ++
 142            " has same primary and secondary node - " ++ pnode
 143   let vtags = sepSplit ',' tags
 144       newinst = Instance.create name vmem vdsk vvcpus status vtags pidx sidx
 145   return (name, newinst)
 146 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
 147
 148 -- | Convert newline and delimiter-separated text.
 149 --
 150 -- This function converts a text in tabular format as generated by
 151 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
 152 -- a supplied conversion function.
 153 loadTabular :: (Monad m, Element a) =>
 154                [String] -> ([String] -> m (String, a))
 155             -> m (NameAssoc, Container.Container a)
 156 loadTabular lines_data convert_fn = do
 157   let rows = map (sepSplit '|') lines_data
 158   kerows <- mapM convert_fn rows
 159   return $ assignIndices kerows
 160
 161 -- | Load the cluser data from disk.
 162 readData :: String -- ^ Path to the text file
 163          -> IO String
 164 readData = readFile
 165
 166 -- | Builds the cluster data from text input.
 167 parseData :: String -- ^ Text data
 168           -> Result (Group.List, Node.List, Instance.List, [String])
 169 parseData fdata = do
 170   let flines = lines fdata
 171   (glines, nlines, ilines) <-
 172       case sepSplit "" flines of
 173         [a, b, c] -> Ok (a, b, c)
 174         xs -> Bad $ printf "Invalid format of the input file: %d sections\
 175                            \ instead of 3" (length xs)
 176   {- group file: name uuid -}
 177   (ktg, gl) <- loadTabular glines loadGroup
 178   {- node file: name t_mem n_mem f_mem t_disk f_disk -}
 179   (ktn, nl) <- loadTabular nlines (loadNode ktg)
 180   {- instance file: name mem disk status pnode snode -}
 181   (_, il) <- loadTabular ilines (loadInst ktn)
 182   return (gl, nl, il, [])
 183
 184 -- | Top level function for data loading
 185 loadData :: String -- ^ Path to the text file
 186          -> IO (Result (Group.List, Node.List, Instance.List, [String]))
 187 loadData afile = readData afile >>= return . parseData