Revision 57f07ff2

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

  
b/htools/Ganeti/HTools/Loader.hs
34 34
    , lookupInstance
35 35
    , lookupGroup
36 36
    , commonSuffix
37
    , RelocMode(..)
38
    , EvacMode(..)
39 37
    , RqType(..)
40 38
    , Request(..)
41 39
    , ClusterData(..)
......
67 65

  
68 66
-- * Types
69 67

  
70
-- | The iallocator multi-evac group mode type.
71
data RelocMode = KeepGroup
72
               | ChangeGroup [Gdx]
73
               | AnyGroup
74
                 deriving (Show, Read)
75

  
76 68
{-| The iallocator request type.
77 69

  
78 70
This type denotes what request we got from Ganeti and also holds
......
84 76
    | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
85 77
                                     -- secondary node
86 78
    | Evacuate [Ndx]                 -- ^ Evacuate nodes
87
    | MultiReloc [Idx] RelocMode     -- ^ Multi-relocate mode
79
    | ChangeGroup [Gdx] [Idx]        -- ^ Multi-relocate mode
88 80
    | NodeEvacuate [Idx] EvacMode    -- ^ node-evacuate mode
89 81
    deriving (Show, Read)
90 82

  

Also available in: Unified diff