Make hail parse and handle requests to allocate a secondary node for
an instance to be converted to DRBD.

Signed-off-by: Klaus Aehlig <[email protected]>
---
 src/Ganeti/HTools/Backend/IAlloc.hs | 23 +++++++++++++++++++++++
 src/Ganeti/HTools/Loader.hs         |  3 +++
 2 files changed, 26 insertions(+)

diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs 
b/src/Ganeti/HTools/Backend/IAlloc.hs
index ac83a7f..d704950 100644
--- a/src/Ganeti/HTools/Backend/IAlloc.hs
+++ b/src/Ganeti/HTools/Backend/IAlloc.hs
@@ -53,6 +53,7 @@ import Text.JSON (JSObject, JSValue(JSArray),
 import Ganeti.BasicTypes
 import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Cluster.AllocationSolution as AllocSol
+import qualified Ganeti.HTools.Cluster.AllocateSecondary as AllocSecondary
 import qualified Ganeti.HTools.Cluster.Evacuate as Evacuate
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Group as Group
@@ -275,6 +276,11 @@ parseData now body = do
                                  return (io, Cluster.AllocDetails
                                                req_nodes rgn))
               return $ MultiAllocate prqs
+        | optype == C.iallocatorModeAllocateSecondary ->
+            do
+              rname <- extrReq "name"
+              ridx  <- lookupInstance kti rname
+              return $ AllocateSecondary ridx
         | otherwise -> fail ("Invalid request type '" ++ optype ++ "'")
   return (msgs, Request rqtype cdata)
 
@@ -306,6 +312,20 @@ formatAllocate il as = do
         let il' = Container.add (Instance.idx inst) inst il
         return (info, showJSON $ map Node.name nodes, nl, il')
 
+-- | Convert allocation/relocation results into the result format.
+formatAllocateSecondary :: Instance.List
+                        -> AllocSol.GenericAllocSolution a
+                        -> Result IAllocResult
+formatAllocateSecondary il as = do
+  let info = describeSolution as
+  case AllocSol.asSolution as of
+    Nothing -> fail info
+    Just (nl, inst, [_, snode], _) ->
+      do
+        let il' = Container.add (Instance.idx inst) inst il
+        return (info, showJSON $ Node.name snode, nl, il')
+    _ -> fail $ "Internal error (not a DRBD allocation); info was: " ++ info
+
 -- | Convert multi allocation results into the result format.
 formatMultiAlloc :: ( Node.List, Instance.List
                     , Cluster.GenericAllocSolutionList a)
@@ -445,6 +465,9 @@ processRequest opts request =
                 formatNodeEvac gl nl il
        MultiAllocate xies ->
          Cluster.allocList opts gl nl il xies [] >>= formatMultiAlloc
+       AllocateSecondary xi ->
+         AllocSecondary.tryAllocateSecondary opts gl nl il xi
+           >>= formatAllocateSecondary il
 
 -- | Reads the request from the data file(s).
 readRequest :: FilePath -> IO Request
diff --git a/src/Ganeti/HTools/Loader.hs b/src/Ganeti/HTools/Loader.hs
index 5162ada..35f3e9f 100644
--- a/src/Ganeti/HTools/Loader.hs
+++ b/src/Ganeti/HTools/Loader.hs
@@ -87,6 +87,9 @@ request-specific fields.
 data RqType
   = Allocate Instance.Instance Cluster.AllocDetails (Maybe [String])
     -- ^ A new instance allocation, maybe with allocation restrictions
+  | AllocateSecondary Idx                             -- ^ Find a suitable
+                                                      -- secondary node for 
disk
+                                                      -- conversion
   | Relocate Idx Int [Ndx]                            -- ^ Choose a new
                                                       --   secondary node
   | NodeEvacuate [Idx] EvacMode                       -- ^ node-evacuate mode
-- 
2.2.0.rc0.207.ga3a616c

Reply via email to