diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index a85b9ad9b81a466a664d8c6416e04b2f82b691ab..cba2ad0f36229c7505e15ce4671c67766f94d3a1 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -85,10 +85,6 @@ data IMove = Failover -- ^ Failover the instance (f)
data Table = Table NodeList InstanceList Score [Placement]
deriving (Show)
--- | Constant node index for a non-moveable instance
-noSecondary :: Int
-noSecondary = -1
-
-- General functions
-- | Cap the removal list if needed.
@@ -480,7 +476,7 @@ checkMove nodes_idx ini_tbl victims =
best_tbl =
foldl'
(\ step_tbl elem ->
- if Instance.snode elem == noSecondary then step_tbl
+ if Instance.snode elem == Node.noSecondary then step_tbl
else compareTables step_tbl $
checkInstanceMove nodes_idx ini_tbl elem)
ini_tbl victims
@@ -694,23 +690,6 @@ printStats nl =
-- Loading functions
-{- | Convert newline and delimiter-separated text.
-
-This function converts a text in tabular format as generated by
-@gnt-instance list@ and @gnt-node list@ to a list of objects using a
-supplied conversion function.
-
--}
-loadTabular :: (Monad m) => String -> ([String] -> m (String, a))
- -> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)])
-loadTabular text_data convert_fn set_fn = do
- let lines_data = lines text_data
- rows = map (sepSplit '|') lines_data
- kerows <- mapM convert_fn rows
- let idxrows = map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
- (zip [0..] kerows)
- return $ unzip idxrows
-
-- | For each instance, add its index to its primary and secondary nodes
fixNodes :: [(Int, Node.Node)]
-> [(Int, Instance.Instance)]
@@ -726,7 +705,7 @@ fixNodes nl il =
ac1 = deleteBy assocEqual (pdx, pold) accu
ac2 = (pdx, pnew):ac1
in
- if sdx /= noSecondary then
+ if sdx /= Node.noSecondary then
let
sold = fromJust $ lookup sdx accu
snew = Node.setSec sold idx
@@ -756,66 +735,15 @@ stripSuffix suffix lst =
let sflen = length suffix in
map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
--- | Safe 'read' function returning data encapsulated in a Result
-tryRead :: (Monad m, Read a) => String -> String -> m a
-tryRead name s =
- let sols = readsPrec 0 s
- in case sols of
- (v, ""):[] -> return v
- (_, e):[] -> fail $ name ++ ": leftover characters when parsing '"
- ++ s ++ "': '" ++ e ++ "'"
- _ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'"
-
--- | Lookups a node into an assoc list
-lookupNode :: (Monad m) => String -> String -> [(String, Int)] -> m Int
-lookupNode node inst ktn =
- case lookup node ktn of
- Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
- Just idx -> return idx
-
--- | Load a node from a field list
-loadNode :: (Monad m) => [String] -> m (String, Node.Node)
-loadNode (name:tm:nm:fm:td:fd:fo:[]) = do
- new_node <-
- if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
- return $ Node.create 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
- return $ Node.create vtm vnm vfm vtd vfd False
- return (name, new_node)
-loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
-
--- | Load an instance from a field list
-loadInst :: (Monad m) =>
- [(String, Int)] -> [String] -> m (String, Instance.Instance)
-loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do
- pidx <- lookupNode pnode name ktn
- sidx <- (if null snode then return noSecondary
- else lookupNode snode name ktn)
- vmem <- tryRead name mem
- vdsk <- tryRead name dsk
- when (sidx == pidx) $ fail $ "Instance " ++ name ++
- " has same primary and secondary node - " ++ pnode
- let newinst = Instance.create vmem vdsk status pidx sidx
- return (name, newinst)
-loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
{-| Initializer function that loads the data from a node and list file
and massages it into the correct format. -}
-loadData :: String -- ^ Node data in text format
- -> String -- ^ Instance data in text format
- -> Result (Container.Container Node.Node,
- Container.Container Instance.Instance,
- String, NameList, NameList)
-loadData ndata idata = do
- {- node file: name t_mem n_mem f_mem t_disk f_disk -}
- (ktn, nl) <- loadTabular ndata loadNode Node.setIdx
- {- instance file: name mem disk status pnode snode -}
- (kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx
+loadData :: ([(String, Int)], Node.AssocList,
+ [(String, Int)], Instance.AssocList) -- ^ Data from either
+ -- Text.loadData
+ -- or Rapi.loadData
+ -> Result (NodeList, InstanceList, String, NameList, NameList)
+loadData (ktn, nl, kti, il) = do
let
nl2 = fixNodes nl il
il3 = Container.fromAssocList il
diff --git a/Ganeti/HTools/Instance.hs b/Ganeti/HTools/Instance.hs
index d115742e0ffce6d4c2bb57119672af2270414dac..96a7afe52ce8ad5a301904ba1e966592437520a4 100644
--- a/Ganeti/HTools/Instance.hs
+++ b/Ganeti/HTools/Instance.hs
@@ -17,6 +17,9 @@ data Instance = Instance { mem :: Int -- ^ memory of the instance
-- book-keeping
} deriving (Show)
+-- | A simple name for the int, instance association list
+type AssocList = [(Int, Instance)]
+
create :: Int -> Int -> String -> Int -> Int -> Instance
create mem_init dsk_init run_init pn sn =
Instance {
diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs
new file mode 100644
index 0000000000000000000000000000000000000000..0363db5bdac1b6ff1a91f1f74dd6c72c612b579f
--- /dev/null
+++ b/Ganeti/HTools/Loader.hs
@@ -0,0 +1,24 @@
+{-| Loading data from external sources
+
+This module holds the common code for loading the cluster state from external sources.
+
+-}
+
+module Ganeti.HTools.Loader
+ where
+
+type NameAssoc = [(String, Int)]
+
+-- | Lookups a node into an assoc list
+lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Int
+lookupNode ktn inst node =
+ case lookup node ktn of
+ Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
+ Just idx -> return idx
+
+assignIndices :: (a -> Int -> a)
+ -> [(String, a)]
+ -> (NameAssoc, [(Int, a)])
+assignIndices set_fn =
+ unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
+ . zip [0..]
diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
index 8dffd585fadbd90be63a3c614254f72be6891549..37d3d9249912dbff63c647ed8365d278887ca463 100644
--- a/Ganeti/HTools/Node.hs
+++ b/Ganeti/HTools/Node.hs
@@ -26,6 +26,9 @@ module Ganeti.HTools.Node
, setSec
-- * Formatting
, list
+ -- * Misc stuff
+ , AssocList
+ , noSecondary
) where
import Data.List
@@ -58,6 +61,13 @@ data Node = Node { t_mem :: Double -- ^ total memory (MiB)
-- score computations
} deriving (Show)
+-- | A simple name for the int, node association list
+type AssocList = [(Int, Node)]
+
+-- | Constant node index for a non-moveable instance
+noSecondary :: Int
+noSecondary = -1
+
{- | Create a new node.
The index and the peers maps are empty, and will be need to be update
diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index 786bfe151a7783a80ef1233ac6800f6865f70a8a..5cfc42b4d368fc99d9e7db660c4d75617a539e49 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -4,20 +4,21 @@
module Ganeti.HTools.Rapi
(
- getNodes
- , getInstances
+ loadData
) where
import Network.Curl
import Network.Curl.Types ()
import Network.Curl.Code
-import Data.Either ()
-import Data.Maybe
import Data.List
import Control.Monad
import Text.JSON (JSObject, JSValue)
import Text.Printf (printf)
+
import Ganeti.HTools.Utils
+import Ganeti.HTools.Loader
+import qualified Ganeti.HTools.Node as Node
+import qualified Ganeti.HTools.Instance as Instance
-- | Read an URL via curl and return the body if successful
getUrl :: (Monad m) => String -> IO (m String)
@@ -35,57 +36,62 @@ formatHost master =
if elem ':' master then master
else "https://" ++ master ++ ":5080"
-getInstances :: String -> IO (Result String)
-getInstances master = do
- let url2 = printf "%s/2/instances?bulk=1" (formatHost master)
- body <- getUrl url2
- return $ (do x <- body
- arr <- loadJSArray x
- ilist <- mapM parseInstance arr
- return $ unlines ilist)
+getInstances :: NameAssoc
+ -> String
+ -> Result [(String, Instance.Instance)]
+getInstances ktn body = do
+ arr <- loadJSArray body
+ ilist <- mapM (parseInstance ktn) arr
+ return ilist
-getNodes :: String -> IO (Result String)
-getNodes master = do
- let url2 = printf "%s/2/nodes?bulk=1" (formatHost master)
- body <- getUrl url2
- return $ (do x <- body
- arr <- loadJSArray x
- nlist <- mapM parseNode arr
- return $ unlines nlist)
+getNodes :: String -> Result [(String, Node.Node)]
+getNodes body = do
+ arr <- loadJSArray body
+ nlist <- mapM parseNode arr
+ return nlist
-parseInstance :: JSObject JSValue -> Result String
-parseInstance a =
- let name = getStringElement "name" a
- disk = getIntElement "disk_usage" a
- mem = getObjectElement "beparams" a >>= getIntElement "memory"
- pnode = getStringElement "pnode" a
- snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
- running = getStringElement "status" a
- in
- name |+ (show `liftM` mem) |+
- (show `liftM` disk) |+
- running |+ pnode |+ snode
+parseInstance :: [(String, Int)]
+ -> JSObject JSValue
+ -> Result (String, Instance.Instance)
+parseInstance ktn a = do
+ name <- fromObj "name" a
+ disk <- fromObj "disk_usage" a
+ mem <- fromObj "beparams" a >>= fromObj "memory"
+ pnode <- fromObj "pnode" a >>= lookupNode ktn name
+ snodes <- getListElement "snodes" a
+ snode <- (if null snodes then return Node.noSecondary
+ else readEitherString (head snodes) >>= lookupNode ktn name)
+ running <- fromObj "status" a
+ let inst = Instance.create mem disk running pnode snode
+ return (name, inst)
-boolToYN :: (Monad m) => Bool -> m String
-boolToYN True = return "Y"
-boolToYN _ = return "N"
+parseNode :: JSObject JSValue -> Result (String, Node.Node)
+parseNode a = do
+ name <- fromObj "name" a
+ offline <- fromObj "offline" a
+ node <- (case offline of
+ True -> return $ Node.create 0 0 0 0 0 True
+ _ -> do
+ drained <- fromObj "drained" a
+ mtotal <- fromObj "mtotal" a
+ mnode <- fromObj "mnode" a
+ mfree <- fromObj "mfree" a
+ dtotal <- fromObj "dtotal" a
+ dfree <- fromObj "dfree" a
+ return $ Node.create mtotal mnode mfree
+ dtotal dfree (offline || drained))
+ return (name, node)
-parseNode :: JSObject JSValue -> Result String
-parseNode a =
- let name = getStringElement "name" a
- offline = getBoolElement "offline" a
- drained = getBoolElement "drained" a
- mtotal = getIntElement "mtotal" a
- mnode = getIntElement "mnode" a
- mfree = getIntElement "mfree" a
- dtotal = getIntElement "dtotal" a
- dfree = getIntElement "dfree" a
- in name |+
- (case offline of
- Ok True -> Ok "0|0|0|0|0|Y"
- _ ->
- (show `liftM` mtotal) |+ (show `liftM` mnode) |+
- (show `liftM` mfree) |+ (show `liftM` dtotal) |+
- (show `liftM` dfree) |+
- ((liftM2 (||) offline drained) >>= boolToYN)
- )
+loadData :: String -- ^ Cluster/URL to use as source
+ -> IO (Result (NameAssoc, Node.AssocList,
+ NameAssoc, Instance.AssocList))
+loadData master = do -- IO monad
+ let url = formatHost master
+ node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
+ inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
+ return $ do -- Result monad
+ node_data <- node_body >>= getNodes
+ let (node_names, node_idx) = assignIndices Node.setIdx node_data
+ inst_data <- inst_body >>= getInstances node_names
+ let (inst_names, inst_idx) = assignIndices Instance.setIdx inst_data
+ return (node_names, node_idx, inst_names, inst_idx)
diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs
new file mode 100644
index 0000000000000000000000000000000000000000..f643e5f5b7f0a9b94874b7cecd8263194962609c
--- /dev/null
+++ b/Ganeti/HTools/Text.hs
@@ -0,0 +1,86 @@
+{-| Parsing data from text-files
+
+This module holds the code for loading the cluster state from text
+files, as produced by gnt-node/gnt-instance list.
+
+-}
+
+module Ganeti.HTools.Text
+ where
+
+import Control.Monad
+
+import Ganeti.HTools.Utils
+import Ganeti.HTools.Loader
+import qualified Ganeti.HTools.Node as Node
+import qualified Ganeti.HTools.Instance as Instance
+
+-- | Safe 'read' function returning data encapsulated in a Result
+tryRead :: (Monad m, Read a) => String -> String -> m a
+tryRead name s =
+ let sols = readsPrec 0 s
+ in case sols of
+ (v, ""):[] -> return v
+ (_, e):[] -> fail $ name ++ ": leftover characters when parsing '"
+ ++ s ++ "': '" ++ e ++ "'"
+ _ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'"
+
+-- | Load a node from a field list
+loadNode :: (Monad m) => [String] -> m (String, Node.Node)
+loadNode (name:tm:nm:fm:td:fd:fo:[]) = do
+ new_node <-
+ if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
+ return $ Node.create 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
+ return $ Node.create vtm vnm vfm vtd vfd False
+ return (name, new_node)
+loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
+
+-- | Load an instance from a field list
+loadInst :: (Monad m) =>
+ [(String, Int)] -> [String] -> m (String, Instance.Instance)
+loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = 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
+ when (sidx == pidx) $ fail $ "Instance " ++ name ++
+ " has same primary and secondary node - " ++ pnode
+ let newinst = Instance.create vmem vdsk status pidx sidx
+ return (name, newinst)
+loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
+
+{- | Convert newline and delimiter-separated text.
+
+This function converts a text in tabular format as generated by
+@gnt-instance list@ and @gnt-node list@ to a list of objects using a
+supplied conversion function.
+
+-}
+loadTabular :: (Monad m) => String -> ([String] -> m (String, a))
+ -> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)])
+loadTabular text_data convert_fn set_fn = do
+ let lines_data = lines text_data
+ rows = map (sepSplit '|') lines_data
+ kerows <- mapM convert_fn rows
+ return $ assignIndices set_fn kerows
+
+loadData :: String -- ^ Node data in string format
+ -> String -- ^ Instance data in string format
+ -> IO (Result (NameAssoc, Node.AssocList,
+ NameAssoc, 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 Node.setIdx
+ {- instance file: name mem disk status pnode snode -}
+ (kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx
+ return (ktn, nl, kti, il)
diff --git a/hbal.hs b/hbal.hs
index a69622a1255e347715058a7c670180aebe0df21c..459574ea8ceff55efcac1e3bbd9594c542b7bd68 100644
--- a/hbal.hs
+++ b/hbal.hs
@@ -19,7 +19,9 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.CLI as CLI
-import Ganeti.HTools.Rapi
+import qualified Ganeti.HTools.Rapi as Rapi
+import qualified Ganeti.HTools.Text as Text
+
import Ganeti.HTools.Utils
-- | Command line options structure.
@@ -179,14 +181,13 @@ main = do
else env_inst
oneline = optOneline opts
verbose = optVerbose opts
- (node_data, inst_data) =
- case optMaster opts of
- "" -> (readFile nodef,
- readFile instf)
- host -> (getNodes host >>= readData,
- getInstances host >>= readData)
-
- ldresult <- liftM2 Cluster.loadData node_data inst_data
+ input_data <-
+ case optMaster opts of
+ "" -> Text.loadData nodef instf
+ host -> Rapi.loadData host
+
+ let ldresult = input_data >> Cluster.loadData
+
(loaded_nl, il, csf, ktn, kti) <-
(case ldresult of
Ok x -> return x
diff --git a/hn1.hs b/hn1.hs
index adef634d566ced4d8e7e1eb4e36f80753935d5c1..2cb10c60be49315bbb1e65c71fae36202eaebcc6 100644
--- a/hn1.hs
+++ b/hn1.hs
@@ -18,7 +18,8 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.CLI as CLI
-import Ganeti.HTools.Rapi
+import qualified Ganeti.HTools.Rapi as Rapi
+import qualified Ganeti.HTools.Text as Text
import Ganeti.HTools.Utils
-- | Command line options structure.
@@ -144,14 +145,13 @@ main = do
instf = if optInstSet opts then optInstf opts
else env_inst
min_depth = optMinDepth opts
- (node_data, inst_data) =
- case optMaster opts of
- "" -> (readFile nodef,
- readFile instf)
- host -> (getNodes host >>= readData,
- getInstances host >>= readData)
-
- ldresult <- liftM2 Cluster.loadData node_data inst_data
+
+ input_data <-
+ case optMaster opts of
+ "" -> Text.loadData nodef instf
+ host -> Rapi.loadData host
+ let ldresult = input_data >>= Cluster.loadData
+
(loaded_nl, il, csf, ktn, kti) <-
(case ldresult of
Ok x -> return x
diff --git a/hscan.hs b/hscan.hs
index 21c249ea08f5601f84935b7c7ab0aa53606df208..45c1b10a360c66543512f284d1a2176e61faad8c 100644
--- a/hscan.hs
+++ b/hscan.hs
@@ -21,7 +21,7 @@ import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.CLI as CLI
-import Ganeti.HTools.Rapi
+import qualified Ganeti.HTools.Rapi as Rapi
import Ganeti.HTools.Utils
-- | Command line options structure.
@@ -158,10 +158,8 @@ main = do
do
printf "%-*s " nlen name
hFlush stdout
- node_data <- getNodes name
- inst_data <- getInstances name
- let ldresult = join $
- liftM2 Cluster.loadData node_data inst_data
+ input_data <- Rapi.loadData name
+ let ldresult = input_data >>= Cluster.loadData
(case ldresult of
Bad err -> printf "\nError: failed to load data. \
\Details:\n%s\n" err