{-
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-}
module Ganeti.HTools.Text
- where
+ (
+ loadData
+ , parseData
+ , 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.Group as Group
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
--- | Parse results from readsPrec
-parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a
-parseChoices _ _ ((v, ""):[]) = return v
-parseChoices name s ((_, e):[]) =
- fail $ name ++ ": leftover characters when parsing '"
- ++ s ++ "': '" ++ e ++ "'"
-parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'"
-
--- | Safe 'read' function returning data encapsulated in a Result.
-tryRead :: (Monad m, Read a) => String -> String -> m a
-tryRead name s = parseChoices name s $ readsPrec 0 s
+-- | Serialize a single node
+serializeNode :: Node.Node -> String
+serializeNode node =
+ printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c|%s" (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')
+ (Node.group node)
+
+-- | Generate node file data from node objects
+serializeNodes :: Node.List -> String
+serializeNodes = unlines . map serializeNode . Container.elems
+
+-- | Serialize a single instance
+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))
+
+-- | Generate instance file data from instance objects
+serializeInstances :: Node.List -> Instance.List -> String
+serializeInstances nl =
+ unlines . map (serializeInstance nl) . Container.elems
+
+-- | Generate complete cluster data from node and instance lists
+serializeCluster :: Node.List -> Instance.List -> String
+serializeCluster nl il =
+ let ndata = serializeNodes nl
+ idata = serializeInstances nl il
+ in ndata ++ ['\n'] ++ idata
+
+-- | Load a group from a field list.
+loadGroup :: (Monad m) => [String] -> m (String, Group.Group)
+loadGroup [name, gid] =
+ return $ (gid, Group.create name gid AllocPreferred)
+
+loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
-- | Load a node from a field list.
loadNode :: (Monad m) => [String] -> m (String, Node.Node)
-loadNode (name:tm:nm:fm:td:fd:tc:fo:[]) = do
+-- compatibility wrapper for old text files
+loadNode [name, tm, nm, fm, td, fd, tc, fo] =
+ loadNode [name, tm, nm, fm, td, fd, tc, fo, defaultGroupID]
+loadNode [name, tm, nm, fm, td, fd, tc, fo, gu] = 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
+ return $ Node.create name 0 0 0 0 0 0 True gu
else do
vtm <- tryRead name tm
vnm <- tryRead name nm
vtd <- tryRead name td
vfd <- tryRead name fd
vtc <- tryRead name tc
- return $ Node.create name vtm vnm vfm vtd vfd vtc False
+ return $ Node.create name vtm vnm vfm vtd vfd vtc False gu
return (name, new_node)
-loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
+loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
-- | Load an instance from a field list.
loadInst :: (Monad m) =>
- [(String, Ndx)] -> [String] -> m (String, Instance.Instance)
-loadInst ktn (name:mem:dsk:vcpus:status:pnode:snode:[]) = do
+ NameAssoc -> [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)
vvcpus <- tryRead name vcpus
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
- let newinst = Instance.create name vmem vdsk vvcpus status pidx sidx
+ 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) ++ "'"
+loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
-- | Convert newline and delimiter-separated text.
--
-- @gnt-instance list@ and @gnt-node list@ to a list of objects using
-- a supplied conversion function.
loadTabular :: (Monad m, Element a) =>
- String -> ([String] -> m (String, a))
- -> m ([(String, Int)], [(Int, a)])
-loadTabular text_data convert_fn = do
- let lines_data = lines text_data
- rows = map (sepSplit '|') lines_data
+ [String] -> ([String] -> m (String, a))
+ -> m (NameAssoc, Container.Container a)
+loadTabular lines_data convert_fn = do
+ let rows = map (sepSplit '|') lines_data
kerows <- mapM convert_fn rows
return $ assignIndices kerows
--- | Builds the cluster data from node\/instance files.
-loadData :: String -- ^ Node data in string format
- -> String -- ^ Instance data in string format
- -> IO (Result (Node.AssocList, Instance.AssocList))
-loadData nfile ifile = do -- IO monad
- ndata <- readFile nfile
- idata <- readFile ifile
- return $ do
- {- node file: name t_mem n_mem f_mem t_disk f_disk -}
- (ktn, nl) <- loadTabular ndata loadNode
- {- instance file: name mem disk status pnode snode -}
- (_, il) <- loadTabular idata (loadInst ktn)
- return (nl, il)
+-- | Load the cluser data from disk.
+readData :: String -- ^ Path to the text file
+ -> IO String
+readData = readFile
+
+-- | Builds the cluster data from text input.
+parseData :: String -- ^ Text data
+ -> Result (Group.List, Node.List, Instance.List, [String])
+parseData fdata = do
+ let flines = lines fdata
+ (glines, nilines) = break null flines
+ (nlines, ilines) = break null (tail nilines)
+ nfixed <- case nlines of
+ [] -> Bad "Invalid format of the input file (no node data)"
+ xs -> Ok xs
+ ifixed <- case ilines of
+ [] -> Bad "Invalid format of the input file (no instance data)"
+ _:xs -> Ok xs
+ {- group file: name uuid -}
+ (_, gl) <- loadTabular glines loadGroup
+ {- node file: name t_mem n_mem f_mem t_disk f_disk -}
+ (ktn, nl) <- loadTabular nfixed loadNode
+ {- instance file: name mem disk status pnode snode -}
+ (_, il) <- loadTabular ifixed (loadInst ktn)
+ return (gl, nl, il, [])
+
+-- | Top level function for data loading
+loadData :: String -- ^ Path to the text file
+ -> IO (Result (Group.List, Node.List, Instance.List, [String]))
+loadData afile = readData afile >>= return . parseData
projects / ganeti-local / blobdiff