diff --git a/Ganeti/HTools/CLI.hs b/Ganeti/HTools/CLI.hs index c597bda8be41722aa5a5f63ffc296beb64820f41..8f177da00d86c17814825f95ee9bb767533d0a1d 100644 --- a/Ganeti/HTools/CLI.hs +++ b/Ganeti/HTools/CLI.hs @@ -118,7 +118,7 @@ loadExternalData opts = do printf "Error: failed to load data. Details:\n%s\n" s exitWith $ ExitFailure 1 ) - let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il ktn kti + let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il unless (null fix_msgs || silent opts) $ do putStrLn "Warning: cluster has inconsistent data:" diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 74f24d8896691be5e4bb1562b0d8cd875d165c67..0022e9ea3ac7396f139c7fc6cee97d4d7a092fe5 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -581,19 +581,18 @@ computeMoves i a b c d = {-| Converts a placement to string format -} printSolutionLine :: InstanceList - -> NameList -> NameList -> Int -> Int -> Placement -> Int -> (String, [String]) -printSolutionLine il ktn kti nmlen imlen plc pos = +printSolutionLine il ktn nmlen imlen plc pos = let pmlen = (2*nmlen + 1) (i, p, s, c) = plc inst = Container.find i il - inam = fromJust $ lookup (Instance.idx inst) kti + inam = Instance.name inst npri = fromJust $ lookup p ktn nsec = fromJust $ lookup s ktn opri = fromJust $ lookup (Instance.pnode inst) ktn @@ -628,15 +627,14 @@ printSolution il ktn kti sol = imlen = mlen_fn kti nmlen = mlen_fn ktn in - unzip $ map (uncurry $ printSolutionLine il ktn kti nmlen imlen) $ + unzip $ map (uncurry $ printSolutionLine il ktn nmlen imlen) $ zip sol [1..] -- | Print the node list. -printNodes :: NameList -> NodeList -> String -printNodes ktn nl = +printNodes :: NodeList -> String +printNodes 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' + m_name = maximum . map (length . Node.name) $ snl helper = Node.list m_name header = printf "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s" @@ -644,7 +642,7 @@ printNodes ktn nl = "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') + in unlines $ (header:map helper snl) -- | Compute the mem and disk covariance. compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double) diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs index 442dbb3a58a47d3c6039fa03a0490e18f076549f..ca58d4cc5ad52d60aa475d9cd143faac4ed5ee2f 100644 --- a/Ganeti/HTools/Loader.hs +++ b/Ganeti/HTools/Loader.hs @@ -107,12 +107,12 @@ mergeData (ktn, nl, kti, il) = do return (snl, sil, common_suffix, stn, sti) -- | Check cluster data for consistency -checkData :: NodeList -> InstanceList -> NameList -> NameList +checkData :: NodeList -> InstanceList -> ([String], NodeList) -checkData nl il ktn _ = +checkData nl il = Container.mapAccum (\ msgs node -> - let nname = fromJust $ lookup (Node.idx node) ktn + let nname = Node.name node nilst = map (flip Container.find $ il) (Node.plist node) dilst = filter (not . Instance.running) nilst adj_mem = sum . map Instance.mem $ dilst diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs index 9f54f03707c6bf9e27b4731667dd9d99db23decf..aa3eaf401c4958d0749c98d2de8ab330eca721f6 100644 --- a/Ganeti/HTools/Node.hs +++ b/Ganeti/HTools/Node.hs @@ -234,8 +234,8 @@ setSec :: Node -> Int -> Node setSec t idx = t { slist = idx:(slist t) } -- | String converter for the node list functionality. -list :: Int -> String -> Node -> String -list mname n t = +list :: Int -> Node -> String +list mname t = let pl = plist t sl = slist t mp = p_mem t @@ -250,7 +250,7 @@ list mname n t = in printf " %c %-*s %5.0f %5d %5d %5d %5d %5d %5.0f %5d %3d %3d %.5f %.5f" (if off then '-' else if fn then '*' else ' ') - mname n tmem nmem imem xmem fmem (r_mem t) + mname (name t) tmem nmem imem xmem fmem (r_mem t) ((t_dsk t) / 1024) ((f_dsk t) `div` 1024) (length pl) (length sl) mp dp diff --git a/hail.hs b/hail.hs index b375e16690b8b9596c4612c6afeb92b1b271300c..e61a6317b3d8588c1ae9b71fc82939890e6ca66f 100644 --- a/hail.hs +++ b/hail.hs @@ -141,7 +141,7 @@ iterateDepth ini_tbl max_rounds ktn kti nmlen imlen in do let - (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti + (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn nmlen imlen (head fin_plc) fin_plc_len upd_cmd_strs = cmds:cmd_strs unless (oneline || fin_plc_len == ini_plc_len) $ do diff --git a/hbal.hs b/hbal.hs index c791a57c3e648d39f27e378426980a9661caac81..d54951a57f495ca85019c4f1b13764767e9e161a 100644 --- a/hbal.hs +++ b/hbal.hs @@ -127,7 +127,6 @@ we find a valid solution or we exceed the maximum depth. iterateDepth :: Cluster.Table -- ^ The starting table -> Int -- ^ Remaining length -> Cluster.NameList -- ^ Node idx to name list - -> Cluster.NameList -- ^ Inst idx to name list -> Int -- ^ Max node name len -> Int -- ^ Max instance name len -> [[String]] -- ^ Current command list @@ -135,7 +134,7 @@ iterateDepth :: Cluster.Table -- ^ The starting table -> Cluster.Score -- ^ Score at which to stop -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and -- commands -iterateDepth ini_tbl max_rounds ktn kti nmlen imlen +iterateDepth ini_tbl max_rounds ktn nmlen imlen cmd_strs oneline min_score = let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl all_inst = Container.elems ini_il @@ -149,7 +148,7 @@ iterateDepth ini_tbl max_rounds ktn kti nmlen imlen in do let - (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti + (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn nmlen imlen (head fin_plc) fin_plc_len upd_cmd_strs = cmds:cmd_strs unless (oneline || fin_plc_len == ini_plc_len) $ do @@ -157,7 +156,7 @@ iterateDepth ini_tbl max_rounds ktn kti nmlen imlen hFlush stdout (if fin_cv < ini_cv then -- this round made success, try deeper if allowed_next && fin_cv > min_score - then iterateDepth fin_tbl max_rounds ktn kti + then iterateDepth fin_tbl max_rounds ktn nmlen imlen upd_cmd_strs oneline min_score -- don't go deeper, but return the better solution else return (fin_tbl, upd_cmd_strs) @@ -224,7 +223,7 @@ main = do when (optShowNodes opts) $ do putStrLn "Initial cluster status:" - putStrLn $ Cluster.printNodes ktn nl + putStrLn $ Cluster.printNodes nl let ini_cv = Cluster.compCV nl ini_tbl = Cluster.Table nl il ini_cv [] @@ -250,7 +249,7 @@ main = do nmlen = mlen_fn ktn (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts) - ktn kti nmlen imlen [] oneline min_cv + ktn nmlen imlen [] oneline min_cv let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl ord_plc = reverse fin_plc sol_msg = if null fin_plc @@ -288,7 +287,7 @@ main = do (final_mem, final_disk) = Cluster.totalResources fin_nl putStrLn "" putStrLn "Final cluster status:" - putStrLn $ Cluster.printNodes ktn fin_nl + putStrLn $ Cluster.printNodes fin_nl when (verbose > 3) $ do printf "Original: mem=%d disk=%d\n" orig_mem orig_disk diff --git a/hn1.hs b/hn1.hs index e7fc122f11d371ae5de25bf5a2ebb94801c8c439..5d6c424f667937f3b82f7dc3f9e5035d0ca61174 100644 --- a/hn1.hs +++ b/hn1.hs @@ -211,6 +211,6 @@ main = do (final_mem, final_disk) = Cluster.totalResources ns putStrLn "" putStrLn "Final cluster status:" - putStrLn $ Cluster.printNodes ktn ns + putStrLn $ Cluster.printNodes ns printf "Original: mem=%d disk=%d\n" orig_mem orig_disk printf "Final: mem=%d disk=%d\n" final_mem final_disk diff --git a/hscan.hs b/hscan.hs index fb9a89783458b0d4dce02aa8113254802536c772..17663c72222b4758956f02ca73d1773c746ad6ad 100644 --- a/hscan.hs +++ b/hscan.hs @@ -74,13 +74,12 @@ options = ] -- | Generate node file data from node objects -serializeNodes :: Cluster.NodeList -> String -> Cluster.NameList -> String -serializeNodes nl csf ktn = - let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn - nodes = Container.elems nl +serializeNodes :: Cluster.NodeList -> String -> String +serializeNodes nl csf = + let nodes = Container.elems nl nlines = map (\node -> - let name = (fromJust $ lookup (Node.idx node) etn) + let name = Node.name node ++ csf t_mem = (truncate $ Node.t_mem node)::Int t_dsk = (truncate $ Node.t_dsk node)::Int in @@ -94,15 +93,14 @@ serializeNodes nl csf ktn = -- | Generate instance file data from instance objects serializeInstances :: Cluster.InstanceList -> String - -> Cluster.NameList -> Cluster.NameList -> String -serializeInstances il csf ktn kti = + -> Cluster.NameList -> String +serializeInstances il csf ktn = let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn - eti = map (\(idx, name) -> (idx, name ++ csf)) kti instances = Container.elems il nlines = map (\inst -> let - iname = fromJust $ lookup (Instance.idx inst) eti + iname = Instance.name inst ++ csf pnode = fromJust $ lookup (Instance.pnode inst) etn snode = fromJust $ lookup (Instance.snode inst) etn in @@ -116,19 +114,19 @@ serializeInstances il csf ktn kti = -- | Return a one-line summary of cluster state printCluster :: Cluster.NodeList -> Cluster.InstanceList - -> Cluster.NameList -> Cluster.NameList -> String -printCluster nl il ktn kti = +printCluster nl il = let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il ccv = Cluster.compCV nl nodes = Container.elems nl + insts = Container.elems il t_ram = truncate . sum . map Node.t_mem $ nodes t_dsk = truncate . sum . map Node.t_dsk $ nodes f_ram = sum . map Node.f_mem $ nodes f_dsk = sum . map Node.f_dsk $ nodes in printf "%5d %5d %5d %5d %6d %6d %6d %6d %.8f" - (length ktn) (length kti) + (length nodes) (length insts) (length bad_nodes) (length bad_instances) (t_ram::Integer) f_ram ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024) @@ -165,13 +163,13 @@ main = do Bad err -> printf "\nError: failed to load data. \ \Details:\n%s\n" err Ok x -> do - let (nl, il, csf, ktn, kti) = x - (_, fix_nl) = Loader.checkData nl il ktn kti - putStrLn $ printCluster fix_nl il ktn kti + let (nl, il, csf, ktn, _) = x + (_, fix_nl) = Loader.checkData nl il + putStrLn $ printCluster fix_nl il when (optShowNodes opts) $ do - putStr $ Cluster.printNodes ktn fix_nl - let ndata = serializeNodes nl csf ktn - idata = serializeInstances il csf ktn kti + putStr $ Cluster.printNodes fix_nl + let ndata = serializeNodes nl csf + idata = serializeInstances il csf ktn oname = odir </> (fixSlash name) writeFile (oname <.> "nodes") ndata writeFile (oname <.> "instances") idata)