AllocatePort is used when adding instances. NoMonomorphismRestriction is needed to reuse the lenses defined locally using let.
Signed-off-by: BSRK Aditya <[email protected]> --- src/Ganeti/WConfd/ConfigModifications.hs | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/Ganeti/WConfd/ConfigModifications.hs b/src/Ganeti/WConfd/ConfigModifications.hs index 0141fe7..0a6d440 100644 --- a/src/Ganeti/WConfd/ConfigModifications.hs +++ b/src/Ganeti/WConfd/ConfigModifications.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-} {-| The WConfd functions for direct configuration manipulation @@ -39,6 +39,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.WConfd.ConfigModifications where +import Control.Lens.Getter ((^.)) import Control.Lens.Setter ((.~), (%~)) import Control.Lens.Traversal (mapMOf) import Control.Monad (unless, when, forM_) @@ -51,6 +52,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Ganeti.BasicTypes (GenericResult(..), genericResult, toError) +import Ganeti.Constants (lastDrbdPort) import Ganeti.Errors (GanetiException(..)) import Ganeti.JSON (Container, GenericContainer(..), alterContainerL , lookupContainer, MaybeForJSON(..)) @@ -59,7 +61,8 @@ import Ganeti.Logging.Lifted (logDebug, logInfo) import Ganeti.Objects import Ganeti.Objects.Lens import Ganeti.WConfd.ConfigState (ConfigState, csConfigData, csConfigDataL) -import Ganeti.WConfd.Monad (WConfdMonad, modifyConfigWithLock) +import Ganeti.WConfd.Monad (WConfdMonad, modifyConfigWithLock + , modifyConfigAndReturnWithLock) import qualified Ganeti.WConfd.TempRes as T type DiskUUID = String @@ -300,10 +303,29 @@ attachInstanceDisk iUuid dUuid idx = do (return ()) return $ isJust r +-- | Allocate a port. +-- The port will be taken from the available port pool or from the +-- default port range (and in this case we increase +-- highest_used_port). +allocatePort :: WConfdMonad Int +allocatePort = do + Just port <- modifyConfigAndReturnWithLock (\_ cs -> + let portPoolL = csConfigDataL . configClusterL . clusterTcpudpPortPoolL + hupL = csConfigDataL . configClusterL . clusterHighestUsedPortL + in case cs ^. portPoolL of + [] -> if cs ^. hupL >= lastDrbdPort + then toError . Bad . ConfigurationError $ printf + "The highest used port is greater than %s. Aborting." lastDrbdPort + else return (cs ^. hupL + 1, hupL %~ (+1) $ cs) + (p:ps) -> return (p, portPoolL .~ ps $ cs)) + (return ()) + return port + -- * The list of functions exported to RPC. exportedFunctions :: [Name] exportedFunctions = [ 'addInstance , 'addInstanceDisk + , 'allocatePort , 'attachInstanceDisk ] -- 1.7.10.4
