On Tue, May 05, 2015 at 01:45:15PM +0200, 'BSRK Aditya' via ganeti-devel wrote:
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 | 29 +++++++++++++++++++++++++++--
1 file changed, 27 insertions(+), 2 deletions(-)
diff --git a/src/Ganeti/WConfd/ConfigModifications.hs
b/src/Ganeti/WConfd/ConfigModifications.hs
index 0141fe7..877febb 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,32 @@ 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
+ maybePort <- 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
Just a minor thing: `toError . Bad` is better expressed as `throwError`,
without going through `GenericResult` unnecessarily.
+ "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 ())
+ case maybePort of
+ Nothing -> toError . Bad . ConfigurationError $
ditto
+ "Failed to modify configuration"
+ Just port -> return port
+
-- * The list of functions exported to RPC.
exportedFunctions :: [Name]
exportedFunctions = [ 'addInstance
, 'addInstanceDisk
+ , 'allocatePort
, 'attachInstanceDisk
]
--
2.2.0.rc0.207.ga3a616c