Commit 3e4480e0 authored by Iustin Pop's avatar Iustin Pop
Browse files

Stop modifying names for internal computations

Currently the name used internally is modified and holds the shortened
name of the nodes/instances. This has caused issues before, since we
always have to strip the suffix from input data and reapply it if we
need to send data back to Ganeti.

This patch changes the code such that the names are never modified, only
the alias, and all the internal computations can forget about the common
suffix addition/removal.
parent 8bcdde0c
...@@ -770,12 +770,12 @@ printStats nl = ...@@ -770,12 +770,12 @@ printStats nl =
in intercalate ", " formatted in intercalate ", " formatted
-- | Convert a placement into a list of OpCodes (basically a job). -- | Convert a placement into a list of OpCodes (basically a job).
iMoveToJob :: String -> Node.List -> Instance.List iMoveToJob :: Node.List -> Instance.List
-> Idx -> IMove -> [OpCodes.OpCode] -> Idx -> IMove -> [OpCodes.OpCode]
iMoveToJob csf nl il idx move = iMoveToJob nl il idx move =
let inst = Container.find idx il let inst = Container.find idx il
iname = Instance.name inst ++ csf iname = Instance.name inst
lookNode n = Just (Container.nameOf nl n ++ csf) lookNode = Just . Container.nameOf nl
opF = if Instance.running inst opF = if Instance.running inst
then OpCodes.OpMigrateInstance iname True False then OpCodes.OpMigrateInstance iname True False
else OpCodes.OpFailoverInstance iname False else OpCodes.OpFailoverInstance iname False
......
...@@ -31,6 +31,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ...@@ -31,6 +31,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.HTools.ExtLoader module Ganeti.HTools.ExtLoader
( loadExternalData ( loadExternalData
, Loader.commonSuffix
) where ) where
import Data.Maybe (isJust, fromJust) import Data.Maybe (isJust, fromJust)
...@@ -73,7 +74,7 @@ parseUtilisation line = ...@@ -73,7 +74,7 @@ parseUtilisation line =
-- | External tool data loader from a variety of sources. -- | External tool data loader from a variety of sources.
loadExternalData :: Options loadExternalData :: Options
-> IO (Node.List, Instance.List, [String], String) -> IO (Node.List, Instance.List, [String])
loadExternalData opts = do loadExternalData opts = do
let mhost = optMaster opts let mhost = optMaster opts
lsock = optLuxi opts lsock = optLuxi opts
...@@ -119,7 +120,7 @@ loadExternalData opts = do ...@@ -119,7 +120,7 @@ loadExternalData opts = do
| otherwise -> return $ Bad "No backend selected! Exiting." | otherwise -> return $ Bad "No backend selected! Exiting."
let ldresult = input_data >>= Loader.mergeData util_data' exTags exInsts let ldresult = input_data >>= Loader.mergeData util_data' exTags exInsts
(loaded_nl, il, tags, csf) <- (loaded_nl, il, tags) <-
(case ldresult of (case ldresult of
Ok x -> return x Ok x -> return x
Bad s -> do Bad s -> do
...@@ -133,4 +134,4 @@ loadExternalData opts = do ...@@ -133,4 +134,4 @@ loadExternalData opts = do
hPutStrLn stderr "Warning: cluster has inconsistent data:" hPutStrLn stderr "Warning: cluster has inconsistent data:"
hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
return (fixed_nl, il, tags, csf) return (fixed_nl, il, tags)
...@@ -113,7 +113,7 @@ parseData body = do ...@@ -113,7 +113,7 @@ parseData body = do
let (kti, il) = assignIndices iobj let (kti, il) = assignIndices iobj
-- cluster tags -- cluster tags
ctags <- fromObj "cluster_tags" obj ctags <- fromObj "cluster_tags" obj
(map_n, map_i, ptags, csf) <- mergeData [] [] [] (nl, il, ctags) (map_n, map_i, ptags) <- mergeData [] [] [] (nl, il, ctags)
optype <- fromObj "type" request optype <- fromObj "type" request
rqtype <- rqtype <-
case optype of case optype of
...@@ -130,45 +130,41 @@ parseData body = do ...@@ -130,45 +130,41 @@ parseData body = do
ridx <- lookupInstance kti rname ridx <- lookupInstance kti rname
req_nodes <- fromObj "required_nodes" request req_nodes <- fromObj "required_nodes" request
ex_nodes <- fromObj "relocate_from" request ex_nodes <- fromObj "relocate_from" request
let ex_nodes' = map (stripSuffix $ length csf) ex_nodes ex_idex <- mapM (Container.findByName map_n) ex_nodes
ex_idex <- mapM (Container.findByName map_n) ex_nodes'
return $ Relocate ridx req_nodes (map Node.idx ex_idex) return $ Relocate ridx req_nodes (map Node.idx ex_idex)
"multi-evacuate" -> "multi-evacuate" ->
do do
ex_names <- fromObj "evac_nodes" request ex_names <- fromObj "evac_nodes" request
let ex_names' = map (stripSuffix $ length csf) ex_names ex_nodes <- mapM (Container.findByName map_n) ex_names
ex_nodes <- mapM (Container.findByName map_n) ex_names'
let ex_ndx = map Node.idx ex_nodes let ex_ndx = map Node.idx ex_nodes
return $ Evacuate ex_ndx return $ Evacuate ex_ndx
other -> fail ("Invalid request type '" ++ other ++ "'") other -> fail ("Invalid request type '" ++ other ++ "'")
return $ Request rqtype map_n map_i ptags csf return $ Request rqtype map_n map_i ptags
-- | Format the result -- | Format the result
formatRVal :: String -> RqType -> [Node.AllocElement] -> JSValue formatRVal :: RqType -> [Node.AllocElement] -> JSValue
formatRVal _ _ [] = JSArray [] formatRVal _ [] = JSArray []
formatRVal csf (Evacuate _) elems = formatRVal (Evacuate _) elems =
let sols = map (\(_, inst, nl) -> let sols = map (\(_, inst, nl) -> Instance.name inst : map Node.name nl)
let names = Instance.name inst : map Node.name nl elems
in map (++ csf) names) elems
jsols = map (JSArray . map (JSString . toJSString)) sols jsols = map (JSArray . map (JSString . toJSString)) sols
in JSArray jsols in JSArray jsols
formatRVal csf _ elems = formatRVal _ elems =
let (_, _, nodes) = head elems let (_, _, nodes) = head elems
nodes' = map ((++ csf) . Node.name) nodes nodes' = map Node.name nodes
in JSArray $ map (JSString . toJSString) nodes' in JSArray $ map (JSString . toJSString) nodes'
-- | Formats the response into a valid IAllocator response message. -- | Formats the response into a valid IAllocator response message.
formatResponse :: Bool -- ^ Whether the request was successful formatResponse :: Bool -- ^ Whether the request was successful
-> String -- ^ Information text -> String -- ^ Information text
-> String -- ^ Suffix for nodes and instances
-> RqType -- ^ Request type -> RqType -- ^ Request type
-> [Node.AllocElement] -- ^ The resulting allocations -> [Node.AllocElement] -- ^ The resulting allocations
-> String -- ^ The JSON-formatted message -> String -- ^ The JSON-formatted message
formatResponse success info csf rq elems = formatResponse success info rq elems =
let let
e_success = ("success", JSBool success) e_success = ("success", JSBool success)
e_info = ("info", JSString . toJSString $ info) e_info = ("info", JSString . toJSString $ info)
e_nodes = ("nodes", formatRVal csf rq elems) e_nodes = ("nodes", formatRVal rq elems)
in encodeStrict $ makeObj [e_success, e_info, e_nodes] in encodeStrict $ makeObj [e_success, e_info, e_nodes]
...@@ -65,10 +65,10 @@ data Instance = Instance { name :: String -- ^ The instance name ...@@ -65,10 +65,10 @@ data Instance = Instance { name :: String -- ^ The instance name
} deriving (Show) } deriving (Show)
instance T.Element Instance where instance T.Element Instance where
nameOf = name nameOf = name
idxOf = idx idxOf = idx
setName = setName setAlias = setAlias
setIdx = setIdx setIdx = setIdx
-- | Running instance states. -- | Running instance states.
runningStates :: [String] runningStates :: [String]
......
...@@ -32,7 +32,7 @@ module Ganeti.HTools.Loader ...@@ -32,7 +32,7 @@ module Ganeti.HTools.Loader
, assignIndices , assignIndices
, lookupNode , lookupNode
, lookupInstance , lookupInstance
, stripSuffix , commonSuffix
, RqType(..) , RqType(..)
, Request(..) , Request(..)
) where ) where
...@@ -70,7 +70,7 @@ data RqType ...@@ -70,7 +70,7 @@ data RqType
deriving (Show) deriving (Show)
-- | A complete request, as received from Ganeti. -- | A complete request, as received from Ganeti.
data Request = Request RqType Node.List Instance.List [String] String data Request = Request RqType Node.List Instance.List [String]
deriving (Show) deriving (Show)
-- * Functions -- * Functions
...@@ -147,16 +147,19 @@ longestDomain (x:xs) = ...@@ -147,16 +147,19 @@ longestDomain (x:xs) =
else accu) else accu)
"" $ filter (isPrefixOf ".") (tails x) "" $ filter (isPrefixOf ".") (tails x)
-- | Remove tail suffix from a string.
stripSuffix :: Int -> String -> String
stripSuffix sflen name = take (length name - sflen) name
-- | Extracts the exclusion tags from the cluster configuration -- | Extracts the exclusion tags from the cluster configuration
extractExTags :: [String] -> [String] extractExTags :: [String] -> [String]
extractExTags = extractExTags =
map (drop (length exTagsPrefix)) . map (drop (length exTagsPrefix)) .
filter (isPrefixOf exTagsPrefix) filter (isPrefixOf exTagsPrefix)
-- | Extracts the common suffix from node/instance names
commonSuffix :: Node.List -> Instance.List -> String
commonSuffix nl il =
let node_names = map Node.name $ Container.elems nl
inst_names = map Instance.name $ Container.elems il
in longestDomain (node_names ++ inst_names)
-- | Initializer function that loads the data from a node and instance -- | Initializer function that loads the data from a node and instance
-- list and massages it into the correct format. -- list and massages it into the correct format.
mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data
...@@ -164,7 +167,7 @@ mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data ...@@ -164,7 +167,7 @@ mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data
-> [String] -- ^ Untouchable instances -> [String] -- ^ Untouchable instances
-> (Node.AssocList, Instance.AssocList, [String]) -> (Node.AssocList, Instance.AssocList, [String])
-- ^ Data from backends -- ^ Data from backends
-> Result (Node.List, Instance.List, [String], String) -> Result (Node.List, Instance.List, [String])
mergeData um extags exinsts (nl, il, tags) = mergeData um extags exinsts (nl, il, tags) =
let il2 = Container.fromAssocList il let il2 = Container.fromAssocList il
il3 = foldl' (\im (name, n_util) -> il3 = foldl' (\im (name, n_util) ->
...@@ -183,13 +186,12 @@ mergeData um extags exinsts (nl, il, tags) = ...@@ -183,13 +186,12 @@ mergeData um extags exinsts (nl, il, tags) =
node_names = map (Node.name . snd) nl node_names = map (Node.name . snd) nl
inst_names = map (Instance.name . snd) il inst_names = map (Instance.name . snd) il
common_suffix = longestDomain (node_names ++ inst_names) common_suffix = longestDomain (node_names ++ inst_names)
csl = length common_suffix snl = Container.map (computeAlias common_suffix) nl3
snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3 sil = Container.map (computeAlias common_suffix) il4
sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il4
in if not $ all (`elem` inst_names) exinsts in if not $ all (`elem` inst_names) exinsts
then Bad $ "Some of the excluded instances are unknown: " ++ then Bad $ "Some of the excluded instances are unknown: " ++
show (exinsts \\ inst_names) show (exinsts \\ inst_names)
else Ok (snl, sil, tags, common_suffix) else Ok (snl, sil, tags)
-- | Checks the cluster data for consistency. -- | Checks the cluster data for consistency.
checkData :: Node.List -> Instance.List checkData :: Node.List -> Instance.List
......
...@@ -33,7 +33,6 @@ module Ganeti.HTools.Node ...@@ -33,7 +33,6 @@ module Ganeti.HTools.Node
-- ** Finalization after data loading -- ** Finalization after data loading
, buildPeers , buildPeers
, setIdx , setIdx
, setName
, setAlias , setAlias
, setOffline , setOffline
, setXmem , setXmem
...@@ -123,7 +122,7 @@ data Node = Node ...@@ -123,7 +122,7 @@ data Node = Node
instance T.Element Node where instance T.Element Node where
nameOf = name nameOf = name
idxOf = idx idxOf = idx
setName = setName setAlias = setAlias
setIdx = setIdx setIdx = setIdx
-- | A simple name for the int, node association list. -- | A simple name for the int, node association list.
...@@ -227,12 +226,6 @@ mCpuTohiCpu mval tcpu = floor (mval * tcpu) ...@@ -227,12 +226,6 @@ mCpuTohiCpu mval tcpu = floor (mval * tcpu)
setIdx :: Node -> T.Ndx -> Node setIdx :: Node -> T.Ndx -> Node
setIdx t i = t {idx = i} setIdx t i = t {idx = i}
-- | Changes the name.
--
-- This is used only during the building of the data structures.
setName :: Node -> String -> Node
setName t s = t { name = s, alias = s }
-- | Changes the alias. -- | Changes the alias.
-- --
-- This is used only during the building of the data structures. -- This is used only during the building of the data structures.
...@@ -435,7 +428,8 @@ availCpu t = ...@@ -435,7 +428,8 @@ availCpu t =
showField :: Node -> String -> String showField :: Node -> String -> String
showField t field = showField t field =
case field of case field of
"name" -> name t "name" -> alias t
"fqdn" -> name t
"status" -> if offline t then "-" "status" -> if offline t then "-"
else if failN1 t then "*" else " " else if failN1 t then "*" else " "
"tmem" -> printf "%5.0f" $ tMem t "tmem" -> printf "%5.0f" $ tMem t
...@@ -471,6 +465,7 @@ showHeader :: String -> (String, Bool) ...@@ -471,6 +465,7 @@ showHeader :: String -> (String, Bool)
showHeader field = showHeader field =
case field of case field of
"name" -> ("Name", False) "name" -> ("Name", False)
"fqdn" -> ("Name", False)
"status" -> ("F", False) "status" -> ("F", False)
"tmem" -> ("t_mem", True) "tmem" -> ("t_mem", True)
"nmem" -> ("n_mem", True) "nmem" -> ("n_mem", True)
......
...@@ -194,7 +194,13 @@ class Element a where ...@@ -194,7 +194,13 @@ class Element a where
nameOf :: a -> String nameOf :: a -> String
-- | Returns the index of the element -- | Returns the index of the element
idxOf :: a -> Int idxOf :: a -> Int
-- | Updates the name of the element -- | Updates the alias of the element
setName :: a -> String -> a setAlias :: a -> String -> a
-- | Compute the alias by stripping a given suffix (domain) from
-- | the name
computeAlias :: String -> a -> a
computeAlias dom e = setAlias e alias
where alias = take (length name - length dom) name
name = nameOf e
-- | Updates the index of the element -- | Updates the index of the element
setIdx :: a -> Int -> a setIdx :: a -> Int -> a
...@@ -72,7 +72,7 @@ processResults _ as@(fstats, successes, sols) = ...@@ -72,7 +72,7 @@ processResults _ as@(fstats, successes, sols) =
processRequest :: Request processRequest :: Request
-> Result Cluster.AllocSolution -> Result Cluster.AllocSolution
processRequest request = processRequest request =
let Request rqtype nl il _ _ = request let Request rqtype nl il _ = request
in case rqtype of in case rqtype of
Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
...@@ -98,7 +98,7 @@ main = do ...@@ -98,7 +98,7 @@ main = do
exitWith $ ExitFailure 1 exitWith $ ExitFailure 1
Ok rq -> return rq Ok rq -> return rq
let Request rq nl _ _ csf = request let Request rq nl _ _ = request
when (isJust shownodes) $ do when (isJust shownodes) $ do
hPutStrLn stderr "Initial cluster status:" hPutStrLn stderr "Initial cluster status:"
...@@ -110,5 +110,5 @@ main = do ...@@ -110,5 +110,5 @@ main = do
Ok (ginfo, (_, _, sn)) -> (True, "Request successful: " ++ ginfo, Ok (ginfo, (_, _, sn)) -> (True, "Request successful: " ++ ginfo,
map snd sn) map snd sn)
Bad s -> (False, "Request failed: " ++ s, []) Bad s -> (False, "Request failed: " ++ s, [])
resp = formatResponse ok info csf rq rn resp = formatResponse ok info rq rn
putStrLn resp putStrLn resp
...@@ -149,13 +149,13 @@ checkJobsStatus :: [JobStatus] -> Bool ...@@ -149,13 +149,13 @@ checkJobsStatus :: [JobStatus] -> Bool
checkJobsStatus = all (== JobSuccess) checkJobsStatus = all (== JobSuccess)
-- | Execute an entire jobset -- | Execute an entire jobset
execJobSet :: String -> String -> Node.List execJobSet :: String -> Node.List
-> Instance.List -> [JobSet] -> IO () -> Instance.List -> [JobSet] -> IO ()
execJobSet _ _ _ _ [] = return () execJobSet _ _ _ [] = return ()
execJobSet master csf nl il (js:jss) = do execJobSet master nl il (js:jss) = do
-- map from jobset (htools list of positions) to [[opcodes]] -- map from jobset (htools list of positions) to [[opcodes]]
let jobs = map (\(_, idx, move, _) -> let jobs = map (\(_, idx, move, _) ->
Cluster.iMoveToJob csf nl il idx move) js Cluster.iMoveToJob nl il idx move) js
let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
putStrLn $ "Executing jobset for instances " ++ commaJoin descr putStrLn $ "Executing jobset for instances " ++ commaJoin descr
jrs <- bracket (L.getClient master) L.closeClient jrs <- bracket (L.getClient master) L.closeClient
...@@ -172,7 +172,7 @@ execJobSet master csf nl il (js:jss) = do ...@@ -172,7 +172,7 @@ execJobSet master csf nl il (js:jss) = do
hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
return () return ()
Ok x -> if checkJobsStatus x Ok x -> if checkJobsStatus x
then execJobSet master csf nl il jss then execJobSet master nl il jss
else do else do
hPutStrLn stderr $ "Not all jobs completed successfully: " ++ hPutStrLn stderr $ "Not all jobs completed successfully: " ++
show x show x
...@@ -192,7 +192,7 @@ main = do ...@@ -192,7 +192,7 @@ main = do
verbose = optVerbose opts verbose = optVerbose opts
shownodes = optShowNodes opts shownodes = optShowNodes opts
(fixed_nl, il, ctags, csf) <- loadExternalData opts (fixed_nl, il, ctags) <- loadExternalData opts
let offline_names = optOffline opts let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl all_nodes = Container.elems fixed_nl
...@@ -203,6 +203,7 @@ main = do ...@@ -203,6 +203,7 @@ main = do
all_nodes all_nodes
m_cpu = optMcpu opts m_cpu = optMcpu opts
m_dsk = optMdsk opts m_dsk = optMdsk opts
csf = commonSuffix fixed_nl il
when (length offline_wrong > 0) $ do when (length offline_wrong > 0) $ do
hPrintf stderr "Wrong node name(s) set as offline: %s\n" hPrintf stderr "Wrong node name(s) set as offline: %s\n"
...@@ -311,7 +312,7 @@ main = do ...@@ -311,7 +312,7 @@ main = do
Nothing -> do Nothing -> do
hPutStrLn stderr "Execution of commands possible only on LUXI" hPutStrLn stderr "Execution of commands possible only on LUXI"
exitWith $ ExitFailure 1 exitWith $ ExitFailure 1
Just master -> execJobSet master csf fin_nl il cmd_jobs) Just master -> execJobSet master fin_nl il cmd_jobs)
when (optShowInsts opts) $ do when (optShowInsts opts) $ do
putStrLn "" putStrLn ""
......
...@@ -65,28 +65,27 @@ options = ...@@ -65,28 +65,27 @@ options =
] ]
-- | Serialize a single node -- | Serialize a single node
serializeNode :: String -> Node.Node -> String serializeNode :: Node.Node -> String
serializeNode csf node = serializeNode node =
printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node ++ csf) printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node)
(Node.tMem node) (Node.nMem node) (Node.fMem node) (Node.tMem node) (Node.nMem node) (Node.fMem node)
(Node.tDsk node) (Node.fDsk node) (Node.tCpu node) (Node.tDsk node) (Node.fDsk node) (Node.tCpu node)
(if Node.offline node then 'Y' else 'N') (if Node.offline node then 'Y' else 'N')
-- | Generate node file data from node objects -- | Generate node file data from node objects
serializeNodes :: String -> Node.List -> String serializeNodes :: Node.List -> String
serializeNodes csf = serializeNodes = unlines . map serializeNode . Container.elems
unlines . map (serializeNode csf) . Container.elems
-- | Serialize a single instance -- | Serialize a single instance
serializeInstance :: String -> Node.List -> Instance.Instance -> String serializeInstance :: Node.List -> Instance.Instance -> String
serializeInstance csf nl inst = serializeInstance nl inst =
let let
iname = Instance.name inst ++ csf iname = Instance.name inst
pnode = Container.nameOf nl (Instance.pNode inst) ++ csf pnode = Container.nameOf nl (Instance.pNode inst)
sidx = Instance.sNode inst sidx = Instance.sNode inst
snode = (if sidx == Node.noSecondary snode = (if sidx == Node.noSecondary
then "" then ""
else Container.nameOf nl sidx ++ csf) else Container.nameOf nl sidx)
in in
printf "%s|%d|%d|%d|%s|%s|%s|%s" printf "%s|%d|%d|%d|%s|%s|%s|%s"
iname (Instance.mem inst) (Instance.dsk inst) iname (Instance.mem inst) (Instance.dsk inst)
...@@ -94,9 +93,9 @@ serializeInstance csf nl inst = ...@@ -94,9 +93,9 @@ serializeInstance csf nl inst =
pnode snode (intercalate "," (Instance.tags inst)) pnode snode (intercalate "," (Instance.tags inst))
-- | Generate instance file data from instance objects -- | Generate instance file data from instance objects
serializeInstances :: String -> Node.List -> Instance.List -> String serializeInstances :: Node.List -> Instance.List -> String
serializeInstances csf nl = serializeInstances nl =
unlines . map (serializeInstance csf nl) . Container.elems unlines . map (serializeInstance nl) . Container.elems
-- | Return a one-line summary of cluster state -- | Return a one-line summary of cluster state
printCluster :: Node.List -> Instance.List printCluster :: Node.List -> Instance.List
...@@ -128,10 +127,10 @@ fixSlash = map (\x -> if x == '/' then '_' else x) ...@@ -128,10 +127,10 @@ fixSlash = map (\x -> if x == '/' then '_' else x)
processData :: Result (Node.AssocList, Instance.AssocList, [String]) processData :: Result (Node.AssocList, Instance.AssocList, [String])
-> Result (Node.List, Instance.List, String) -> Result (Node.List, Instance.List, String)
processData input_data = do processData input_data = do
(nl, il, _, csf) <- input_data >>= Loader.mergeData [] [] [] (nl, il, _) <- input_data >>= Loader.mergeData [] [] []
let (_, fix_nl) = Loader.checkData nl il let (_, fix_nl) = Loader.checkData nl il
let ndata = serializeNodes csf nl let ndata = serializeNodes nl
idata = serializeInstances csf nl il idata = serializeInstances nl il
adata = ndata ++ ['\n'] ++ idata adata = ndata ++ ['\n'] ++ idata
return (fix_nl, il, adata) return (fix_nl, il, adata)
......
...@@ -242,7 +242,7 @@ main = do ...@@ -242,7 +242,7 @@ main = do
ispec = optISpec opts ispec = optISpec opts
shownodes = optShowNodes opts shownodes = optShowNodes opts
(fixed_nl, il, _, csf) <- loadExternalData opts (fixed_nl, il, _) <- loadExternalData opts
printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ] printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
...@@ -275,6 +275,7 @@ main = do ...@@ -275,6 +275,7 @@ main = do
else n) fixed_nl else n) fixed_nl
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu) nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
nm nm
csf = commonSuffix fixed_nl il
when (length csf > 0 && verbose > 1) $ when (length csf > 0 && verbose > 1) $
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
......