Add a server-side Luxi implementation
[ganeti-local] / htools / Ganeti / HTools / Cluster.hs
index 0b1617a..9500aea 100644 (file)
@@ -395,6 +395,17 @@ applyMove nl inst Failover =
                 new_inst, old_sdx, old_pdx)
   in new_nl
 
+-- Failover to any (fa)
+applyMove nl inst (FailoverToAny new_pdx) = do
+  let (old_pdx, old_sdx, old_pnode, _) = instanceNodes nl inst
+      new_pnode = Container.find new_pdx nl
+      force_failover = Node.offline old_pnode
+  new_pnode' <- Node.addPriEx force_failover new_pnode inst
+  let old_pnode' = Node.removePri old_pnode inst
+      inst' = Instance.setPri inst new_pdx
+      nl' = Container.addTwo old_pdx old_pnode' new_pdx new_pnode' nl
+  return (nl', inst', new_pdx, old_sdx)
+
 -- Replace the primary (f:, r:np, f)
 applyMove nl inst (ReplacePrimary new_pdx) =
   let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
@@ -520,7 +531,10 @@ possibleMoves :: MirrorType -- ^ The mirroring type of the instance
 
 possibleMoves MirrorNone _ _ _ = []
 
-possibleMoves MirrorExternal _ _ _ = []
+possibleMoves MirrorExternal _ False _ = []
+
+possibleMoves MirrorExternal _ True tdx =
+  [ FailoverToAny tdx ]
 
 possibleMoves MirrorInternal _ False tdx =
   [ ReplaceSecondary tdx ]
@@ -549,7 +563,7 @@ checkInstanceMove nodes_idx disk_moves inst_moves ini_tbl target =
       osdx = Instance.sNode target
       bad_nodes = [opdx, osdx]
       nodes = filter (`notElem` bad_nodes) nodes_idx
-      mir_type = templateMirrorType $ Instance.diskTemplate target
+      mir_type = Instance.mirrorType target
       use_secondary = elem osdx nodes_idx && inst_moves
       aft_failover = if mir_type == MirrorInternal && use_secondary
                        -- if drbd and allowed to failover
@@ -856,10 +870,11 @@ nodeEvacInstance :: Node.List         -- ^ The node list (cluster-wide)
                  -> [Ndx]             -- ^ The list of available nodes
                                       -- for allocation
                  -> Result (Node.List, Instance.List, [OpCodes.OpCode])
-nodeEvacInstance _ _ mode (Instance.Instance
-                           {Instance.diskTemplate = dt@DTDiskless}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Diskless relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTDiskless})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
 nodeEvacInstance _ _ _ (Instance.Instance
                         {Instance.diskTemplate = DTPlain}) _ _ =
@@ -869,20 +884,23 @@ nodeEvacInstance _ _ _ (Instance.Instance
                         {Instance.diskTemplate = DTFile}) _ _ =
                   fail "Instances of type file cannot be relocated"
 
-nodeEvacInstance _ _ mode  (Instance.Instance
-                            {Instance.diskTemplate = dt@DTSharedFile}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Shared file relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTSharedFile})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
-nodeEvacInstance _ _ mode (Instance.Instance
-                           {Instance.diskTemplate = dt@DTBlock}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Block device relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTBlock})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
-nodeEvacInstance _ _ mode  (Instance.Instance
-                            {Instance.diskTemplate = dt@DTRbd}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Rbd relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTRbd})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
 nodeEvacInstance nl il ChangePrimary
                  inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
@@ -897,16 +915,7 @@ nodeEvacInstance nl il ChangePrimary
 nodeEvacInstance nl il ChangeSecondary
                  inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
                  gdx avail_nodes =
-  do
-    let op_fn = ReplaceSecondary
-    (nl', inst', _, ndx) <- annotateResult "Can't find any good node" $
-                            eitherToResult $
-                            foldl' (evacDrbdSecondaryInner nl inst gdx op_fn)
-                            (Left "no nodes available") avail_nodes
-    let idx = Instance.idx inst
-        il' = Container.add idx inst' il
-        ops = iMoveToJob nl' il' idx (op_fn ndx)
-    return (nl', il', ops)
+  evacOneNodeOnly nl il inst gdx avail_nodes
 
 -- The algorithm for ChangeAll is as follows:
 --
@@ -947,27 +956,56 @@ nodeEvacInstance nl il ChangeAll
 
     return (nl', il', ops)
 
--- | Inner fold function for changing secondary of a DRBD instance.
+-- | Generic function for changing one node of an instance.
+--
+-- This is similar to 'nodeEvacInstance' but will be used in a few of
+-- its sub-patterns. It folds the inner function 'evacOneNodeInner'
+-- over the list of available nodes, which results in the best choice
+-- for relocation.
+evacOneNodeOnly :: Node.List         -- ^ The node list (cluster-wide)
+                -> Instance.List     -- ^ Instance list (cluster-wide)
+                -> Instance.Instance -- ^ The instance to be evacuated
+                -> Gdx               -- ^ The group we're targetting
+                -> [Ndx]             -- ^ The list of available nodes
+                                      -- for allocation
+                -> Result (Node.List, Instance.List, [OpCodes.OpCode])
+evacOneNodeOnly nl il inst gdx avail_nodes = do
+  op_fn <- case Instance.mirrorType inst of
+             MirrorNone -> Bad "Can't relocate/evacuate non-mirrored instances"
+             MirrorInternal -> Ok ReplaceSecondary
+             MirrorExternal -> Ok FailoverToAny
+  (nl', inst', _, ndx) <- annotateResult "Can't find any good node" $
+                          eitherToResult $
+                          foldl' (evacOneNodeInner nl inst gdx op_fn)
+                          (Left "no nodes available") avail_nodes
+  let idx = Instance.idx inst
+      il' = Container.add idx inst' il
+      ops = iMoveToJob nl' il' idx (op_fn ndx)
+  return (nl', il', ops)
+
+-- | Inner fold function for changing one node of an instance.
+--
+-- Depending on the instance disk template, this will either change
+-- the secondary (for DRBD) or the primary node (for shared
+-- storage). However, the operation is generic otherwise.
 --
 -- The running solution is either a @Left String@, which means we
 -- don't have yet a working solution, or a @Right (...)@, which
 -- represents a valid solution; it holds the modified node list, the
 -- modified instance (after evacuation), the score of that solution,
 -- and the new secondary node index.
-evacDrbdSecondaryInner :: Node.List -- ^ Cluster node list
-                       -> Instance.Instance -- ^ Instance being evacuated
-                       -> Gdx -- ^ The group index of the instance
-                       -> (Ndx -> IMove) -- ^ Operation constructor
-                       -> EvacInnerState  -- ^ Current best solution
-                       -> Ndx  -- ^ Node we're evaluating as new secondary
-                       -> EvacInnerState -- ^ New best solution
-evacDrbdSecondaryInner nl inst gdx op_fn accu ndx =
+evacOneNodeInner :: Node.List         -- ^ Cluster node list
+                 -> Instance.Instance -- ^ Instance being evacuated
+                 -> Gdx               -- ^ The group index of the instance
+                 -> (Ndx -> IMove)    -- ^ Operation constructor
+                 -> EvacInnerState    -- ^ Current best solution
+                 -> Ndx               -- ^ Node we're evaluating as target
+                 -> EvacInnerState    -- ^ New best solution
+evacOneNodeInner nl inst gdx op_fn accu ndx =
   case applyMove nl inst (op_fn ndx) of
-    OpFail fm ->
-      case accu of
-        Right _ -> accu
-        Left _ -> Left $ "Node " ++ Container.nameOf nl ndx ++
-                  " failed: " ++ show fm
+    OpFail fm -> let fail_msg = "Node " ++ Container.nameOf nl ndx ++
+                                " failed: " ++ show fm
+                 in either (const $ Left fail_msg) (const accu) accu
     OpGood (nl', inst', _, _) ->
       let nodes = Container.elems nl'
           -- The fromJust below is ugly (it can fail nastily), but
@@ -1215,13 +1253,15 @@ computeMoves :: Instance.Instance -- ^ The instance to be moved
 computeMoves i inam mv c d =
   case mv of
     Failover -> ("f", [mig])
+    FailoverToAny _ -> (printf "fa:%s" c, [mig_any])
     FailoverAndReplace _ -> (printf "f r:%s" d, [mig, rep d])
     ReplaceSecondary _ -> (printf "r:%s" d, [rep d])
     ReplaceAndFailover _ -> (printf "r:%s f" c, [rep c, mig])
     ReplacePrimary _ -> (printf "f r:%s f" c, [mig, rep c, mig])
   where morf = if Instance.isRunning i then "migrate" else "failover"
         mig = printf "%s -f %s" morf inam::String
-        rep n = printf "replace-disks -n %s %s" n inam
+        mig_any = printf "%s -f -n %s %s" morf c inam::String
+        rep n = printf "replace-disks -n %s %s" n inam::String
 
 -- | Converts a placement to string format.
 printSolutionLine :: Node.List     -- ^ The node list
@@ -1245,14 +1285,13 @@ printSolutionLine nl il nmlen imlen plc pos =
       (moves, cmds) =  computeMoves inst inam mv npri nsec
       -- FIXME: this should check instead/also the disk template
       ostr = if old_sec == Node.noSecondary
-               then printf "%s" opri
-               else printf "%s:%s" opri osec
+               then printf "%s" opri::String
+               else printf "%s:%s" opri osec::String
       nstr = if s == Node.noSecondary
-               then printf "%s" npri
-               else printf "%s:%s" npri nsec
+               then printf "%s" npri::String
+               else printf "%s:%s" npri nsec::String
   in (printf "  %3d. %-*s %-*s => %-*s %12.8f a=%s"
-      pos imlen inam pmlen (ostr::String)
-      pmlen (nstr::String) c moves,
+      pos imlen inam pmlen ostr pmlen nstr c moves,
       cmds)
 
 -- | Return the instance and involved nodes in an instance move.
@@ -1374,10 +1413,12 @@ iMoveToJob nl il idx move =
       iname = Instance.name inst
       lookNode  = Just . Container.nameOf nl
       opF = OpCodes.OpInstanceMigrate iname True False True Nothing
+      opFA n = OpCodes.OpInstanceMigrate iname True False True (lookNode n)
       opR n = OpCodes.OpInstanceReplaceDisks iname (lookNode n)
               OpCodes.ReplaceNewSecondary [] Nothing
   in case move of
        Failover -> [ opF ]
+       FailoverToAny np -> [ opFA np ]
        ReplacePrimary np -> [ opF, opR np, opF ]
        ReplaceSecondary ns -> [ opR ns ]
        ReplaceAndFailover np -> [ opR np, opF ]