Revision 57f07ff2 htools/Ganeti/HTools/IAlloc.hs
| b/htools/Ganeti/HTools/IAlloc.hs | ||
|---|---|---|
| 124 | 124 |
apol <- extract "alloc_policy" |
| 125 | 125 |
return (u, Group.create name u apol) |
| 126 | 126 |
|
| 127 |
parseTargetGroups :: JSRecord -- ^ The JSON object (request dict) |
|
| 128 |
-> Group.List -- ^ The existing groups |
|
| 129 |
-> Result [Gdx] |
|
| 130 |
parseTargetGroups req map_g = do |
|
| 131 |
group_uuids <- fromObjWithDefault req "target_groups" [] |
|
| 132 |
mapM (liftM Group.idx . Container.findByName map_g) group_uuids |
|
| 133 |
|
|
| 134 | 127 |
-- | Top-level parser. |
| 135 | 128 |
parseData :: String -- ^ The JSON message as received from Ganeti |
| 136 | 129 |
-> Result Request -- ^ A (possible valid) request |
| ... | ... | |
| 186 | 179 |
ex_nodes <- mapM (Container.findByName map_n) ex_names |
| 187 | 180 |
let ex_ndx = map Node.idx ex_nodes |
| 188 | 181 |
return $ Evacuate ex_ndx |
| 189 |
| optype == C.iallocatorModeMreloc ->
|
|
| 182 |
| optype == C.iallocatorModeChgGroup ->
|
|
| 190 | 183 |
do |
| 191 | 184 |
rl_names <- extrReq "instances" |
| 192 |
rl_insts <- mapM (Container.findByName map_i) rl_names |
|
| 193 |
let rl_idx = map Instance.idx rl_insts |
|
| 194 |
rl_mode <- |
|
| 195 |
case extrReq "reloc_mode" of |
|
| 196 |
Ok s | s == C.iallocatorMrelocKeep -> return KeepGroup |
|
| 197 |
| s == C.iallocatorMrelocChange -> |
|
| 198 |
do |
|
| 199 |
tg_groups <- parseTargetGroups request map_g |
|
| 200 |
return $ ChangeGroup tg_groups |
|
| 201 |
| s == C.iallocatorMrelocAny -> return AnyGroup |
|
| 202 |
| otherwise -> Bad $ "Invalid relocate mode " ++ s |
|
| 203 |
Bad x -> Bad x |
|
| 204 |
return $ MultiReloc rl_idx rl_mode |
|
| 185 |
rl_insts <- mapM (liftM Instance.idx . |
|
| 186 |
Container.findByName map_i) rl_names |
|
| 187 |
gr_uuids <- extrReq "target_groups" |
|
| 188 |
gr_idxes <- mapM (liftM Group.idx . |
|
| 189 |
Container.findByName map_g) gr_uuids |
|
| 190 |
return $ ChangeGroup rl_insts gr_idxes |
|
| 205 | 191 |
| optype == C.iallocatorModeNodeEvac -> |
| 206 | 192 |
do |
| 207 | 193 |
rl_names <- extrReq "instances" |
| ... | ... | |
| 276 | 262 |
Cluster.tryMGReloc gl nl il idx reqn exnodes >>= formatAllocate |
| 277 | 263 |
Evacuate exnodes -> |
| 278 | 264 |
Cluster.tryMGEvac gl nl il exnodes >>= formatEvacuate |
| 279 |
MultiReloc _ _ -> fail "multi-reloc not handled"
|
|
| 265 |
ChangeGroup _ _ -> fail "Request 'change-group' not implemented"
|
|
| 280 | 266 |
NodeEvacuate xi mode -> |
| 281 | 267 |
Cluster.tryNodeEvac gl nl il mode xi >>= formatNodeEvac |
| 282 | 268 |
|
Also available in: Unified diff