Commit c5daf4e6 authored by Petr Pudlak's avatar Petr Pudlak

New module for temporary reservation of config. resources

This patch adds the first step, the reservation of DRBD minors.
Signed-off-by: default avatarPetr Pudlak <>
Reviewed-by: default avatarKlaus Aehlig <>
parent 113b6056
......@@ -871,7 +871,8 @@ HS_LIB_SRCS = \
src/Ganeti/WConfd/Language.hs \
src/Ganeti/WConfd/Monad.hs \
src/Ganeti/WConfd/Server.hs \
src/Ganeti/WConfd/Ssconf.hs \
test/hs/Test/AutoConf.hs \
{-# LANGUAGE TemplateHaskell, RankNTypes, FlexibleContexts #-}
{-| Pure functions for manipulating reservations of temporary objects
Copyright (C) 2014 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
module Ganeti.WConfd.TempRes
( TempResState(..)
, emptyTempResState
, NodeUUID
, InstanceUUID
, DRBDMinor
, trsDRBDL
, computeDRBDMap
, computeDRBDMap'
, allocateDRBDMinor
, releaseDRBDMinors
) where
import Control.Lens.At
import Control.Monad.Error
import Control.Monad.State
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 Ganeti.BasicTypes
import Ganeti.Config
import Ganeti.Errors
import qualified Ganeti.JSON as J
import Ganeti.Lens
import Ganeti.Objects
import Ganeti.Utils
-- * The main reservation state
-- ** Aliases to make types more meaningful:
type NodeUUID = String
type InstanceUUID = String
type DRBDMinor = Int
-- | A map of the usage of DRBD minors
type DRBDMap = Map NodeUUID (Map DRBDMinor InstanceUUID)
-- | A map of the usage of DRBD minors with possible duplicates
type DRBDMap' = Map NodeUUID (Map DRBDMinor [InstanceUUID])
-- * The state data structure
-- | The state of the temporary reservations
data TempResState = TempResState
{ trsDRBD :: DRBDMap
deriving (Eq, Show)
emptyTempResState :: TempResState
emptyTempResState = TempResState M.empty
$(makeCustomLenses ''TempResState)
-- ** Utility functions
-- | Filter values from the nested map and remove any nested maps
-- that become empty.
filterNested :: (Ord a, Ord b)
=> (c -> Bool) -> Map a (Map b c) -> Map a (Map b c)
filterNested p = M.filter (not . M.null) . fmap (M.filter p)
-- * DRBDs
-- | Converts a lens that works on maybe values into a lens that works
-- on regular ones. A missing value on the input is replaced by
-- 'mempty'.
-- The output is is @Just something@ iff @something /= mempty@.
maybeLens :: (Monoid a, Monoid b, Eq b)
=> Lens s t (Maybe a) (Maybe b) -> Lens s t a b
maybeLens l f = l (fmap (mfilter (/= mempty) . Just) . f . fromMaybe mempty)
-- * DRBD functions
-- | Compute the map of used DRBD minor/nodes, including possible
-- duplicates.
-- An error is returned if the configuration isn't consistent
-- (for example if a referenced disk is missing etc.).
computeDRBDMap' :: (MonadError GanetiException m)
=> ConfigData -> TempResState -> m DRBDMap'
computeDRBDMap' cfg trs =
flip execStateT (fmap (fmap (: [])) (trsDRBD trs))
$ F.forM_ (configInstances cfg) addDisks
-- | Creates a lens for modifying the list of instances
nodeMinor :: NodeUUID -> DRBDMinor -> Lens' DRBDMap' [InstanceUUID]
nodeMinor node minor = maybeLens (at node) . maybeLens (at minor)
-- | Adds disks of an instance within the state monad
addDisks inst = do
disks <- toError $ getDrbdMinorsForInstance cfg inst
forM_ disks $ \(minor, node) -> nodeMinor node minor
%= (uuidOf inst :)
-- | Compute the map of used DRBD minor/nodes.
-- Report any duplicate entries as an error.
-- Unlike 'computeDRBDMap'', includes entries for all nodes, even if empty.
computeDRBDMap :: (MonadError GanetiException m)
=> ConfigData -> TempResState -> m DRBDMap
computeDRBDMap cfg trs = do
m <- computeDRBDMap' cfg trs
let dups = filterNested ((>= 2) . length) m
unless (M.null dups) . failError
$ "Duplicate DRBD ports detected: " ++ show (M.toList $ fmap M.toList dups)
return $ fmap (fmap head . M.filter ((== 1) . length)) m
`M.union` (fmap (const mempty) . J.fromContainer . configNodes $ cfg)
-- Allocate a drbd minor.
-- The free minor will be automatically computed from the existing devices.
-- A node can be given multiple times in order to allocate multiple minors.
-- The result is the list of minors, in the same order as the passed nodes.
allocateDRBDMinor :: (MonadError GanetiException m, MonadState TempResState m)
=> ConfigData -> InstanceUUID -> [NodeUUID]
-> m [DRBDMinor]
allocateDRBDMinor cfg inst nodes = do
dMap <- computeDRBDMap' cfg =<< get
let usedMap = fmap M.keysSet dMap
let alloc :: S.Set DRBDMinor -> Map DRBDMinor InstanceUUID
-> (DRBDMinor, Map DRBDMinor InstanceUUID)
alloc used m = let k = findFirst 0 (M.keysSet m `S.union` used)
in (k, M.insert k inst m)
forM nodes $ \node -> trsDRBDL . maybeLens (at node)
%%= alloc (M.findWithDefault mempty node usedMap)
-- Release temporary drbd minors allocated for a given instance using
-- 'allocateDRBDMinor'.
releaseDRBDMinors :: (MonadState TempResState m) => InstanceUUID -> m ()
releaseDRBDMinors inst = trsDRBDL %= filterNested (/= inst)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment