For this, add an internal Tempres data structure that implements functionality similar to the one in config.py.
Signed-off-by: Petr Pudlak <[email protected]> --- src/Ganeti/WConfd/TempRes.hs | 129 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 128 insertions(+), 1 deletion(-) diff --git a/src/Ganeti/WConfd/TempRes.hs b/src/Ganeti/WConfd/TempRes.hs index a6844a7..bb0abd4 100644 --- a/src/Ganeti/WConfd/TempRes.hs +++ b/src/Ganeti/WConfd/TempRes.hs @@ -30,6 +30,7 @@ module Ganeti.WConfd.TempRes , emptyTempResState , NodeUUID , InstanceUUID + , NetworkUUID , DRBDMinor , DRBDMap , trsDRBDL @@ -37,25 +38,41 @@ module Ganeti.WConfd.TempRes , computeDRBDMap' , allocateDRBDMinor , releaseDRBDMinors + , MAC + , generateMAC + , reserveMAC + , dropAllReservations + , isReserved + , reserve + , dropReservationsFor + , reserved + , generate ) where +import Control.Applicative import Control.Lens.At import Control.Monad.Error import Control.Monad.State +import Control.Monad.Trans.Maybe import qualified Data.Foldable as F import Data.Maybe import Data.Map (Map) import qualified Data.Map as M import Data.Monoid import qualified Data.Set as S +import System.Random +import Text.Printf import Ganeti.BasicTypes import Ganeti.Config import Ganeti.Errors import qualified Ganeti.JSON as J import Ganeti.Lens +import Ganeti.Locking.Locks (ClientId) import Ganeti.Objects import Ganeti.Utils +import Ganeti.Utils.MonadPlus +import qualified Ganeti.Utils.MultiMap as MM -- * The main reservation state @@ -65,8 +82,12 @@ type NodeUUID = String type InstanceUUID = String +type NetworkUUID = String + type DRBDMinor = Int +-- type UUID = String + -- | A map of the usage of DRBD minors type DRBDMap = Map NodeUUID (Map DRBDMinor InstanceUUID) @@ -75,14 +96,24 @@ type DRBDMap' = Map NodeUUID (Map DRBDMinor [InstanceUUID]) -- * The state data structure +-- | A polymorphic data structure for managing temporary resources assigned +-- to jobs. +newtype TempRes j a = TempRes { getTempRes :: MM.MultiMap j a } + deriving (Eq, Ord, Show) + +instance (Ord j, Ord a) => Monoid (TempRes j a) where + mempty = TempRes mempty + mappend (TempRes x) (TempRes y) = TempRes $ x <> y + -- | The state of the temporary reservations data TempResState = TempResState { trsDRBD :: DRBDMap + , trsMACs :: TempRes ClientId MAC } deriving (Eq, Show) emptyTempResState :: TempResState -emptyTempResState = TempResState M.empty +emptyTempResState = TempResState M.empty mempty $(makeCustomLenses ''TempResState) @@ -161,3 +192,99 @@ allocateDRBDMinor cfg inst nodes = do -- 'allocateDRBDMinor'. releaseDRBDMinors :: (MonadState TempResState m) => InstanceUUID -> m () releaseDRBDMinors inst = trsDRBDL %= filterNested (/= inst) + +-- * Other temporary resources + +-- | Tests if a given value is reserved for a given job. +isReserved :: (Ord a, Ord j) => a -> TempRes j a -> Bool +isReserved x = MM.elem x . getTempRes + +-- | Tries to reserve a given value for a given job. +reserve :: (MonadError e m, Error e, Show a, Ord a, Ord j) + => j -> a -> TempRes j a -> m (TempRes j a) +reserve jobid x tr = do + when (isReserved x tr) . failError $ "Duplicate reservation for resource '" + ++ show x ++ "'" + return . TempRes . MM.insert jobid x $ getTempRes tr + +dropReservationsFor :: (Ord a, Ord j) => j -> TempRes j a -> TempRes j a +dropReservationsFor jobid = TempRes . MM.deleteAll jobid . getTempRes + +reserved :: (Ord a, Ord j) => TempRes j a -> S.Set a +reserved = MM.values . getTempRes + +generate :: (MonadError e m, Error e, Show a, Ord a, Ord j) + => j -> S.Set a -> m (Maybe a) -> TempRes j a -> m (a, TempRes j a) +generate jobid existing genfn tr = do + let retries = 64 + let vals = reserved tr `S.union` existing + xOpt <- retryMaybeN retries + (\_ -> mfilter (`S.notMember` vals) (MaybeT genfn)) + case xOpt of + Nothing -> failError "Not able generate new resource" + -- TODO: (last tried: " ++ %s)" % new_resource + Just x -> (,) x `liftM` reserve jobid x tr + +-- | A variant of 'generate' for randomized computations. +generateRand :: (MonadError e m, Error e, Show a, Ord a, Ord j, RandomGen g) + => g -> j -> S.Set a -> (g -> (Maybe a, g)) -> TempRes j a + -> m (a, TempRes j a) +generateRand rgen jobid existing genfn tr = + evalStateT (generate jobid existing (state genfn) tr) rgen + +-- ** Functions common to all reservations + +-- | Removes all resources reserved by a given job. +-- +-- If a new reservation resource type is added, it must be added here as well. +dropAllReservations :: ClientId -> TempResState -> TempResState +dropAllReservations jobId = trsMACsL %~ dropReservationsFor jobId + +-- ** IDs + +-- ** MAC addresses + +-- | Given a prefix, randomly generates a full MAC address. +-- +-- See 'generateMAC' for discussion about how this function uses +-- the random generator. +generateOneMAC :: (RandomGen g) => MAC -> g -> (MAC, g) +generateOneMAC prefix = runState $ + let randByte = state (randomR (0, 255 :: Int)) + in printf "%s:%02x:%02x:%02x" prefix <$> randByte <*> randByte <*> randByte + +-- Randomly generate a MAC for an instance. +-- Checks that the generated MAC isn't used by another instance. +-- +-- Note that we only consume, but not return the state of a random number +-- generator. This is because the whole operation needs to be pure (for atomic +-- 'IORef' updates) and therefore we can't use 'getStdRandom'. Therefore the +-- approach we take is to instead use 'newStdGen' and discard the split +-- generator afterwards. +generateMAC + :: (RandomGen g, MonadError e m, Error e, Functor m) + => g -> ClientId -> Maybe NetworkUUID -> ConfigData + -> StateT TempResState m MAC +generateMAC rgen jobId netId cd = do + net <- case netId of + Just n -> Just <$> J.lookupContainer (failError $ "Network '" ++ show netId + ++ "' not found") + n (configNetworks cd) + Nothing -> return Nothing + let prefix = fromMaybe (clusterMacPrefix . configCluster $ cd) + (networkMacPrefix =<< net) + let existing = S.fromList $ getAllMACs cd + StateT + $ traverseOf2 trsMACsL + (generateRand rgen jobId existing + (over _1 Just . generateOneMAC prefix)) + +-- Reserves a MAC for an instance in the list of temporary reservations. +reserveMAC + :: (MonadError GanetiException m, MonadState TempResState m, Functor m) + => ClientId -> MAC -> ConfigData -> m () +reserveMAC jobId mac cd = do + let existing = S.fromList $ getAllMACs cd + when (S.member mac existing) + $ throwError (ReservationError "MAC already in use") + get >>= traverseOf trsMACsL (reserve jobId mac) >>= put -- 1.9.1.423.g4596e3a
