Hi!
On Tue, Oct 7, 2014 at 4:53 PM, 'Klaus Aehlig' via ganeti-devel <
ganeti-devel@googlegroups.com> wrote:
> Provide two functions getMigRestrictions and getRecvMigRestrictions.
> The first computes the migration restrictions, given the the cluster
> tags and the tags of a node. The second computes the set of restrictions
> a node is able to receive, again, given the cluster tags and the node
> tags. Migration is possible if the the migration restrictions of the
> source node are a subset of the set of restrictions the target node
> is able to receive. This is as described in the location awareness
> design document.
>
> Signed-off-by: Klaus Aehlig <aeh...@google.com>
> ---
> src/Ganeti/HTools/Tags.hs | 54
> ++++++++++++++++++++++++++++++++++++++++++++++-
> 1 file changed, 53 insertions(+), 1 deletion(-)
>
> diff --git a/src/Ganeti/HTools/Tags.hs b/src/Ganeti/HTools/Tags.hs
> index ae09bbc..abb090a 100644
> --- a/src/Ganeti/HTools/Tags.hs
> +++ b/src/Ganeti/HTools/Tags.hs
> @@ -43,9 +43,14 @@ module Ganeti.HTools.Tags
> , autoRepairTagPending
> , autoRepairTagResult
> , autoRepairTagSuspended
> + , getMigRestrictions
> + , getRecvMigRestrictions
> ) where
>
> -import Data.List (isPrefixOf)
> +import Control.Monad (guard, (>=>))
> +import Data.List (isPrefixOf, isInfixOf, stripPrefix)
> +import Data.Maybe (mapMaybe)
> +import qualified Data.Set as S
>
> import qualified Ganeti.HTools.Node as Node
>
> @@ -60,6 +65,14 @@ exTagsPrefix = "htools:iextags:"
> standbyPrefix :: String
> standbyPrefix = "htools:standby:"
>
> +-- | The prefix for migration tags
> +migrationPrefix :: String
> +migrationPrefix = "htools:migration:"
> +
> +-- | Prefix of tags allowing migration
> +allowMigrationPrefix :: String
> +allowMigrationPrefix = "htools:allowmigration:"
> +
> -- | The tag to be added to nodes that were shutdown by hsqueeze.
> standbyAuto :: String
> standbyAuto = "htools:standby:auto"
> @@ -86,3 +99,42 @@ autoRepairTagSuspended = autoRepairTagPrefix ++
> "suspend:"
> hasStandbyTag :: Node.Node -> Bool
> hasStandbyTag = any (standbyPrefix `isPrefixOf`) . Node.nTags
>
> +-- * Migration restriction tags
> +
> +-- | Given the cluster tags extract the migration restrictions
> +-- from a node tag, as a list.
> +getMigRestrictionsList :: [String] -> [String] -> [String]
> +getMigRestrictionsList ctags ntags =
> + mapMaybe (stripPrefix migrationPrefix) ctags >>= \ prefix ->
> + filter (prefix `isPrefixOf`) ntags
> +
> +-- | Given the cluster tags extract the migration restrictions
> +-- from a node tag.
> +getMigRestrictions :: [String] -> [String] -> S.Set String
> +getMigRestrictions ctags = S.fromList . getMigRestrictionsList ctags
> +
> +-- | Maybe split a string on the first single occurence of "::" return
> +-- the parts before and after.
> +splitAtColons :: String -> Maybe (String, String)
> +
> +splitAtColons (':':':':xs) = do
> + guard $ not ("::" `isInfixOf` xs)
> + return ("", xs)
> +
> +splitAtColons (x:xs) = do
> + (as, bs) <- splitAtColons xs
> + return (x:as, bs)
> +
> +splitAtColons _ = Nothing
> +
> +-- | Get the pairs of allowed migrations from a set of cluster tags.
> +migrations :: [String] -> [(String, String)]
> +migrations = mapMaybe $ stripPrefix allowMigrationPrefix >=> splitAtColons
> +
> +-- | Given the cluster tags, extract the set of migration restrictions
> +-- a node is able to receive from its node tags.
> +getRecvMigRestrictions :: [String] -> [String] -> S.Set String
> +getRecvMigRestrictions ctags ntags =
> + let migs = migrations ctags
> + closure tag = (:) tag . map fst $ filter ((==) tag . snd) migs
> + in S.fromList $ getMigRestrictionsList ctags ntags >>= closure
> --
> 2.1.0.rc2.206.gedb03e5
>
>
LGTM, thanks
--
Helga Velroyen | Software Engineer | hel...@google.com |
Google Germany GmbH
Dienerstr. 12
80331 München
Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschäftsführer: Graham Law, Christine Elizabeth Flores
