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     , loadInst
  33     , loadNode
  34     , serializeInstances
  35     , serializeNodes
  36     ) where
  37
  38 import Control.Monad
  39 import Data.List
  40
  41 import Text.Printf (printf)
  42
  43 import Ganeti.HTools.Utils
  44 import Ganeti.HTools.Loader
  45 import Ganeti.HTools.Types
  46 import qualified Ganeti.HTools.Container as Container
  47 import qualified Ganeti.HTools.Node as Node
  48 import qualified Ganeti.HTools.Instance as Instance
  49
  50 -- | Serialize a single node
  51 serializeNode :: Node.Node -> String
  52 serializeNode node =
  53     printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node)
  54                (Node.tMem node) (Node.nMem node) (Node.fMem node)
  55                (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
  56                (if Node.offline node then 'Y' else 'N')
  57
  58 -- | Generate node file data from node objects
  59 serializeNodes :: Node.List -> String
  60 serializeNodes = unlines . map serializeNode . Container.elems
  61
  62 -- | Serialize a single instance
  63 serializeInstance :: Node.List -> Instance.Instance -> String
  64 serializeInstance nl inst =
  65     let
  66         iname = Instance.name inst
  67         pnode = Container.nameOf nl (Instance.pNode inst)
  68         sidx = Instance.sNode inst
  69         snode = (if sidx == Node.noSecondary
  70                     then ""
  71                     else Container.nameOf nl sidx)
  72     in
  73       printf "%s|%d|%d|%d|%s|%s|%s|%s"
  74              iname (Instance.mem inst) (Instance.dsk inst)
  75              (Instance.vcpus inst) (Instance.runSt inst)
  76              pnode snode (intercalate "," (Instance.tags inst))
  77
  78 -- | Generate instance file data from instance objects
  79 serializeInstances :: Node.List -> Instance.List -> String
  80 serializeInstances nl =
  81     unlines . map (serializeInstance nl) . Container.elems
  82
  83 -- | Load a node from a field list.
  84 loadNode :: (Monad m) => [String] -> m (String, Node.Node)
  85 loadNode [name, tm, nm, fm, td, fd, tc, fo] = do
  86   new_node <-
  87       if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
  88           return $ Node.create name 0 0 0 0 0 0 True
  89       else do
  90         vtm <- tryRead name tm
  91         vnm <- tryRead name nm
  92         vfm <- tryRead name fm
  93         vtd <- tryRead name td
  94         vfd <- tryRead name fd
  95         vtc <- tryRead name tc
  96         return $ Node.create name vtm vnm vfm vtd vfd vtc False
  97   return (name, new_node)
  98 loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
  99
 100 -- | Load an instance from a field list.
 101 loadInst :: (Monad m) =>
 102             [(String, Ndx)] -> [String] -> m (String, Instance.Instance)
 103 loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode, tags] = do
 104   pidx <- lookupNode ktn name pnode
 105   sidx <- (if null snode then return Node.noSecondary
 106            else lookupNode ktn name snode)
 107   vmem <- tryRead name mem
 108   vdsk <- tryRead name dsk
 109   vvcpus <- tryRead name vcpus
 110   when (sidx == pidx) $ fail $ "Instance " ++ name ++
 111            " has same primary and secondary node - " ++ pnode
 112   let vtags = sepSplit ',' tags
 113       newinst = Instance.create name vmem vdsk vvcpus status vtags pidx sidx
 114   return (name, newinst)
 115 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
 116
 117 -- | Convert newline and delimiter-separated text.
 118 --
 119 -- This function converts a text in tabular format as generated by
 120 -- @gnt-instance list@ and @gnt-node list@ to a list of objects using
 121 -- a supplied conversion function.
 122 loadTabular :: (Monad m, Element a) =>
 123                [String] -> ([String] -> m (String, a))
 124             -> m ([(String, Int)], [(Int, a)])
 125 loadTabular lines_data convert_fn = do
 126   let rows = map (sepSplit '|') lines_data
 127   kerows <- mapM convert_fn rows
 128   return $ assignIndices kerows
 129
 130 -- | Builds the cluster data from text input.
 131 loadData :: String -- ^ Path to the text file
 132          -> IO (Result (Node.AssocList, Instance.AssocList, [String]))
 133 loadData afile = do -- IO monad
 134   fdata <- readFile afile
 135   let flines = lines fdata
 136       (nlines, ilines) = break null flines
 137   return $ do
 138     ifixed <- case ilines of
 139                 [] -> Bad "Invalid format of the input file (no instance data)"
 140                 _:xs -> Ok xs
 141     {- node file: name t_mem n_mem f_mem t_disk f_disk -}
 142     (ktn, nl) <- loadTabular nlines loadNode
 143     {- instance file: name mem disk status pnode snode -}
 144     (_, il) <- loadTabular ifixed (loadInst ktn)
 145     return (nl, il, [])