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 {-
   8
   9 Copyright (C) 2009 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.HTools.Loader
  29     ( mergeData
  30     , checkData
  31     , assignIndices
  32     , lookupNode
  33     , lookupInstance
  34     , stripSuffix
  35     , RqType(..)
  36     , Request(..)
  37     ) where
  38
  39 import Data.Function (on)
  40 import Data.List
  41 import Data.Maybe (fromJust)
  42 import Text.Printf (printf)
  43
  44 import qualified Ganeti.HTools.Container as Container
  45 import qualified Ganeti.HTools.Instance as Instance
  46 import qualified Ganeti.HTools.Node as Node
  47
  48 import Ganeti.HTools.Types
  49
  50 -- * Types
  51
  52 {-| The request type.
  53
  54 This type denotes what request we got from Ganeti and also holds
  55 request-specific fields.
  56
  57 -}
  58 data RqType
  59     = Allocate Instance.Instance Int -- ^ A new instance allocation
  60     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  61                                      -- secondary node
  62     deriving (Show)
  63
  64 -- | A complete request, as received from Ganeti.
  65 data Request = Request RqType Node.List Instance.List String
  66     deriving (Show)
  67
  68 -- * Functions
  69
  70 -- | Lookups a node into an assoc list.
  71 lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
  72 lookupNode ktn inst node =
  73     case lookup node ktn of
  74       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  75       Just idx -> return idx
  76
  77 -- | Lookups an instance into an assoc list.
  78 lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
  79 lookupInstance kti inst =
  80     case lookup inst kti of
  81       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  82       Just idx -> return idx
  83
  84 -- | Given a list of elements (and their names), assign indices to them.
  85 assignIndices :: (Element a) =>
  86                  [(String, a)]
  87               -> (NameAssoc, [(Int, a)])
  88 assignIndices =
  89     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  90           . zip [0..]
  91
  92 -- | Assoc element comparator
  93 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
  94 assocEqual = (==) `on` fst
  95
  96 -- | For each instance, add its index to its primary and secondary nodes.
  97 fixNodes :: [(Ndx, Node.Node)]
  98          -> (Idx, Instance.Instance)
  99          -> [(Ndx, Node.Node)]
 100 fixNodes accu (idx, inst) =
 101     let
 102         pdx = Instance.pnode inst
 103         sdx = Instance.snode inst
 104         pold = fromJust $ lookup pdx accu
 105         pnew = Node.setPri pold idx
 106         pnew' = Node.addCpus pnew (Instance.vcpus inst)
 107         ac1 = deleteBy assocEqual (pdx, pold) accu
 108         ac2 = (pdx, pnew'):ac1
 109     in
 110       if sdx /= Node.noSecondary
 111       then let sold = fromJust $ lookup sdx accu
 112                snew = Node.setSec sold idx
 113                ac3 = deleteBy assocEqual (sdx, sold) ac2
 114            in (sdx, snew):ac3
 115       else ac2
 116
 117 -- | Compute the longest common suffix of a list of strings that
 118 -- | starts with a dot.
 119 longestDomain :: [String] -> String
 120 longestDomain [] = ""
 121 longestDomain (x:xs) =
 122       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 123                               then suffix
 124                               else accu)
 125       "" $ filter (isPrefixOf ".") (tails x)
 126
 127 -- | Remove tail suffix from a string.
 128 stripSuffix :: Int -> String -> String
 129 stripSuffix sflen name = take (length name - sflen) name
 130
 131 -- | Initializer function that loads the data from a node and instance
 132 -- list and massages it into the correct format.
 133 mergeData :: (Node.AssocList,
 134               Instance.AssocList) -- ^ Data from either Text.loadData
 135                                   -- or Rapi.loadData
 136           -> Result (Node.List, Instance.List, String)
 137 mergeData (nl, il) = do
 138   let
 139       nl2 = foldl' fixNodes nl il
 140       il3 = Container.fromAssocList il
 141       nl3 = Container.fromAssocList
 142             (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
 143       node_names = map Node.name $ Container.elems nl3
 144       inst_names = map Instance.name $ Container.elems il3
 145       common_suffix = longestDomain (node_names ++ inst_names)
 146       csl = length common_suffix
 147       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 148       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
 149   return (snl, sil, common_suffix)
 150
 151 -- | Checks the cluster data for consistency.
 152 checkData :: Node.List -> Instance.List
 153           -> ([String], Node.List)
 154 checkData nl il =
 155     Container.mapAccum
 156         (\ msgs node ->
 157              let nname = Node.name node
 158                  nilst = map (flip Container.find il) (Node.plist node)
 159                  dilst = filter (not . Instance.running) nilst
 160                  adj_mem = sum . map Instance.mem $ dilst
 161                  delta_mem = truncate (Node.t_mem node)
 162                              - Node.n_mem node
 163                              - Node.f_mem node
 164                              - nodeImem node il
 165                              + adj_mem
 166                  delta_dsk = truncate (Node.t_dsk node)
 167                              - Node.f_dsk node
 168                              - nodeIdsk node il
 169                  newn = Node.setFmem (Node.setXmem node delta_mem)
 170                         (Node.f_mem node - adj_mem)
 171                  umsg1 = [printf "node %s is missing %d MB ram \
 172                                  \and %d GB disk"
 173                                  nname delta_mem (delta_dsk `div` 1024) |
 174                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 175              in (msgs ++ umsg1, newn)
 176         ) [] nl
 177
 178 -- | Compute the amount of memory used by primary instances on a node.
 179 nodeImem :: Node.Node -> Instance.List -> Int
 180 nodeImem node il =
 181     let rfind = flip Container.find il
 182     in sum . map (Instance.mem . rfind)
 183            $ Node.plist node
 184
 185 -- | Compute the amount of disk used by instances on a node (either primary
 186 -- or secondary).
 187 nodeIdsk :: Node.Node -> Instance.List -> Int
 188 nodeIdsk node il =
 189     let rfind = flip Container.find il
 190     in sum . map (Instance.dsk . rfind)
 191            $ Node.plist node ++ Node.slist node