On Mon, May 30, 2011 at 3:30 PM, Iustin Pop <[email protected]> wrote:
> This is not handled yet, this patch just adds parsing of the incoming
> request.
> ---
> htools/Ganeti/HTools/IAlloc.hs | 26 ++++++++++++++++++++++++++
> 1 files changed, 26 insertions(+), 0 deletions(-)
>
> diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
> index 741a370..091db9d 100644
> --- a/htools/Ganeti/HTools/IAlloc.hs
> +++ b/htools/Ganeti/HTools/IAlloc.hs
> @@ -114,6 +114,13 @@ parseGroup u a = do
> apol <- extract "alloc_policy"
> return (u, Group.create name u apol)
>
> +parseTargetGroups :: [(String, JSValue)] -- ^ The JSON object
The JSON object containing what? The group list?
> + -> Group.List -- ^ The existing groups
> + -> Result [Gdx]
> +parseTargetGroups req map_g = do
> + group_uuids <- fromObjWithDefault req "target_groups" []
> + mapM (liftM Group.idx . Container.findByName map_g) group_uuids
> +
> -- | Top-level parser.
> parseData :: String -- ^ The JSON message as received from Ganeti
> -> Result Request -- ^ A (possible valid) request
> @@ -143,6 +150,8 @@ parseData body = do
> ctags <- extrObj "cluster_tags"
> cdata <- mergeData [] [] [] (ClusterData gl nl il ctags)
> let map_n = cdNodes cdata
> + map_i = cdInstances cdata
> + map_g = cdGroups cdata
> optype <- extrReq "type"
> rqtype <-
> case () of
> @@ -167,6 +176,23 @@ parseData body = do
> ex_nodes <- mapM (Container.findByName map_n) ex_names
> let ex_ndx = map Node.idx ex_nodes
> return $ Evacuate ex_ndx
> + | optype == C.iallocatorModeMreloc ->
> + do
> + rl_names <- extrReq "instances"
> + rl_insts <- mapM (Container.findByName map_i) rl_names
> + let rl_idx = map Instance.idx rl_insts
> + rl_mode <- do
> + case extrReq "reloc_mode" of
> + Ok s | s == C.iallocatorMrelocKeep -> return KeepGroup
> + | s == C.iallocatorMrelocChange ->
> + do
> + tg_groups <- parseTargetGroups request map_g
> + return $ ChangeGroup tg_groups
> + | s == C.iallocatorMrelocAny -> return AnyGroup
> + | otherwise -> Bad $ "Invalid relocate mode " ++ s
> + Bad x -> Bad x
> + return $ MultiReloc rl_idx rl_mode
> +
> | otherwise -> fail ("Invalid request type '" ++ optype ++ "'")
> return $ Request rqtype cdata
>
> --
> 1.7.3.1
>
>
--
Guido Trotter
Google - Corporate Computing Services SRE
Google Ireland Ltd. : Registered in Ireland with company number 368047.
Gordon House, Barrow Street, Dublin 4, Ireland.
