Synnefo » snf-ganeti

    , EvacSolution(..)

    , tryNodeEvac

-- | Node evacuation/group change iallocator result type. This result

-- type consists of actual opcodes (a restricted subset) that are

-- transmitted back to Ganeti.

data EvacSolution = EvacSolution

    { esMoved   :: [String]             -- ^ Instance moved successfully

    , esFailed  :: [String]             -- ^ Instance which were not

                                        -- relocated

    , esOpCodes :: [[[OpCodes.OpCode]]] -- ^ List of lists of jobs

    }

-- | The empty evac solution.

emptyEvacSolution :: EvacSolution

emptyEvacSolution = EvacSolution { esMoved = []

                                 , esFailed = []

                                 , esOpCodes = []

                                 }

-- | Reverses an evacuation solution.

--

-- Rationale: we always concat the results to the top of the lists, so

-- for proper jobset execution, we should reverse all lists.

reverseEvacSolution :: EvacSolution -> EvacSolution

reverseEvacSolution (EvacSolution f m o) =

    EvacSolution (reverse f) (reverse m) (reverse o)

-- | Function which fails if the requested mode is change secondary.

--

-- This is useful since except DRBD, no other disk template can

-- execute change secondary; thus, we can just call this function

-- instead of always checking for secondary mode. After the call to

-- this function, whatever mode we have is just a primary change.

failOnSecondaryChange :: (Monad m) => EvacMode -> DiskTemplate -> m ()

failOnSecondaryChange ChangeSecondary dt =

    fail $ "Instances with disk template '" ++ dtToString dt ++

         "' can't execute change secondary"

failOnSecondaryChange _ _ = return ()

-- | Run evacuation for a single instance.

nodeEvacInstance :: Node.List         -- ^ The node list (cluster-wide)

                 -> Instance.List     -- ^ Instance list (cluster-wide)

                 -> EvacMode          -- ^ The evacuation mode

                 -> Instance.Instance -- ^ The instance to be evacuated

                 -> [Ndx]             -- ^ The list of available nodes

                                      -- for allocation

                 -> Result (Node.List, Instance.List, [OpCodes.OpCode])

nodeEvacInstance _ _ mode (Instance.Instance

                           {Instance.diskTemplate = dt@DTDiskless}) _ =

                  failOnSecondaryChange mode dt >>

                  fail "Diskless relocations not implemented yet"

nodeEvacInstance _ _ _ (Instance.Instance

                        {Instance.diskTemplate = DTPlain}) _ =

                  fail "Instances of type plain cannot be relocated"

nodeEvacInstance _ _ _ (Instance.Instance

                        {Instance.diskTemplate = DTFile}) _ =

                  fail "Instances of type file cannot be relocated"

nodeEvacInstance _ _ mode  (Instance.Instance

                            {Instance.diskTemplate = dt@DTSharedFile}) _ =

                  failOnSecondaryChange mode dt >>

                  fail "Shared file relocations not implemented yet"

nodeEvacInstance _ _ mode (Instance.Instance

                           {Instance.diskTemplate = dt@DTBlock}) _ =

                  failOnSecondaryChange mode dt >>

                  fail "Block device relocations not implemented yet"

nodeEvacInstance _ _ _ (Instance.Instance

                        {Instance.diskTemplate = DTDrbd8}) _ =

                  fail "DRBD relocations not implemented yet"

-- | Computes the local nodes of a given instance which are available

-- for allocation.

availableLocalNodes :: Node.List

                    -> [(Gdx, [Ndx])]

                    -> IntSet.IntSet

                    -> Instance.Instance

                    -> Result [Ndx]

availableLocalNodes nl group_nodes excl_ndx inst = do

  let gdx = instancePriGroup nl inst

  local_nodes <- maybe (Bad $ "Can't find group with index " ++ show gdx)

                 Ok (lookup gdx group_nodes)

  let avail_nodes = filter (not . flip IntSet.member excl_ndx) local_nodes

  return avail_nodes

-- | Updates the evac solution with the results of an instance

-- evacuation.

updateEvacSolution :: (Node.List, Instance.List, EvacSolution)

                   -> Instance.Instance

                   -> Result (Node.List, Instance.List, [OpCodes.OpCode])

                   -> (Node.List, Instance.List, EvacSolution)

updateEvacSolution (nl, il, es) inst (Bad msg) =

    (nl, il, es { esFailed = (Instance.name inst ++ ": " ++ msg):esFailed es})

updateEvacSolution (_, _, es) inst (Ok (nl, il, opcodes)) =

    (nl, il, es { esMoved = Instance.name inst:esMoved es

                , esOpCodes = [opcodes]:esOpCodes es })

-- | Node-evacuation IAllocator mode main function.

tryNodeEvac :: Group.List    -- ^ The cluster groups

            -> Node.List     -- ^ The node list (cluster-wide, not per group)

            -> Instance.List -- ^ Instance list (cluster-wide)

            -> EvacMode      -- ^ The evacuation mode

            -> [Idx]         -- ^ List of instance (indices) to be evacuated

            -> Result EvacSolution

tryNodeEvac _ ini_nl ini_il mode idxs =

    let evac_ndx = nodesToEvacuate ini_il mode idxs

        offline = map Node.idx . filter Node.offline $ Container.elems ini_nl

        excl_ndx = foldl' (flip IntSet.insert) evac_ndx offline

        group_ndx = map (\(gdx, (nl, _)) -> (gdx, map Node.idx

                                             (Container.elems nl))) $

                      splitCluster ini_nl ini_il

        (_, _, esol) =

            foldl' (\state@(nl, il, _) inst ->

                        updateEvacSolution state inst $

                        availableLocalNodes nl group_ndx excl_ndx inst >>=

                        nodeEvacInstance nl il mode inst

                   )

            (ini_nl, ini_il, emptyEvacSolution)

            (map (`Container.find` ini_il) idxs)

    in return $ reverseEvacSolution esol

-- | Convert a node-evacuation/change group result.

formatNodeEvac :: Cluster.EvacSolution -> Result IAllocResult

formatNodeEvac es =

    let fes = Cluster.esFailed es

        mes = Cluster.esMoved es

        failed = length fes

        moved  = length mes

        info = show failed ++ " instances failed to move and " ++ show moved ++

               " were moved successfully"

    in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es))

       NodeEvacuate xi mode ->

           Cluster.tryNodeEvac gl nl il mode xi >>= formatNodeEvac