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