Experimental support for non-redundant instances

[ganeti-local] / Ganeti / HTools / Cluster.hs

diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index f78a8c0..a85b9ad 100644 (file)
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -85,6 +85,10 @@ data IMove = Failover                -- ^ Failover the instance (f)
 data Table = Table NodeList InstanceList Score [Placement]
              deriving (Show)
 
 data Table = Table NodeList InstanceList Score [Placement]
              deriving (Show)
 

+-- | Constant node index for a non-moveable instance
+noSecondary :: Int
+noSecondary = -1
+

 -- General functions
 
 -- | Cap the removal list if needed.
 -- General functions
 
 -- | Cap the removal list if needed.

@@ -475,8 +479,10 @@ checkMove nodes_idx ini_tbl victims =
         -- iterate over all instances, computing the best move
         best_tbl =
             foldl'
         -- iterate over all instances, computing the best move
         best_tbl =
             foldl'

-            (\ step_tbl elem -> compareTables step_tbl $
-                                checkInstanceMove nodes_idx ini_tbl elem)
+            (\ step_tbl elem ->
+                 if Instance.snode elem == noSecondary then step_tbl
+                    else compareTables step_tbl $
+                         checkInstanceMove nodes_idx ini_tbl elem)

             ini_tbl victims
         Table _ _ _ best_plc = best_tbl
     in
             ini_tbl victims
         Table _ _ _ best_plc = best_tbl
     in

@@ -716,13 +722,20 @@ fixNodes nl il =
                     pdx = Instance.pnode inst
                     sdx = Instance.snode inst
                     pold = fromJust $ lookup pdx accu
                     pdx = Instance.pnode inst
                     sdx = Instance.snode inst
                     pold = fromJust $ lookup pdx accu

-                    sold = fromJust $ lookup sdx accu

                     pnew = Node.setPri pold idx
                     pnew = Node.setPri pold idx

-                    snew = Node.setSec sold idx

                     ac1 = deleteBy assocEqual (pdx, pold) accu
                     ac1 = deleteBy assocEqual (pdx, pold) accu

-                    ac2 = deleteBy assocEqual (sdx, sold) ac1
-                    ac3 = (pdx, pnew):(sdx, snew):ac2
-                in ac3) nl il
+                    ac2 = (pdx, pnew):ac1
+                in
+                  if sdx /= noSecondary then
+                      let
+                          sold = fromJust $ lookup sdx accu
+                          snew = Node.setSec sold idx
+                          ac3 = deleteBy assocEqual (sdx, sold) ac2
+                          ac4 = (sdx, snew):ac3
+                      in ac4
+                  else
+                      ac2
+           ) nl il

 
 -- | Compute the longest common suffix of a NameList list that
 -- | starts with a dot
 
 -- | Compute the longest common suffix of a NameList list that
 -- | starts with a dot

@@ -743,32 +756,51 @@ stripSuffix suffix lst =
     let sflen = length suffix in
     map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
 
     let sflen = length suffix in
     map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
 

+-- | Safe 'read' function returning data encapsulated in a Result
+tryRead :: (Monad m, Read a) => String -> String -> m a
+tryRead name s =
+    let sols = readsPrec 0 s
+    in case sols of
+         (v, ""):[] -> return v
+         (_, e):[] -> fail $ name ++ ": leftover characters when parsing '"
+                      ++ s ++ "': '" ++ e ++ "'"
+         _ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'"
+

 -- | Lookups a node into an assoc list
 lookupNode :: (Monad m) => String -> String -> [(String, Int)] -> m Int
 lookupNode node inst ktn =
     case lookup node ktn of
 -- | Lookups a node into an assoc list
 lookupNode :: (Monad m) => String -> String -> [(String, Int)] -> m Int
 lookupNode node inst ktn =
     case lookup node ktn of

-      Nothing -> fail $ "Unknown node " ++ node ++ " for instance " ++ inst
+      Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst

       Just idx -> return idx
 
       Just idx -> return idx
 

+-- | Load a node from a field list

 loadNode :: (Monad m) => [String] -> m (String, Node.Node)
 loadNode (name:tm:nm:fm:td:fd:fo:[]) = do
 loadNode :: (Monad m) => [String] -> m (String, Node.Node)
 loadNode (name:tm:nm:fm:td:fd:fo:[]) = do

-  let new_node =
-          if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
-              Node.create 0 0 0 0 0 True
-          else
-              Node.create (read tm) (read nm) (read fm)
-                      (read td) (read fd) False
+  new_node <-
+      if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
+          return $ Node.create 0 0 0 0 0 True
+      else do
+        vtm <- tryRead name tm
+        vnm <- tryRead name nm
+        vfm <- tryRead name fm
+        vtd <- tryRead name td
+        vfd <- tryRead name fd
+        return $ Node.create vtm vnm vfm vtd vfd False

   return (name, new_node)
 loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
 
   return (name, new_node)
 loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
 

+-- | Load an instance from a field list

 loadInst :: (Monad m) =>
             [(String, Int)] -> [String] -> m (String, Instance.Instance)
 loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do
   pidx <- lookupNode pnode name ktn
 loadInst :: (Monad m) =>
             [(String, Int)] -> [String] -> m (String, Instance.Instance)
 loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do
   pidx <- lookupNode pnode name ktn

-  sidx <- lookupNode snode name ktn
+  sidx <- (if null snode then return noSecondary
+           else lookupNode snode name ktn)
+  vmem <- tryRead name mem
+  vdsk <- tryRead name dsk

   when (sidx == pidx) $ fail $ "Instance " ++ name ++
            " has same primary and secondary node - " ++ pnode
   when (sidx == pidx) $ fail $ "Instance " ++ name ++
            " has same primary and secondary node - " ++ pnode

-  let newinst = Instance.create (read mem) (read dsk) status pidx sidx
+  let newinst = Instance.create vmem vdsk status pidx sidx

   return (name, newinst)
 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
 
   return (name, newinst)
 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
 

@@ -811,7 +843,6 @@ nodeIdsk node il =
     in sum . map Instance.dsk .
        map rfind $ (Node.plist node) ++ (Node.slist node)
 
     in sum . map Instance.dsk .
        map rfind $ (Node.plist node) ++ (Node.slist node)
 

-

 -- | Check cluster data for consistency
 checkData :: NodeList -> InstanceList -> NameList -> NameList
           -> ([String], NodeList)
 -- | Check cluster data for consistency
 checkData :: NodeList -> InstanceList -> NameList -> NameList
           -> ([String], NodeList)