X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/40d4eba06cd66f3ddc12f41f09393c1a131c06dd..e0eb63f07dca0dcfb323fca28085cf2774fcc707:/Ganeti/HTools/Cluster.hs

diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 72ab0ff..4153af6 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -10,6 +10,7 @@ module Ganeti.HTools.Cluster
      -- * Types
      NodeList
     , InstanceList
+    , NameList
     , Placement
     , Solution(..)
     , Table(..)
@@ -31,6 +32,7 @@ module Ganeti.HTools.Cluster
     , printStats
     -- * Loading functions
     , loadData
+    , checkData
     ) where
 
 import Data.List
@@ -45,6 +47,8 @@ import Ganeti.HTools.Utils
 
 type NodeList = Container.Container Node.Node
 type InstanceList = Container.Container Instance.Instance
+-- | The type used to hold idx-to-name mappings
+type NameList = [(Int, String)]
 -- | A separate name for the cluster score type
 type Score = Double
 
@@ -559,33 +563,33 @@ computeMoves i a b c d =
     else
         if c == b then {- Failover and ... -}
             if d == a then {- that's all -}
-                ("f", [printf "migrate %s" i])
+                ("f", [printf "migrate -f %s" i])
             else
                 (printf "f r:%s" d,
-                 [printf "migrate %s" i,
+                 [printf "migrate -f %s" i,
                   printf "replace-disks -n %s %s" d i])
         else
             if d == a then {- ... and keep primary as secondary -}
                 (printf "r:%s f" c,
                  [printf "replace-disks -n %s %s" c i,
-                  printf "migrate %s" i])
+                  printf "migrate -f %s" i])
             else
                 if d == b then {- ... keep same secondary -}
                     (printf "f r:%s f" c,
-                     [printf "migrate %s" i,
+                     [printf "migrate -f %s" i,
                       printf "replace-disks -n %s %s" c i,
-                      printf "migrate %s" i])
+                      printf "migrate -f %s" i])
 
                 else {- Nothing in common -}
                     (printf "r:%s f r:%s" c d,
                      [printf "replace-disks -n %s %s" c i,
-                      printf "migrate %s" i,
+                      printf "migrate -f %s" i,
                       printf "replace-disks -n %s %s" d i])
 
 {-| Converts a placement to string format -}
 printSolutionLine :: InstanceList
-              -> [(Int, String)]
-              -> [(Int, String)]
+              -> NameList
+              -> NameList
               -> Int
               -> Int
               -> Placement
@@ -612,15 +616,17 @@ printSolutionLine il ktn kti nmlen imlen plc pos =
 
 formatCmds :: [[String]] -> String
 formatCmds cmd_strs =
-    unlines $ map ("  echo " ++) $
+    unlines $
     concat $ map (\(a, b) ->
-        (printf "step %d" (a::Int)):(map ("gnt-instance " ++) b)) $
+        (printf "echo step %d" (a::Int)):
+        (printf "check"):
+        (map ("gnt-instance " ++) b)) $
         zip [1..] cmd_strs
 
 {-| Converts a solution to string format -}
 printSolution :: InstanceList
-              -> [(Int, String)]
-              -> [(Int, String)]
+              -> NameList
+              -> NameList
               -> [Placement]
               -> ([String], [[String]])
 printSolution il ktn kti sol =
@@ -633,23 +639,26 @@ printSolution il ktn kti sol =
             zip sol [1..]
 
 -- | Print the node list.
-printNodes :: [(Int, String)] -> NodeList -> String
+printNodes :: NameList -> NodeList -> String
 printNodes ktn nl =
     let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
         snl' = map (\ n -> ((fromJust $ lookup (Node.idx n) ktn), n)) snl
         m_name = maximum . (map length) . fst . unzip $ snl'
         helper = Node.list m_name
-        header = printf "%2s %-*s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
-                 "N1" m_name "Name" "t_mem" "f_mem" "r_mem"
+        header = printf
+                 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
+                 " F" m_name "Name"
+                 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
                  "t_dsk" "f_dsk"
                  "pri" "sec" "p_fmem" "p_fdsk"
     in unlines $ (header:map (uncurry helper) snl')
 
 -- | Compute the mem and disk covariance.
-compDetailedCV :: NodeList -> (Double, Double, Double, Double)
+compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double)
 compDetailedCV nl =
     let
-        nodes = Container.elems nl
+        all_nodes = Container.elems nl
+        (offline, nodes) = partition Node.offline all_nodes
         mem_l = map Node.p_mem nodes
         dsk_l = map Node.p_dsk nodes
         mem_cv = varianceCoeff mem_l
@@ -658,19 +667,25 @@ compDetailedCV nl =
         n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
         res_l = map Node.p_rem nodes
         res_cv = varianceCoeff res_l
-    in (mem_cv, dsk_cv, n1_score, res_cv)
+        offline_inst = sum . map (\n -> (length . Node.plist $ n) +
+                                        (length . Node.slist $ n)) $ offline
+        online_inst = sum . map (\n -> (length . Node.plist $ n) +
+                                       (length . Node.slist $ n)) $ nodes
+        off_score = (fromIntegral offline_inst) /
+                    (fromIntegral $ online_inst + offline_inst)
+    in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
 
 -- | Compute the 'total' variance.
 compCV :: NodeList -> Double
 compCV nl =
-    let (mem_cv, dsk_cv, n1_score, res_cv) = compDetailedCV nl
-    in mem_cv + dsk_cv + n1_score + res_cv
+    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
+    in mem_cv + dsk_cv + n1_score + res_cv + off_score
 
 printStats :: NodeList -> String
 printStats nl =
-    let (mem_cv, dsk_cv, n1_score, res_cv) = compDetailedCV nl
-    in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f"
-       mem_cv res_cv dsk_cv n1_score
+    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
+    in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
+       mem_cv res_cv dsk_cv n1_score off_score
 
 -- Balancing functions
 
@@ -712,9 +727,9 @@ fixNodes nl il =
                     ac3 = (pdx, pnew):(sdx, snew):ac2
                 in ac3) nl il
 
--- | Compute the longest common suffix of a [(Int, String)] list that
+-- | Compute the longest common suffix of a NameList list that
 -- | starts with a dot
-longestDomain :: [(Int, String)] -> String
+longestDomain :: NameList -> String
 longestDomain [] = ""
 longestDomain ((_,x):xs) =
     let
@@ -726,7 +741,7 @@ longestDomain ((_,x):xs) =
       "" $ filter (isPrefixOf ".") (tails x)
 
 -- | Remove tails from the (Int, String) lists
-stripSuffix :: String -> [(Int, String)] -> [(Int, String)]
+stripSuffix :: String -> NameList -> NameList
 stripSuffix suffix lst =
     let sflen = length suffix in
     map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
@@ -737,19 +752,24 @@ loadData :: String -- ^ Node data in text format
          -> String -- ^ Instance data in text format
          -> (Container.Container Node.Node,
              Container.Container Instance.Instance,
-             String, [(Int, String)], [(Int, String)])
+             String, NameList, NameList)
 loadData ndata idata =
     let
-    {- node file: name mem disk -}
+    {- node file: name t_mem n_mem f_mem t_disk f_disk -}
         (ktn, nl) = loadTabular ndata
-                    (\ (i:jt:jf:kt:kf:[]) -> (i, Node.create jt jf kt kf))
+                    (\ (name:tm:nm:fm:td:fd:[]) ->
+                         (name,
+                          Node.create (read tm) (read nm)
+                                  (read fm) (read td) (read fd)))
                     Node.setIdx
-    {- instance file: name mem disk -}
+    {- instance file: name mem disk status pnode snode -}
         (kti, il) = loadTabular idata
-                    (\ (i:j:k:l:m:[]) -> (i,
-                                           Instance.create j k
-                                               (fromJust $ lookup l ktn)
-                                               (fromJust $ lookup m ktn)))
+                    (\ (name:mem:dsk:status:pnode:snode:[]) ->
+                         (name,
+                          Instance.create (read mem) (read dsk)
+                              status
+                              (fromJust $ lookup pnode ktn)
+                              (fromJust $ lookup snode ktn)))
                     Instance.setIdx
         nl2 = fixNodes nl il
         il3 = Container.fromAssocList il
@@ -762,3 +782,47 @@ loadData ndata idata =
         sti = stripSuffix common_suffix xti
     in
       (nl3, il3, common_suffix, stn, sti)
+
+-- | Compute the amount of memory used by primary instances on a node.
+nodeImem :: Node.Node -> InstanceList -> Int
+nodeImem node il =
+    let rfind = flip Container.find $ il
+    in sum . map Instance.mem .
+       map rfind $ Node.plist node
+
+-- | Compute the amount of disk used by instances on a node (either primary
+-- or secondary).
+nodeIdsk :: Node.Node -> InstanceList -> Int
+nodeIdsk node il =
+    let rfind = flip Container.find $ il
+    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)
+checkData nl il ktn _ =
+    Container.mapAccum
+        (\ msgs node ->
+             let nname = fromJust $ lookup (Node.idx node) ktn
+                 nilst = map (flip Container.find $ il) (Node.plist node)
+                 dilst = filter (not . Instance.running) nilst
+                 adj_mem = sum . map Instance.mem $ dilst
+                 delta_mem = (truncate $ Node.t_mem node)
+                             - (Node.n_mem node)
+                             - (Node.f_mem node)
+                             - (nodeImem node il)
+                             + adj_mem
+                 delta_dsk = (truncate $ Node.t_dsk node)
+                             - (Node.f_dsk node)
+                             - (nodeIdsk node il)
+                 newn = Node.setFmem (Node.setXmem node delta_mem)
+                        (Node.f_mem node - adj_mem)
+                 umsg1 = if delta_mem > 16 || delta_dsk > 1024
+                         then [printf "node %s is missing %d MB ram \
+                                     \and %d GB disk"
+                                     nname delta_mem (delta_dsk `div` 1024)]
+                         else []
+             in (msgs ++ umsg1, newn)
+        ) [] nl