code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Loader.hs

   1 {-| Loading data from external sources
   2
   3 This module holds the common code for loading the cluster state from external sources.
   4
   5 -}
   6
   7 module Ganeti.HTools.Loader
   8     ( mergeData
   9     , checkData
  10     , assignIndices
  11     , lookupNode
  12     ) where
  13
  14 import Data.List
  15 import Data.Maybe (fromJust)
  16 import Text.Printf (printf)
  17
  18 import qualified Ganeti.HTools.Container as Container
  19 import qualified Ganeti.HTools.Instance as Instance
  20 import qualified Ganeti.HTools.Node as Node
  21
  22 import Ganeti.HTools.Types
  23
  24
  25 -- | Swap a list of @(a, b)@ into @(b, a)@
  26 swapPairs :: [(a, b)] -> [(b, a)]
  27 swapPairs = map (\ (a, b) -> (b, a))
  28
  29 -- | Lookups a node into an assoc list
  30 lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Int
  31 lookupNode ktn inst node =
  32     case lookup node ktn of
  33       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  34       Just idx -> return idx
  35
  36 assignIndices :: (Element a) =>
  37                  [(String, a)]
  38               -> (NameAssoc, [(Int, a)])
  39 assignIndices =
  40     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  41           . zip [0..]
  42
  43 -- | For each instance, add its index to its primary and secondary nodes
  44 fixNodes :: [(Int, Node.Node)]
  45          -> [(Int, Instance.Instance)]
  46          -> [(Int, Node.Node)]
  47 fixNodes nl il =
  48     foldl' (\accu (idx, inst) ->
  49                 let
  50                     assocEqual = (\ (i, _) (j, _) -> i == j)
  51                     pdx = Instance.pnode inst
  52                     sdx = Instance.snode inst
  53                     pold = fromJust $ lookup pdx accu
  54                     pnew = Node.setPri pold idx
  55                     ac1 = deleteBy assocEqual (pdx, pold) accu
  56                     ac2 = (pdx, pnew):ac1
  57                 in
  58                   if sdx /= Node.noSecondary then
  59                       let
  60                           sold = fromJust $ lookup sdx accu
  61                           snew = Node.setSec sold idx
  62                           ac3 = deleteBy assocEqual (sdx, sold) ac2
  63                           ac4 = (sdx, snew):ac3
  64                       in ac4
  65                   else
  66                       ac2
  67            ) nl il
  68
  69 -- | Compute the longest common suffix of a NameList list that
  70 -- | starts with a dot
  71 longestDomain :: [String] -> String
  72 longestDomain [] = ""
  73 longestDomain (x:xs) =
  74       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
  75                               then suffix
  76                               else accu)
  77       "" $ filter (isPrefixOf ".") (tails x)
  78
  79 -- | Remove tail suffix from a string
  80 stripSuffix :: Int -> String -> String
  81 stripSuffix sflen name = take ((length name) - sflen) name
  82
  83 {-| Initializer function that loads the data from a node and list file
  84     and massages it into the correct format. -}
  85 mergeData :: ([(String, Int)], Node.AssocList,
  86               [(String, Int)], Instance.AssocList) -- ^ Data from either
  87                                                    -- Text.loadData
  88                                                    -- or Rapi.loadData
  89           -> Result (NodeList, InstanceList, String)
  90 mergeData (ktn, nl, kti, il) = do
  91   let
  92       nl2 = fixNodes nl il
  93       il3 = Container.fromAssocList il
  94       nl3 = Container.fromAssocList
  95             (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
  96       node_names = map Node.name $ Container.elems nl3
  97       inst_names = map Instance.name $ Container.elems il3
  98       common_suffix = longestDomain (node_names ++ inst_names)
  99       csl = length common_suffix
 100       snl = Container.map (\n -> setName n (stripSuffix csl $ name n)) nl3
 101       sil = Container.map (\i -> setName i (stripSuffix csl $ name i)) il3
 102   return (snl, sil, common_suffix)
 103
 104 -- | Check cluster data for consistency
 105 checkData :: NodeList -> InstanceList
 106           -> ([String], NodeList)
 107 checkData nl il =
 108     Container.mapAccum
 109         (\ msgs node ->
 110              let nname = Node.name node
 111                  nilst = map (flip Container.find $ il) (Node.plist node)
 112                  dilst = filter (not . Instance.running) nilst
 113                  adj_mem = sum . map Instance.mem $ dilst
 114                  delta_mem = (truncate $ Node.t_mem node)
 115                              - (Node.n_mem node)
 116                              - (Node.f_mem node)
 117                              - (nodeImem node il)
 118                              + adj_mem
 119                  delta_dsk = (truncate $ Node.t_dsk node)
 120                              - (Node.f_dsk node)
 121                              - (nodeIdsk node il)
 122                  newn = Node.setFmem (Node.setXmem node delta_mem)
 123                         (Node.f_mem node - adj_mem)
 124                  umsg1 = if delta_mem > 512 || delta_dsk > 1024
 125                          then [printf "node %s is missing %d MB ram \
 126                                      \and %d GB disk"
 127                                      nname delta_mem (delta_dsk `div` 1024)]
 128                          else []
 129              in (msgs ++ umsg1, newn)
 130         ) [] nl
 131
 132 -- | Compute the amount of memory used by primary instances on a node.
 133 nodeImem :: Node.Node -> InstanceList -> Int
 134 nodeImem node il =
 135     let rfind = flip Container.find $ il
 136     in sum . map Instance.mem .
 137        map rfind $ Node.plist node
 138
 139 -- | Compute the amount of disk used by instances on a node (either primary
 140 -- or secondary).
 141 nodeIdsk :: Node.Node -> InstanceList -> Int
 142 nodeIdsk node il =
 143     let rfind = flip Container.find $ il
 144     in sum . map Instance.dsk .
 145        map rfind $ (Node.plist node) ++ (Node.slist node)