module Ganeti.HTools.Text
(
loadData
, loadInst
, loadNode
, serializeInstances
, serializeNode
, serializeNodes
, serializeCluster
) where
import Control.Monad
import Data.List
import Text.Printf (printf)
import Ganeti.HTools.Utils
import Ganeti.HTools.Loader
import Ganeti.HTools.Types
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
serializeNode :: Node.Node -> String
serializeNode node =
printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node)
(Node.tMem node) (Node.nMem node) (Node.fMem node)
(Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
(if Node.offline node then 'Y' else 'N')
serializeNodes :: Node.List -> String
serializeNodes = unlines . map serializeNode . Container.elems
serializeInstance :: Node.List -> Instance.Instance -> String
serializeInstance nl inst =
let
iname = Instance.name inst
pnode = Container.nameOf nl (Instance.pNode inst)
sidx = Instance.sNode inst
snode = (if sidx == Node.noSecondary
then ""
else Container.nameOf nl sidx)
in
printf "%s|%d|%d|%d|%s|%s|%s|%s"
iname (Instance.mem inst) (Instance.dsk inst)
(Instance.vcpus inst) (Instance.runSt inst)
pnode snode (intercalate "," (Instance.tags inst))
serializeInstances :: Node.List -> Instance.List -> String
serializeInstances nl =
unlines . map (serializeInstance nl) . Container.elems
serializeCluster :: Node.List -> Instance.List -> String
serializeCluster nl il =
let ndata = serializeNodes nl
idata = serializeInstances nl il
in ndata ++ ['\n'] ++ idata
loadNode :: (Monad m) => [String] -> m (String, Node.Node)
loadNode [name, tm, nm, fm, td, fd, tc, fo] = do
new_node <-
if any (== "?") [tm,nm,fm,td,fd,tc] || fo == "Y" then
return $ Node.create name 0 0 0 0 0 0 True
else do
vtm <- tryRead name tm
vnm <- tryRead name nm
vfm <- tryRead name fm
vtd <- tryRead name td
vfd <- tryRead name fd
vtc <- tryRead name tc
return $ Node.create name vtm vnm vfm vtd vfd vtc False
return (name, new_node)
loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
loadInst :: (Monad m) =>
[(String, Ndx)] -> [String] -> m (String, Instance.Instance)
loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode, tags] = do
pidx <- lookupNode ktn name pnode
sidx <- (if null snode then return Node.noSecondary
else lookupNode ktn name snode)
vmem <- tryRead name mem
vdsk <- tryRead name dsk
vvcpus <- tryRead name vcpus
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
let vtags = sepSplit ',' tags
newinst = Instance.create name vmem vdsk vvcpus status vtags pidx sidx
return (name, newinst)
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
loadTabular :: (Monad m, Element a) =>
[String] -> ([String] -> m (String, a))
-> m ([(String, Int)], [(Int, a)])
loadTabular lines_data convert_fn = do
let rows = map (sepSplit '|') lines_data
kerows <- mapM convert_fn rows
return $ assignIndices kerows
loadData :: String
-> IO (Result (Node.AssocList, Instance.AssocList, [String]))
loadData afile = do
fdata <- readFile afile
let flines = lines fdata
(nlines, ilines) = break null flines
return $ do
ifixed <- case ilines of
[] -> Bad "Invalid format of the input file (no instance data)"
_:xs -> Ok xs
(ktn, nl) <- loadTabular nlines loadNode
(_, il) <- loadTabular ifixed (loadInst ktn)
return (nl, il, [])