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