Revision fbe5fcf6 htools/Ganeti/HTools/IAlloc.hs
b/htools/Ganeti/HTools/IAlloc.hs | ||
---|---|---|
152 | 152 |
let idata = fromJSObject ilist |
153 | 153 |
iobj <- mapM (\(x,y) -> |
154 | 154 |
asJSObject y >>= parseInstance ktn x . fromJSObject) idata |
155 |
let (kti, il) = assignIndices iobj
|
|
155 |
let (_, il) = assignIndices iobj
|
|
156 | 156 |
-- cluster tags |
157 | 157 |
ctags <- extrObj "cluster_tags" |
158 | 158 |
cdata1 <- mergeData [] [] [] [] (ClusterData gl nl il ctags) |
159 | 159 |
let (msgs, fix_nl) = checkData (cdNodes cdata1) (cdInstances cdata1) |
160 | 160 |
cdata = cdata1 { cdNodes = fix_nl } |
161 |
map_n = cdNodes cdata |
|
162 | 161 |
map_i = cdInstances cdata |
163 | 162 |
map_g = cdGroups cdata |
164 | 163 |
optype <- extrReq "type" |
... | ... | |
171 | 170 |
inew <- parseBaseInstance rname request |
172 | 171 |
let io = snd inew |
173 | 172 |
return $ Allocate io req_nodes |
174 |
| optype == C.iallocatorModeReloc -> |
|
175 |
do |
|
176 |
rname <- extrReq "name" |
|
177 |
ridx <- lookupInstance kti rname |
|
178 |
req_nodes <- extrReq "required_nodes" |
|
179 |
ex_nodes <- extrReq "relocate_from" |
|
180 |
ex_idex <- mapM (Container.findByName map_n) ex_nodes |
|
181 |
return $ Relocate ridx req_nodes (map Node.idx ex_idex) |
|
182 |
| optype == C.iallocatorModeMevac -> |
|
183 |
do |
|
184 |
ex_names <- extrReq "evac_nodes" |
|
185 |
ex_nodes <- mapM (Container.findByName map_n) ex_names |
|
186 |
let ex_ndx = map Node.idx ex_nodes |
|
187 |
return $ Evacuate ex_ndx |
|
188 | 173 |
| optype == C.iallocatorModeChgGroup -> |
189 | 174 |
do |
190 | 175 |
rl_names <- extrReq "instances" |
... | ... | |
227 | 212 |
describeSolution :: Cluster.AllocSolution -> String |
228 | 213 |
describeSolution = intercalate ", " . Cluster.asLog |
229 | 214 |
|
230 |
-- | Convert evacuation results into the result format. |
|
231 |
formatEvacuate :: Instance.List -> Cluster.AllocSolution -> Result IAllocResult |
|
232 |
formatEvacuate il as = do |
|
233 |
let info = describeSolution as |
|
234 |
elems = Cluster.asSolutions as |
|
235 |
when (null elems) $ fail info |
|
236 |
let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl) |
|
237 |
elems |
|
238 |
-- FIXME: head elems is certainly not correct here, since we |
|
239 |
-- don't always concat the elems and lists in the same order; |
|
240 |
-- however, as the old evacuate mode is deprecated, we can leave |
|
241 |
-- it like this for the moment |
|
242 |
(head_nl, _, _, _) = head elems |
|
243 |
il' = foldl' (\ilist (_, inst, _, _) -> |
|
244 |
Container.add (Instance.idx inst) inst ilist) |
|
245 |
il elems |
|
246 |
return (info, showJSON sols, head_nl, il') |
|
247 |
|
|
248 | 215 |
-- | Convert allocation/relocation results into the result format. |
249 | 216 |
formatAllocate :: Instance.List -> Cluster.AllocSolution -> Result IAllocResult |
250 | 217 |
formatAllocate il as = do |
... | ... | |
283 | 250 |
in case rqtype of |
284 | 251 |
Allocate xi reqn -> |
285 | 252 |
Cluster.tryMGAlloc gl nl il xi reqn >>= formatAllocate il |
286 |
Relocate idx reqn exnodes -> |
|
287 |
Cluster.tryMGReloc gl nl il idx reqn exnodes >>= formatAllocate il |
|
288 |
Evacuate exnodes -> |
|
289 |
Cluster.tryMGEvac gl nl il exnodes >>= formatEvacuate il |
|
290 | 253 |
ChangeGroup gdxs idxs -> |
291 | 254 |
Cluster.tryChangeGroup gl nl il idxs gdxs >>= |
292 | 255 |
formatNodeEvac gl nl il |
Also available in: Unified diff