diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 0022e9ea3ac7396f139c7fc6cee97d4d7a092fe5..17e1ffeee7caa665946d2516502a5e245ec0912d 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -580,23 +580,23 @@ computeMoves i a b c d = printf "replace-disks -n %s %s" d i]) {-| Converts a placement to string format -} -printSolutionLine :: InstanceList - -> NameList - -> Int - -> Int - -> Placement - -> Int - -> (String, [String]) -printSolutionLine il ktn nmlen imlen plc pos = +printSolutionLine :: NodeList + -> InstanceList + -> Int + -> Int + -> Placement + -> Int + -> (String, [String]) +printSolutionLine nl il nmlen imlen plc pos = let pmlen = (2*nmlen + 1) (i, p, s, c) = plc inst = Container.find i il inam = Instance.name inst - npri = fromJust $ lookup p ktn - nsec = fromJust $ lookup s ktn - opri = fromJust $ lookup (Instance.pnode inst) ktn - osec = fromJust $ lookup (Instance.snode inst) ktn + npri = cNameOf nl p + nsec = cNameOf nl s + opri = cNameOf nl $ Instance.pnode inst + osec = cNameOf nl $ Instance.snode inst (moves, cmds) = computeMoves inam opri osec npri nsec ostr = (printf "%s:%s" opri osec)::String nstr = (printf "%s:%s" npri nsec)::String @@ -616,18 +616,16 @@ formatCmds cmd_strs = zip [1..] cmd_strs {-| Converts a solution to string format -} -printSolution :: InstanceList - -> NameList - -> NameList +printSolution :: NodeList + -> InstanceList -> [Placement] -> ([String], [[String]]) -printSolution il ktn kti sol = +printSolution nl il sol = let - mlen_fn = maximum . (map length) . snd . unzip - imlen = mlen_fn kti - nmlen = mlen_fn ktn + nmlen = cMaxNamelen nl + imlen = cMaxNamelen il in - unzip $ map (uncurry $ printSolutionLine il ktn nmlen imlen) $ + unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $ zip sol [1..] -- | Print the node list. diff --git a/hbal.hs b/hbal.hs index d54951a57f495ca85019c4f1b13764767e9e161a..7f0ae28d24420130c4d565d7eabdb60b36244f21 100644 --- a/hbal.hs +++ b/hbal.hs @@ -126,7 +126,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 -> Int -- ^ Max node name len -> Int -- ^ Max instance name len -> [[String]] -- ^ Current command list @@ -134,7 +133,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 nmlen imlen +iterateDepth ini_tbl max_rounds 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 @@ -148,7 +147,7 @@ iterateDepth ini_tbl max_rounds ktn nmlen imlen in do let - (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn + (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il nmlen imlen (head fin_plc) fin_plc_len upd_cmd_strs = cmds:cmd_strs unless (oneline || fin_plc_len == ini_plc_len) $ do @@ -156,7 +155,7 @@ iterateDepth ini_tbl max_rounds ktn 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 + then iterateDepth fin_tbl max_rounds nmlen imlen upd_cmd_strs oneline min_score -- don't go deeper, but return the better solution else return (fin_tbl, upd_cmd_strs) @@ -182,13 +181,15 @@ main = do let oneline = optOneline opts verbose = optVerbose opts - (fixed_nl, il, csf, ktn, kti) <- CLI.loadExternalData opts + (fixed_nl, il, csf, _, _) <- CLI.loadExternalData opts let offline_names = optOffline opts - all_names = snd . unzip $ ktn + all_nodes = Container.elems fixed_nl + all_names = map Node.name all_nodes offline_wrong = filter (\n -> not $ elem n all_names) offline_names - offline_indices = fst . unzip . - filter (\(_, n) -> elem n offline_names) $ ktn + offline_indices = map Node.idx $ + filter (\n -> elem (Node.name n) offline_names) + all_nodes when (length offline_wrong > 0) $ do printf "Wrong node name(s) set as offline: %s\n" @@ -244,12 +245,11 @@ main = do printf "Initial score: %.8f\n" ini_cv) unless oneline $ putStrLn "Trying to minimize the CV..." - let mlen_fn = maximum . (map length) . snd . unzip - imlen = mlen_fn kti - nmlen = mlen_fn ktn + let imlen = cMaxNamelen il + nmlen = cMaxNamelen nl (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts) - ktn nmlen imlen [] oneline min_cv + 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 diff --git a/hn1.hs b/hn1.hs index 5d6c424f667937f3b82f7dc3f9e5035d0ca61174..962558f80b2ddcf94535f606785ebabe78870728 100644 --- a/hn1.hs +++ b/hn1.hs @@ -145,7 +145,7 @@ main = do hPutStrLn stderr "Error: this program doesn't take any arguments." exitWith $ ExitFailure 1 - (nl, il, csf, ktn, kti) <- CLI.loadExternalData opts + (nl, il, csf, _, _) <- CLI.loadExternalData opts printf "Loaded %d nodes, %d instances\n" (Container.size nl) @@ -197,7 +197,7 @@ main = do (Cluster.printStats ns) printf "Solution (delta=%d):\n" $! min_d - let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution + let (sol_strs, cmd_strs) = Cluster.printSolution ns il solution putStr $ unlines $ sol_strs when (optShowCmds opts) $ do diff --git a/hscan.hs b/hscan.hs index 17663c72222b4758956f02ca73d1773c746ad6ad..fab3bdbb5964af669a2bf0552877c0a5eaaf5f87 100644 --- a/hscan.hs +++ b/hscan.hs @@ -92,17 +92,16 @@ serializeNodes nl csf = in unlines nlines -- | Generate instance file data from instance objects -serializeInstances :: Cluster.InstanceList -> String - -> Cluster.NameList -> String -serializeInstances il csf ktn = - let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn - instances = Container.elems il +serializeInstances :: Cluster.NodeList -> Cluster.InstanceList + -> String -> String +serializeInstances nl il csf = + let instances = Container.elems il nlines = map (\inst -> let iname = Instance.name inst ++ csf - pnode = fromJust $ lookup (Instance.pnode inst) etn - snode = fromJust $ lookup (Instance.snode inst) etn + pnode = cNameOf nl $ Instance.pnode inst + snode = cNameOf nl $ Instance.snode inst in printf "%s|%d|%d|%s|%s|%s" iname (Instance.mem inst) (Instance.dsk inst) @@ -163,13 +162,13 @@ main = do Bad err -> printf "\nError: failed to load data. \ \Details:\n%s\n" err Ok x -> do - let (nl, il, csf, ktn, _) = x + let (nl, il, csf, _, _) = x (_, fix_nl) = Loader.checkData nl il putStrLn $ printCluster fix_nl il when (optShowNodes opts) $ do putStr $ Cluster.printNodes fix_nl let ndata = serializeNodes nl csf - idata = serializeInstances il csf ktn + idata = serializeInstances nl il csf oname = odir </> (fixSlash name) writeFile (oname <.> "nodes") ndata writeFile (oname <.> "instances") idata)