[Pkg-ganeti-devel] [ganeti] 32/165: Add a function finding a dedicated allocation on one group

[Apollon Oikonomopoulos]

This is an automated email from the git hooks/post-receive script.

apoikos pushed a commit to branch master
in repository ganeti.

commit cb16544cd34637b98db143d383ab00fb098f468f
Author: Klaus Aehlig <aehlig at google.com>
Date:   Mon Jan 26 18:10:17 2015 +0100

    Add a function finding a dedicated allocation on one group
    
    Add a function that finds the correct allocation in a single
    group in a dedicated context. In particular, it uses the
    lost-allocations metric.
    
    Signed-off-by: Klaus Aehlig <aehlig at google.com>
    Reviewed-by: Petr Pudlak <pudlak at google.com>
---
 src/Ganeti/HTools/Dedicated.hs | 40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/src/Ganeti/HTools/Dedicated.hs b/src/Ganeti/HTools/Dedicated.hs
index 7503bf8..fbc1209 100644
--- a/src/Ganeti/HTools/Dedicated.hs
+++ b/src/Ganeti/HTools/Dedicated.hs
@@ -40,17 +40,20 @@ module Ganeti.HTools.Dedicated
   , lostAllocationsMetric
   , allocateOnSingle
   , allocateOnPair
+  , findAllocation
   ) where
 
 import Control.Applicative (liftA2)
+import Control.Monad (unless)
 import qualified Data.Foldable as F
 import Data.Function (on)
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import Data.List (sortBy)
 
-import Ganeti.BasicTypes (iterateOk)
+import Ganeti.BasicTypes (iterateOk, Result, failError)
 import qualified Ganeti.HTools.AlgorithmParams as Alg
+import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Instance as Instance
@@ -159,3 +162,38 @@ allocateOnPair opts nl inst pdx sdx = do
       metric = (zipWith (+) lAllP lAllS, dskP + dskS)
       nl' = Container.addTwo pdx primary' sdx secondary' nl
   return (nl', inst', [primary', secondary'], metric)
+
+-- | Find an allocation for an instance on a group.
+findAllocation :: Alg.AlgorithmOptions
+               -> Group.List
+               -> Node.List
+               -> T.Gdx
+               -> Instance.Instance
+               -> Int
+               -> Result (Cluster.GenericAllocSolution Metric, [String])
+findAllocation opts mggl mgnl gdx inst count = do
+  let nl = Container.filter ((== gdx) . Node.group) mgnl
+      group = Container.find gdx mggl
+  unless (Cluster.hasRequiredNetworks group inst) . failError
+         $ "The group " ++ Group.name group ++ " is not connected to\
+           \ a network required by instance " ++ Instance.name inst
+  allocNodes <- Cluster.genAllocNodes mggl nl count False
+  solution <- case allocNodes of
+    (Right []) -> fail "Not enough online nodes"
+    (Right pairs) ->
+      let sols = foldl Cluster.sumAllocs Cluster.emptyAllocSolution
+                   $ map (\(p, ss) -> foldl
+                           (\cstate ->
+                             Cluster.concatAllocs cstate
+                             . allocateOnPair opts nl inst p)
+                           Cluster.emptyAllocSolution ss)
+                     pairs
+       in return $ Cluster.genericAnnotateSolution show sols
+    (Left []) -> fail "No online nodes"
+    (Left nodes) ->
+      let sols = foldl (\cstate ->
+                          Cluster.concatAllocs cstate
+                          . allocateOnSingle opts nl inst)
+                       Cluster.emptyAllocSolution nodes
+      in return $ Cluster.genericAnnotateSolution show sols
+  return (solution, Cluster.solutionDescription (group, return solution))

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ganeti/ganeti.git