Add a server-side Luxi implementation
[ganeti-local] / htools / Ganeti / HTools / Cluster.hs
index cd69086..9500aea 100644 (file)
@@ -33,7 +33,6 @@ module Ganeti.HTools.Cluster
   , EvacSolution(..)
   , Table(..)
   , CStats(..)
-  , AllocStats
   , AllocResult
   , AllocMethod
   -- * Generic functions
@@ -62,7 +61,6 @@ module Ganeti.HTools.Cluster
   , genAllocNodes
   , tryAlloc
   , tryMGAlloc
-  , tryReloc
   , tryNodeEvac
   , tryChangeGroup
   , collapseFailures
@@ -140,32 +138,29 @@ data Table = Table Node.List Instance.List Score [Placement]
              deriving (Show, Read)
 
 -- | Cluster statistics data type.
-data CStats = CStats { csFmem :: Integer -- ^ Cluster free mem
-                     , csFdsk :: Integer -- ^ Cluster free disk
-                     , csAmem :: Integer -- ^ Cluster allocatable mem
-                     , csAdsk :: Integer -- ^ Cluster allocatable disk
-                     , csAcpu :: Integer -- ^ Cluster allocatable cpus
-                     , csMmem :: Integer -- ^ Max node allocatable mem
-                     , csMdsk :: Integer -- ^ Max node allocatable disk
-                     , csMcpu :: Integer -- ^ Max node allocatable cpu
-                     , csImem :: Integer -- ^ Instance used mem
-                     , csIdsk :: Integer -- ^ Instance used disk
-                     , csIcpu :: Integer -- ^ Instance used cpu
-                     , csTmem :: Double  -- ^ Cluster total mem
-                     , csTdsk :: Double  -- ^ Cluster total disk
-                     , csTcpu :: Double  -- ^ Cluster total cpus
-                     , csVcpu :: Integer -- ^ Cluster virtual cpus (if
-                                         -- node pCpu has been set,
-                                         -- otherwise -1)
-                     , csXmem :: Integer -- ^ Unnacounted for mem
-                     , csNmem :: Integer -- ^ Node own memory
-                     , csScore :: Score  -- ^ The cluster score
-                     , csNinst :: Int    -- ^ The total number of instances
-                     }
-            deriving (Show, Read)
-
--- | Currently used, possibly to allocate, unallocable.
-type AllocStats = (RSpec, RSpec, RSpec)
+data CStats = CStats
+  { csFmem :: Integer -- ^ Cluster free mem
+  , csFdsk :: Integer -- ^ Cluster free disk
+  , csAmem :: Integer -- ^ Cluster allocatable mem
+  , csAdsk :: Integer -- ^ Cluster allocatable disk
+  , csAcpu :: Integer -- ^ Cluster allocatable cpus
+  , csMmem :: Integer -- ^ Max node allocatable mem
+  , csMdsk :: Integer -- ^ Max node allocatable disk
+  , csMcpu :: Integer -- ^ Max node allocatable cpu
+  , csImem :: Integer -- ^ Instance used mem
+  , csIdsk :: Integer -- ^ Instance used disk
+  , csIcpu :: Integer -- ^ Instance used cpu
+  , csTmem :: Double  -- ^ Cluster total mem
+  , csTdsk :: Double  -- ^ Cluster total disk
+  , csTcpu :: Double  -- ^ Cluster total cpus
+  , csVcpu :: Integer -- ^ Cluster total virtual cpus
+  , csNcpu :: Double  -- ^ Equivalent to 'csIcpu' but in terms of
+                      -- physical CPUs, i.e. normalised used phys CPUs
+  , csXmem :: Integer -- ^ Unnacounted for mem
+  , csNmem :: Integer -- ^ Node own memory
+  , csScore :: Score  -- ^ The cluster score
+  , csNinst :: Int    -- ^ The total number of instances
+  } deriving (Show, Read)
 
 -- | A simple type for allocation functions.
 type AllocMethod =  Node.List           -- ^ Node list
@@ -177,6 +172,10 @@ type AllocMethod =  Node.List           -- ^ Node list
                  -> [CStats]            -- ^ Running cluster stats
                  -> Result AllocResult  -- ^ Allocation result
 
+-- | A simple type for the running solution of evacuations.
+type EvacInnerState =
+  Either String (Node.List, Instance.Instance, Score, Ndx)
+
 -- * Utility functions
 
 -- | Verifies the N+1 status and return the affected nodes.
@@ -214,7 +213,7 @@ instanceNodes nl inst =
 
 -- | Zero-initializer for the CStats type.
 emptyCStats :: CStats
-emptyCStats = CStats 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+emptyCStats = CStats 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 
 -- | Update stats with data from a new node.
 updateCStats :: CStats -> Node.Node -> CStats
@@ -224,7 +223,7 @@ updateCStats cs node =
                csMmem = x_mmem, csMdsk = x_mdsk, csMcpu = x_mcpu,
                csImem = x_imem, csIdsk = x_idsk, csIcpu = x_icpu,
                csTmem = x_tmem, csTdsk = x_tdsk, csTcpu = x_tcpu,
-               csVcpu = x_vcpu,
+               csVcpu = x_vcpu, csNcpu = x_ncpu,
                csXmem = x_xmem, csNmem = x_nmem, csNinst = x_ninst
              }
         = cs
@@ -237,6 +236,8 @@ updateCStats cs node =
       inc_idsk = truncate (Node.tDsk node) - Node.fDsk node
       inc_vcpu = Node.hiCpu node
       inc_acpu = Node.availCpu node
+      inc_ncpu = fromIntegral (Node.uCpu node) /
+                 iPolicyVcpuRatio (Node.iPolicy node)
   in cs { csFmem = x_fmem + fromIntegral (Node.fMem node)
         , csFdsk = x_fdsk + fromIntegral (Node.fDsk node)
         , csAmem = x_amem + fromIntegral inc_amem'
@@ -252,6 +253,7 @@ updateCStats cs node =
         , csTdsk = x_tdsk + Node.tDsk node
         , csTcpu = x_tcpu + Node.tCpu node
         , csVcpu = x_vcpu + fromIntegral inc_vcpu
+        , csNcpu = x_ncpu + inc_ncpu
         , csXmem = x_xmem + fromIntegral (Node.xMem node)
         , csNmem = x_nmem + fromIntegral (Node.nMem node)
         , csNinst = x_ninst + length (Node.pList node)
@@ -271,17 +273,26 @@ totalResources nl =
 -- was left unallocated.
 computeAllocationDelta :: CStats -> CStats -> AllocStats
 computeAllocationDelta cini cfin =
-  let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu} = cini
+  let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu,
+              csNcpu = i_ncpu } = cini
       CStats {csImem = f_imem, csIdsk = f_idsk, csIcpu = f_icpu,
-              csTmem = t_mem, csTdsk = t_dsk, csVcpu = v_cpu } = cfin
-      rini = RSpec (fromIntegral i_icpu) (fromIntegral i_imem)
-             (fromIntegral i_idsk)
-      rfin = RSpec (fromIntegral (f_icpu - i_icpu))
-             (fromIntegral (f_imem - i_imem))
-             (fromIntegral (f_idsk - i_idsk))
-      un_cpu = fromIntegral (v_cpu - f_icpu)::Int
-      runa = RSpec un_cpu (truncate t_mem - fromIntegral f_imem)
-             (truncate t_dsk - fromIntegral f_idsk)
+              csTmem = t_mem, csTdsk = t_dsk, csVcpu = f_vcpu,
+              csNcpu = f_ncpu, csTcpu = f_tcpu } = cfin
+      rini = AllocInfo { allocInfoVCpus = fromIntegral i_icpu
+                       , allocInfoNCpus = i_ncpu
+                       , allocInfoMem   = fromIntegral i_imem
+                       , allocInfoDisk  = fromIntegral i_idsk
+                       }
+      rfin = AllocInfo { allocInfoVCpus = fromIntegral (f_icpu - i_icpu)
+                       , allocInfoNCpus = f_ncpu - i_ncpu
+                       , allocInfoMem   = fromIntegral (f_imem - i_imem)
+                       , allocInfoDisk  = fromIntegral (f_idsk - i_idsk)
+                       }
+      runa = AllocInfo { allocInfoVCpus = fromIntegral (f_vcpu - f_icpu)
+                       , allocInfoNCpus = f_tcpu - f_ncpu
+                       , allocInfoMem   = truncate t_mem - fromIntegral f_imem
+                       , allocInfoDisk  = truncate t_dsk - fromIntegral f_idsk
+                       }
   in (rini, rfin, runa)
 
 -- | The names and weights of the individual elements in the CV list.
@@ -298,6 +309,7 @@ detailedCVInfo = [ (1,  "free_mem_cv")
                  , (1,  "disk_load_cv")
                  , (1,  "net_load_cv")
                  , (2,  "pri_tags_score")
+                 , (1,  "spindles_cv")
                  ]
 
 -- | Holds the weights used by 'compCVNodes' for each metric.
@@ -342,9 +354,11 @@ compDetailedCV all_nodes =
       -- metric: conflicting instance count
       pri_tags_inst = sum $ map Node.conflictingPrimaries nodes
       pri_tags_score = fromIntegral pri_tags_inst::Double
+      -- metric: spindles %
+      spindles_cv = map (\n -> Node.instSpindles n / Node.hiSpindles n) nodes
   in [ mem_cv, dsk_cv, n1_score, res_cv, off_score, off_pri_score, cpu_cv
      , stdDev c_load, stdDev m_load , stdDev d_load, stdDev n_load
-     , pri_tags_score ]
+     , pri_tags_score, stdDev spindles_cv ]
 
 -- | Compute the /total/ variance.
 compCVNodes :: [Node.Node] -> Double
@@ -381,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
@@ -498,22 +523,30 @@ checkSingleStep ini_tbl target cur_tbl move =
 -- | Given the status of the current secondary as a valid new node and
 -- the current candidate target node, generate the possible moves for
 -- a instance.
-possibleMoves :: Bool      -- ^ Whether the secondary node is a valid new node
-              -> Bool      -- ^ Whether we can change the primary node
-              -> Ndx       -- ^ Target node candidate
-              -> [IMove]   -- ^ List of valid result moves
+possibleMoves :: MirrorType -- ^ The mirroring type of the instance
+              -> Bool       -- ^ Whether the secondary node is a valid new node
+              -> Bool       -- ^ Whether we can change the primary node
+              -> Ndx        -- ^ Target node candidate
+              -> [IMove]    -- ^ List of valid result moves
+
+possibleMoves MirrorNone _ _ _ = []
+
+possibleMoves MirrorExternal _ False _ = []
+
+possibleMoves MirrorExternal _ True tdx =
+  [ FailoverToAny tdx ]
 
-possibleMoves _ False tdx =
-  [ReplaceSecondary tdx]
+possibleMoves MirrorInternal _ False tdx =
+  [ ReplaceSecondary tdx ]
 
-possibleMoves True True tdx =
+possibleMoves MirrorInternal True True tdx =
   [ ReplaceSecondary tdx
   , ReplaceAndFailover tdx
   , ReplacePrimary tdx
   , FailoverAndReplace tdx
   ]
 
-possibleMoves False True tdx =
+possibleMoves MirrorInternal False True tdx =
   [ ReplaceSecondary tdx
   , ReplaceAndFailover tdx
   ]
@@ -530,14 +563,17 @@ 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 = Instance.mirrorType target
       use_secondary = elem osdx nodes_idx && inst_moves
-      aft_failover = if use_secondary -- if allowed to failover
+      aft_failover = if mir_type == MirrorInternal && use_secondary
+                       -- if drbd and allowed to failover
                        then checkSingleStep ini_tbl target ini_tbl Failover
                        else ini_tbl
-      all_moves = if disk_moves
-                    then concatMap
-                           (possibleMoves use_secondary inst_moves) nodes
-                    else []
+      all_moves =
+        if disk_moves
+          then concatMap (possibleMoves mir_type use_secondary inst_moves)
+               nodes
+          else []
     in
       -- iterate over the possible nodes for this instance
       foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
@@ -587,15 +623,15 @@ tryBalance :: Table       -- ^ The starting table
 tryBalance ini_tbl disk_moves inst_moves evac_mode mg_limit min_gain =
     let Table ini_nl ini_il ini_cv _ = ini_tbl
         all_inst = Container.elems ini_il
+        all_nodes = Container.elems ini_nl
+        (offline_nodes, online_nodes) = partition Node.offline all_nodes
         all_inst' = if evac_mode
-                    then let bad_nodes = map Node.idx . filter Node.offline $
-                                         Container.elems ini_nl
-                         in filter (any (`elem` bad_nodes) . Instance.allNodes)
-                            all_inst
-                    else all_inst
+                      then let bad_nodes = map Node.idx offline_nodes
+                           in filter (any (`elem` bad_nodes) .
+                                          Instance.allNodes) all_inst
+                      else all_inst
         reloc_inst = filter Instance.movable all_inst'
-        node_idx = map Node.idx . filter (not . Node.offline) $
-                   Container.elems ini_nl
+        node_idx = map Node.idx online_nodes
         fin_tbl = checkMove node_idx disk_moves inst_moves ini_tbl reloc_inst
         (Table _ _ fin_cv _) = fin_tbl
     in
@@ -808,34 +844,6 @@ tryMGAlloc mggl mgnl mgil inst cnt = do
       selmsg = "Selected group: " ++ group_name
   return $ solution { asLog = selmsg:all_msgs }
 
--- | Try to relocate an instance on the cluster.
-tryReloc :: (Monad m) =>
-            Node.List       -- ^ The node list
-         -> Instance.List   -- ^ The instance list
-         -> Idx             -- ^ The index of the instance to move
-         -> Int             -- ^ The number of nodes required
-         -> [Ndx]           -- ^ Nodes which should not be used
-         -> m AllocSolution -- ^ Solution list
-tryReloc nl il xid 1 ex_idx =
-  let all_nodes = getOnline nl
-      inst = Container.find xid il
-      ex_idx' = Instance.pNode inst:ex_idx
-      valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
-      valid_idxes = map Node.idx valid_nodes
-      sols1 = foldl' (\cstate x ->
-                        let em = do
-                              (mnl, i, _, _) <-
-                                applyMove nl inst (ReplaceSecondary x)
-                              return (mnl, i, [Container.find x mnl],
-                                         compCV mnl)
-                        in concatAllocs cstate em
-                     ) emptyAllocSolution valid_idxes
-  in return sols1
-
-tryReloc _ _ _ reqn _  = fail $ "Unsupported number of relocation \
-                                \destinations required (" ++ show reqn ++
-                                                  "), only one supported"
-
 -- | Function which fails if the requested mode is change secondary.
 --
 -- This is useful since except DRBD, no other disk template can
@@ -862,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}) _ _ =
@@ -875,15 +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 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@DTBlock}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Block device 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})
@@ -898,15 +915,7 @@ nodeEvacInstance nl il ChangePrimary
 nodeEvacInstance nl il ChangeSecondary
                  inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
                  gdx avail_nodes =
-  do
-    (nl', inst', _, ndx) <- annotateResult "Can't find any good node" $
-                            eitherToResult $
-                            foldl' (evacDrbdSecondaryInner nl inst gdx)
-                            (Left "no nodes available") avail_nodes
-    let idx = Instance.idx inst
-        il' = Container.add idx inst' il
-        ops = iMoveToJob nl' il' idx (ReplaceSecondary ndx)
-    return (nl', il', ops)
+  evacOneNodeOnly nl il inst gdx avail_nodes
 
 -- The algorithm for ChangeAll is as follows:
 --
@@ -947,32 +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
-                       -> Either String ( Node.List
-                                        , Instance.Instance
-                                        , Score
-                                        , Ndx)  -- ^ Current best solution
-                       -> Ndx  -- ^ Node we're evaluating as new secondary
-                       -> Either String ( Node.List
-                                        , Instance.Instance
-                                        , Score
-                                        , Ndx) -- ^ New best solution
-evacDrbdSecondaryInner nl inst gdx accu ndx =
-  case applyMove nl inst (ReplaceSecondary ndx) of
-    OpFail fm ->
-      case accu of
-        Right _ -> accu
-        Left _ -> Left $ "Node " ++ Container.nameOf nl ndx ++
-                  " failed: " ++ show fm
+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 -> 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
@@ -1220,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.instanceRunning i then "migrate" else "failover"
+  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
@@ -1240,18 +1275,23 @@ printSolutionLine :: Node.List     -- ^ The node list
 printSolutionLine nl il nmlen imlen plc pos =
   let pmlen = (2*nmlen + 1)
       (i, p, s, mv, c) = plc
+      old_sec = Instance.sNode inst
       inst = Container.find i il
       inam = Instance.alias inst
       npri = Node.alias $ Container.find p nl
       nsec = Node.alias $ Container.find s nl
       opri = Node.alias $ Container.find (Instance.pNode inst) nl
-      osec = Node.alias $ Container.find (Instance.sNode inst) nl
+      osec = Node.alias $ Container.find old_sec nl
       (moves, cmds) =  computeMoves inst inam mv npri nsec
-      ostr = printf "%s:%s" opri osec::String
-      nstr = printf "%s:%s" npri nsec::String
-  in (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
-      pos imlen inam pmlen ostr
-      pmlen nstr c moves,
+      -- FIXME: this should check instead/also the disk template
+      ostr = if old_sec == Node.noSecondary
+               then printf "%s" opri::String
+               else printf "%s:%s" opri osec::String
+      nstr = if s == Node.noSecondary
+               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 pmlen nstr c moves,
       cmds)
 
 -- | Return the instance and involved nodes in an instance move.
@@ -1315,14 +1355,13 @@ printNodes nl fs =
                  _ -> fs
       snl = sortBy (comparing Node.idx) (Container.elems nl)
       (header, isnum) = unzip $ map Node.showHeader fields
-  in unlines . map ((:) ' ' .  unwords) $
-     formatTable (header:map (Node.list fields) snl) isnum
+  in printTable "" header (map (Node.list fields) snl) isnum
 
 -- | Print the instance list.
 printInsts :: Node.List -> Instance.List -> String
 printInsts nl il =
   let sil = sortBy (comparing Instance.idx) (Container.elems il)
-      helper inst = [ if Instance.instanceRunning inst then "R" else " "
+      helper inst = [ if Instance.isRunning inst then "R" else " "
                     , Instance.name inst
                     , Container.nameOf nl (Instance.pNode inst)
                     , let sdx = Instance.sNode inst
@@ -1342,18 +1381,21 @@ printInsts nl il =
       header = [ "F", "Name", "Pri_node", "Sec_node", "Auto_bal"
                , "vcpu", "mem" , "dsk", "lCpu", "lMem", "lDsk", "lNet" ]
       isnum = False:False:False:False:False:repeat True
-  in unlines . map ((:) ' ' . unwords) $
-     formatTable (header:map helper sil) isnum
+  in printTable "" header (map helper sil) isnum
 
 -- | Shows statistics for a given node list.
-printStats :: Node.List -> String
-printStats nl =
+printStats :: String -> Node.List -> String
+printStats lp nl =
   let dcvs = compDetailedCV $ Container.elems nl
       (weights, names) = unzip detailedCVInfo
       hd = zip3 (weights ++ repeat 1) (names ++ repeat "unknown") dcvs
-      formatted = map (\(w, header, val) ->
-                         printf "%s=%.8f(x%.2f)" header val w::String) hd
-  in intercalate ", " formatted
+      header = [ "Field", "Value", "Weight" ]
+      formatted = map (\(w, h, val) ->
+                         [ h
+                         , printf "%.8f" val
+                         , printf "x%.2f" w
+                         ]) hd
+  in printTable lp header formatted $ False:repeat True
 
 -- | Convert a placement into a list of OpCodes (basically a job).
 iMoveToJob :: Node.List        -- ^ The node list; only used for node
@@ -1371,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 ]