Revision 1b0a6356
b/htools/Ganeti/HTools/CLI.hs | ||
---|---|---|
250 | 250 |
oIDisk :: OptType |
251 | 251 |
oIDisk = Option "" ["disk"] |
252 | 252 |
(ReqArg (\ d opts -> do |
253 |
dsk <- annotateResult ("--disk option") (parseUnit d)
|
|
253 |
dsk <- annotateResult "--disk option" (parseUnit d)
|
|
254 | 254 |
let ospec = optISpec opts |
255 | 255 |
nspec = ospec { rspecDsk = dsk } |
256 | 256 |
return $ opts { optISpec = nspec }) "DISK") |
... | ... | |
259 | 259 |
oIMem :: OptType |
260 | 260 |
oIMem = Option "" ["memory"] |
261 | 261 |
(ReqArg (\ m opts -> do |
262 |
mem <- annotateResult ("--memory option") (parseUnit m)
|
|
262 |
mem <- annotateResult "--memory option" (parseUnit m)
|
|
263 | 263 |
let ospec = optISpec opts |
264 | 264 |
nspec = ospec { rspecMem = mem } |
265 | 265 |
return $ opts { optISpec = nspec }) "MEMORY") |
b/htools/Ganeti/HTools/Cluster.hs | ||
---|---|---|
994 | 994 |
-- The fromJust below is ugly (it can fail nastily), but |
995 | 995 |
-- at this point we should have any internal mismatches, |
996 | 996 |
-- and adding a monad here would be quite involved |
997 |
grpnodes = fromJust (gdx `lookup` (Node.computeGroups nodes))
|
|
997 |
grpnodes = fromJust (gdx `lookup` Node.computeGroups nodes)
|
|
998 | 998 |
new_cv = compCVNodes grpnodes |
999 | 999 |
new_accu = Right (nl', inst', new_cv, ndx) |
1000 | 1000 |
in case accu of |
b/htools/Ganeti/HTools/IAlloc.hs | ||
---|---|---|
188 | 188 |
return $ NodeEvacuate rl_idx rl_mode |
189 | 189 |
|
190 | 190 |
| otherwise -> fail ("Invalid request type '" ++ optype ++ "'") |
191 |
return $ (msgs, Request rqtype cdata)
|
|
191 |
return (msgs, Request rqtype cdata) |
|
192 | 192 |
|
193 | 193 |
-- | Formats the result into a valid IAllocator response message. |
194 | 194 |
formatResponse :: Bool -- ^ Whether the request was successful |
... | ... | |
215 | 215 |
(nl, inst, nodes, _):[] -> |
216 | 216 |
do |
217 | 217 |
let il' = Container.add (Instance.idx inst) inst il |
218 |
return (info, showJSON $ map (Node.name) nodes, nl, il')
|
|
218 |
return (info, showJSON $ map Node.name nodes, nl, il')
|
|
219 | 219 |
_ -> fail "Internal error: multiple allocation solutions" |
220 | 220 |
|
221 | 221 |
-- | Convert a node-evacuation/change group result. |
b/htools/Ganeti/HTools/Loader.hs | ||
---|---|---|
288 | 288 |
il4 = Container.map (filterExTags allextags . |
289 | 289 |
updateMovable selinst_names exinst_names) il3 |
290 | 290 |
nl2 = foldl' fixNodes nl (Container.elems il4) |
291 |
nl3 = Container.map (flip Node.buildPeers il4) nl2
|
|
291 |
nl3 = Container.map (`Node.buildPeers` il4) nl2
|
|
292 | 292 |
node_names = map Node.name (Container.elems nl) |
293 | 293 |
common_suffix = longestDomain (node_names ++ inst_names) |
294 | 294 |
snl = Container.map (computeAlias common_suffix) nl3 |
b/htools/Ganeti/HTools/Program/Hbal.hs | ||
---|---|---|
273 | 273 |
exitWith ExitSuccess |
274 | 274 |
|
275 | 275 |
let split_insts = Cluster.findSplitInstances nlf ilf |
276 |
when (not . null $ split_insts) $ do
|
|
276 |
unless (null split_insts) $ do
|
|
277 | 277 |
hPutStrLn stderr "Found instances belonging to multiple node groups:" |
278 | 278 |
mapM_ (\i -> hPutStrLn stderr $ " " ++ Instance.name i) split_insts |
279 | 279 |
hPutStrLn stderr "Aborting." |
b/htools/Ganeti/HTools/Program/Hspace.hs | ||
---|---|---|
95 | 95 |
-- | Efficiency generic function. |
96 | 96 |
effFn :: (Cluster.CStats -> Integer) |
97 | 97 |
-> (Cluster.CStats -> Double) |
98 |
-> (Cluster.CStats -> Double)
|
|
98 |
-> Cluster.CStats -> Double
|
|
99 | 99 |
effFn fi ft cs = fromIntegral (fi cs) / ft cs |
100 | 100 |
|
101 | 101 |
-- | Memory efficiency. |
... | ... | |
271 | 271 |
[False, False, False, True, True, True] |
272 | 272 |
|
273 | 273 |
-- | Formats nicely a list of resources. |
274 |
formatResources :: a -> [(String, (a->String))] -> String
|
|
274 |
formatResources :: a -> [(String, a->String)] -> String
|
|
275 | 275 |
formatResources res = |
276 | 276 |
intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res) |
277 | 277 |
|
... | ... | |
298 | 298 |
where req_nodes = Instance.requiredNodes disk_template |
299 | 299 |
prefix = specPrefix spec |
300 | 300 |
|
301 |
printISpec False ispec spec disk_template = do
|
|
301 |
printISpec False ispec spec disk_template = |
|
302 | 302 |
printf "%s instance spec is:\n %s, using disk\ |
303 | 303 |
\ template '%s'.\n" |
304 | 304 |
(specDescription spec) |
b/htools/Ganeti/HTools/QC.hs | ||
---|---|---|
350 | 350 |
Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) && |
351 | 351 |
Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) && |
352 | 352 |
Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int) |
353 |
where _types = (n::Int)
|
|
353 |
where _types = n::Int
|
|
354 | 354 |
|
355 | 355 |
-- | Test list for the Utils module. |
356 | 356 |
testUtils = |
... | ... | |
591 | 591 |
case inst of |
592 | 592 |
Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg) |
593 | 593 |
False |
594 |
Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
|
|
595 |
\ loading the instance") $
|
|
594 |
Types.Ok (_, i) -> printTestCase "Mismatch in some field while\ |
|
595 |
\ loading the instance" $
|
|
596 | 596 |
Instance.name i == name && |
597 | 597 |
Instance.vcpus i == vcpus && |
598 | 598 |
Instance.mem i == mem && |
... | ... | |
734 | 734 |
inst_idx = Instance.idx inst_ab |
735 | 735 |
node_add_ab = Node.addSec node inst_ab (-1) |
736 | 736 |
node_add_nb = Node.addSec node inst_nb (-1) |
737 |
node_del_ab = liftM (flip Node.removeSec inst_ab) node_add_ab
|
|
738 |
node_del_nb = liftM (flip Node.removeSec inst_nb) node_add_nb
|
|
737 |
node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
|
|
738 |
node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
|
|
739 | 739 |
in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of |
740 | 740 |
(Types.OpGood a_ab, Types.OpGood a_nb, |
741 | 741 |
Types.OpGood d_ab, Types.OpGood d_nb) -> |
Also available in: Unified diff