-- * Types
NodeList
, InstanceList
+ , NameList
, Placement
, Solution(..)
, Table(..)
, printStats
-- * Loading functions
, loadData
+ , checkData
) where
import Data.List
type NodeList = Container.Container Node.Node
type InstanceList = Container.Container Instance.Instance
+-- | The type used to hold idx-to-name mappings
+type NameList = [(Int, String)]
-- | A separate name for the cluster score type
type Score = Double
in
compareTables cur_tbl upd_tbl
+-- | Given the status of the current secondary as a valid new node
+-- and the current candidate target node,
+-- generate the possible moves for a instance.
+possibleMoves :: Bool -> Int -> [IMove]
+possibleMoves True tdx =
+ [ReplaceSecondary tdx,
+ ReplaceAndFailover tdx,
+ ReplacePrimary tdx,
+ FailoverAndReplace tdx]
+
+possibleMoves False tdx =
+ [ReplaceSecondary tdx,
+ ReplaceAndFailover tdx]
+
+-- | Compute the best move for a given instance.
checkInstanceMove :: [Int] -- Allowed target node indices
-> Table -- Original table
-> Instance.Instance -- Instance to move
opdx = Instance.pnode target
osdx = Instance.snode target
nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
- aft_failover = checkSingleStep ini_tbl target ini_tbl Failover
- all_moves = concatMap (\idx -> [ReplacePrimary idx,
- ReplaceSecondary idx,
- ReplaceAndFailover idx,
- FailoverAndReplace idx]) nodes
+ use_secondary = elem osdx nodes_idx
+ aft_failover = if use_secondary -- if allowed to failover
+ then checkSingleStep ini_tbl target ini_tbl Failover
+ else ini_tbl
+ all_moves = concatMap (possibleMoves use_secondary) nodes
in
-- iterate over the possible nodes for this instance
foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
else
if c == b then {- Failover and ... -}
if d == a then {- that's all -}
- ("f", [printf "migrate %s" i])
+ ("f", [printf "migrate -f %s" i])
else
(printf "f r:%s" d,
- [printf "migrate %s" i,
+ [printf "migrate -f %s" i,
printf "replace-disks -n %s %s" d i])
else
if d == a then {- ... and keep primary as secondary -}
(printf "r:%s f" c,
[printf "replace-disks -n %s %s" c i,
- printf "migrate %s" i])
+ printf "migrate -f %s" i])
else
if d == b then {- ... keep same secondary -}
(printf "f r:%s f" c,
- [printf "migrate %s" i,
+ [printf "migrate -f %s" i,
printf "replace-disks -n %s %s" c i,
- printf "migrate %s" i])
+ printf "migrate -f %s" i])
else {- Nothing in common -}
(printf "r:%s f r:%s" c d,
[printf "replace-disks -n %s %s" c i,
- printf "migrate %s" i,
+ printf "migrate -f %s" i,
printf "replace-disks -n %s %s" d i])
{-| Converts a placement to string format -}
printSolutionLine :: InstanceList
- -> [(Int, String)]
- -> [(Int, String)]
+ -> NameList
+ -> NameList
-> Int
-> Int
-> Placement
formatCmds :: [[String]] -> String
formatCmds cmd_strs =
- unlines $ map (" echo " ++) $
+ unlines $
concat $ map (\(a, b) ->
- (printf "step %d" (a::Int)):(map ("gnt-instance " ++) b)) $
+ (printf "echo step %d" (a::Int)):
+ (printf "check"):
+ (map ("gnt-instance " ++) b)) $
zip [1..] cmd_strs
{-| Converts a solution to string format -}
printSolution :: InstanceList
- -> [(Int, String)]
- -> [(Int, String)]
+ -> NameList
+ -> NameList
-> [Placement]
-> ([String], [[String]])
printSolution il ktn kti sol =
zip sol [1..]
-- | Print the node list.
-printNodes :: [(Int, String)] -> NodeList -> String
+printNodes :: NameList -> NodeList -> String
printNodes ktn nl =
let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
snl' = map (\ n -> ((fromJust $ lookup (Node.idx n) ktn), n)) snl
m_name = maximum . (map length) . fst . unzip $ snl'
helper = Node.list m_name
- header = printf "%2s %-*s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
- "N1" m_name "Name" "t_mem" "f_mem" "r_mem"
+ header = printf
+ "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
+ " F" m_name "Name"
+ "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
"t_dsk" "f_dsk"
"pri" "sec" "p_fmem" "p_fdsk"
in unlines $ (header:map (uncurry helper) snl')
-- | Compute the mem and disk covariance.
-compDetailedCV :: NodeList -> (Double, Double, Double, Double)
+compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double)
compDetailedCV nl =
let
- nodes = Container.elems nl
+ all_nodes = Container.elems nl
+ (offline, nodes) = partition Node.offline all_nodes
mem_l = map Node.p_mem nodes
dsk_l = map Node.p_dsk nodes
mem_cv = varianceCoeff mem_l
n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
res_l = map Node.p_rem nodes
res_cv = varianceCoeff res_l
- in (mem_cv, dsk_cv, n1_score, res_cv)
+ offline_inst = sum . map (\n -> (length . Node.plist $ n) +
+ (length . Node.slist $ n)) $ offline
+ online_inst = sum . map (\n -> (length . Node.plist $ n) +
+ (length . Node.slist $ n)) $ nodes
+ off_score = (fromIntegral offline_inst) /
+ (fromIntegral $ online_inst + offline_inst)
+ in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
-- | Compute the 'total' variance.
compCV :: NodeList -> Double
compCV nl =
- let (mem_cv, dsk_cv, n1_score, res_cv) = compDetailedCV nl
- in mem_cv + dsk_cv + n1_score + res_cv
+ let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
+ in mem_cv + dsk_cv + n1_score + res_cv + off_score
printStats :: NodeList -> String
printStats nl =
- let (mem_cv, dsk_cv, n1_score, res_cv) = compDetailedCV nl
- in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f"
- mem_cv res_cv dsk_cv n1_score
+ let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
+ in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
+ mem_cv res_cv dsk_cv n1_score off_score
-- Balancing functions
ac3 = (pdx, pnew):(sdx, snew):ac2
in ac3) nl il
--- | Compute the longest common suffix of a [(Int, String)] list that
+-- | Compute the longest common suffix of a NameList list that
-- | starts with a dot
-longestDomain :: [(Int, String)] -> String
+longestDomain :: NameList -> String
longestDomain [] = ""
longestDomain ((_,x):xs) =
let
"" $ filter (isPrefixOf ".") (tails x)
-- | Remove tails from the (Int, String) lists
-stripSuffix :: String -> [(Int, String)] -> [(Int, String)]
+stripSuffix :: String -> NameList -> NameList
stripSuffix suffix lst =
let sflen = length suffix in
map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
-> String -- ^ Instance data in text format
-> (Container.Container Node.Node,
Container.Container Instance.Instance,
- String, [(Int, String)], [(Int, String)])
+ String, NameList, NameList)
loadData ndata idata =
let
- {- node file: name mem disk -}
+ {- node file: name t_mem n_mem f_mem t_disk f_disk -}
(ktn, nl) = loadTabular ndata
- (\ (i:jt:jf:kt:kf:[]) -> (i, Node.create jt jf kt kf))
+ (\ (name:tm:nm:fm:td:fd:[]) ->
+ (name,
+ Node.create (read tm) (read nm)
+ (read fm) (read td) (read fd)))
Node.setIdx
- {- instance file: name mem disk -}
+ {- instance file: name mem disk status pnode snode -}
(kti, il) = loadTabular idata
- (\ (i:j:k:l:m:[]) -> (i,
- Instance.create j k
- (fromJust $ lookup l ktn)
- (fromJust $ lookup m ktn)))
+ (\ (name:mem:dsk:status:pnode:snode:[]) ->
+ (name,
+ Instance.create (read mem) (read dsk)
+ status
+ (fromJust $ lookup pnode ktn)
+ (fromJust $ lookup snode ktn)))
Instance.setIdx
nl2 = fixNodes nl il
il3 = Container.fromAssocList il
sti = stripSuffix common_suffix xti
in
(nl3, il3, common_suffix, stn, sti)
+
+-- | Compute the amount of memory used by primary instances on a node.
+nodeImem :: Node.Node -> InstanceList -> Int
+nodeImem node il =
+ let rfind = flip Container.find $ il
+ in sum . map Instance.mem .
+ map rfind $ Node.plist node
+
+-- | Compute the amount of disk used by instances on a node (either primary
+-- or secondary).
+nodeIdsk :: Node.Node -> InstanceList -> Int
+nodeIdsk node il =
+ let rfind = flip Container.find $ il
+ in sum . map Instance.dsk .
+ map rfind $ (Node.plist node) ++ (Node.slist node)
+
+
+-- | Check cluster data for consistency
+checkData :: NodeList -> InstanceList -> NameList -> NameList
+ -> ([String], NodeList)
+checkData nl il ktn _ =
+ Container.mapAccum
+ (\ msgs node ->
+ let nname = fromJust $ lookup (Node.idx node) ktn
+ nilst = map (flip Container.find $ il) (Node.plist node)
+ dilst = filter (not . Instance.running) nilst
+ adj_mem = sum . map Instance.mem $ dilst
+ delta_mem = (truncate $ Node.t_mem node)
+ - (Node.n_mem node)
+ - (Node.f_mem node)
+ - (nodeImem node il)
+ + adj_mem
+ delta_dsk = (truncate $ Node.t_dsk node)
+ - (Node.f_dsk node)
+ - (nodeIdsk node il)
+ newn = Node.setFmem (Node.setXmem node delta_mem)
+ (Node.f_mem node - adj_mem)
+ umsg1 = if delta_mem > 16 || delta_dsk > 1024
+ then [printf "node %s is missing %d MB ram \
+ \and %d GB disk"
+ nname delta_mem (delta_dsk `div` 1024)]
+ else []
+ in (msgs ++ umsg1, newn)
+ ) [] nl
projects / ganeti-local / blobdiff