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

   1 {-| Generic data loader
   2
   3 This module holds the common code for parsing the input data after it
   4 has been loaded from external sources.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Ganeti.HTools.Loader
  30     ( mergeData
  31     , checkData
  32     , assignIndices
  33     , lookupNode
  34     , lookupInstance
  35     , commonSuffix
  36     , RqType(..)
  37     , Request(..)
  38     ) where
  39
  40 import Data.Function (on)
  41 import Data.List
  42 import Data.Maybe (fromJust)
  43 import Text.Printf (printf)
  44
  45 import qualified Ganeti.HTools.Container as Container
  46 import qualified Ganeti.HTools.Instance as Instance
  47 import qualified Ganeti.HTools.Node as Node
  48
  49 import Ganeti.HTools.Types
  50
  51 -- * Constants
  52
  53 -- | The exclusion tag prefix
  54 exTagsPrefix :: String
  55 exTagsPrefix = "htools:iextags:"
  56
  57 -- * Types
  58
  59 {-| The iallocator request type.
  60
  61 This type denotes what request we got from Ganeti and also holds
  62 request-specific fields.
  63
  64 -}
  65 data RqType
  66     = Allocate Instance.Instance Int -- ^ A new instance allocation
  67     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  68                                      -- secondary node
  69     | Evacuate [Ndx]                 -- ^ Evacuate nodes
  70     deriving (Show)
  71
  72 -- | A complete request, as received from Ganeti.
  73 data Request = Request RqType Node.List Instance.List [String]
  74     deriving (Show)
  75
  76 -- * Functions
  77
  78 -- | Lookups a node into an assoc list.
  79 lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
  80 lookupNode ktn inst node =
  81     case lookup node ktn of
  82       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  83       Just idx -> return idx
  84
  85 -- | Lookups an instance into an assoc list.
  86 lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
  87 lookupInstance kti inst =
  88     case lookup inst kti of
  89       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  90       Just idx -> return idx
  91
  92 -- | Given a list of elements (and their names), assign indices to them.
  93 assignIndices :: (Element a) =>
  94                  [(String, a)]
  95               -> (NameAssoc, [(Int, a)])
  96 assignIndices =
  97     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  98           . zip [0..]
  99
 100 -- | Assoc element comparator
 101 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
 102 assocEqual = (==) `on` fst
 103
 104 -- | For each instance, add its index to its primary and secondary nodes.
 105 fixNodes :: [(Ndx, Node.Node)]
 106          -> Instance.Instance
 107          -> [(Ndx, Node.Node)]
 108 fixNodes accu inst =
 109     let
 110         pdx = Instance.pNode inst
 111         sdx = Instance.sNode inst
 112         pold = fromJust $ lookup pdx accu
 113         pnew = Node.setPri pold inst
 114         ac1 = deleteBy assocEqual (pdx, pold) accu
 115         ac2 = (pdx, pnew):ac1
 116     in
 117       if sdx /= Node.noSecondary
 118       then let sold = fromJust $ lookup sdx accu
 119                snew = Node.setSec sold inst
 120                ac3 = deleteBy assocEqual (sdx, sold) ac2
 121            in (sdx, snew):ac3
 122       else ac2
 123
 124 -- | Remove non-selected tags from the exclusion list
 125 filterExTags :: [String] -> Instance.Instance -> Instance.Instance
 126 filterExTags tl inst =
 127     let old_tags = Instance.tags inst
 128         new_tags = filter (\tag -> any (`isPrefixOf` tag) tl)
 129                    old_tags
 130     in inst { Instance.tags = new_tags }
 131
 132 -- | Update the movable attribute
 133 updateMovable :: [String] -> Instance.Instance -> Instance.Instance
 134 updateMovable exinst inst =
 135     if Instance.sNode inst == Node.noSecondary ||
 136        Instance.name inst `elem` exinst
 137     then Instance.setMovable inst False
 138     else inst
 139
 140 -- | Compute the longest common suffix of a list of strings that
 141 -- | starts with a dot.
 142 longestDomain :: [String] -> String
 143 longestDomain [] = ""
 144 longestDomain (x:xs) =
 145       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 146                               then suffix
 147                               else accu)
 148       "" $ filter (isPrefixOf ".") (tails x)
 149
 150 -- | Extracts the exclusion tags from the cluster configuration
 151 extractExTags :: [String] -> [String]
 152 extractExTags =
 153     map (drop (length exTagsPrefix)) .
 154     filter (isPrefixOf exTagsPrefix)
 155
 156 -- | Extracts the common suffix from node\/instance names
 157 commonSuffix :: Node.List -> Instance.List -> String
 158 commonSuffix nl il =
 159     let node_names = map Node.name $ Container.elems nl
 160         inst_names = map Instance.name $ Container.elems il
 161     in longestDomain (node_names ++ inst_names)
 162
 163 -- | Initializer function that loads the data from a node and instance
 164 -- list and massages it into the correct format.
 165 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 166           -> [String]             -- ^ Exclusion tags
 167           -> [String]             -- ^ Untouchable instances
 168           -> (Node.AssocList, Instance.AssocList, [String])
 169           -- ^ Data from backends
 170           -> Result (Node.List, Instance.List, [String])
 171 mergeData um extags exinsts (nl, il, tags) =
 172   let il2 = Container.fromAssocList il
 173       il3 = foldl' (\im (name, n_util) ->
 174                         case Container.findByName im name of
 175                           Nothing -> im -- skipping unknown instance
 176                           Just inst ->
 177                               let new_i = inst { Instance.util = n_util }
 178                               in Container.add (Instance.idx inst) new_i im
 179                    ) il2 um
 180       allextags = extags ++ extractExTags tags
 181       il4 = Container.map (filterExTags allextags .
 182                            updateMovable exinsts) il3
 183       nl2 = foldl' fixNodes nl (Container.elems il4)
 184       nl3 = Container.fromAssocList
 185             (map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
 186       node_names = map (Node.name . snd) nl
 187       inst_names = map (Instance.name . snd) il
 188       common_suffix = longestDomain (node_names ++ inst_names)
 189       snl = Container.map (computeAlias common_suffix) nl3
 190       sil = Container.map (computeAlias common_suffix) il4
 191       all_inst_names = concatMap allNames $ Container.elems sil
 192   in if not $ all (`elem` all_inst_names) exinsts
 193      then Bad $ "Some of the excluded instances are unknown: " ++
 194           show (exinsts \\ all_inst_names)
 195      else Ok (snl, sil, tags)
 196
 197 -- | Checks the cluster data for consistency.
 198 checkData :: Node.List -> Instance.List
 199           -> ([String], Node.List)
 200 checkData nl il =
 201     Container.mapAccum
 202         (\ msgs node ->
 203              let nname = Node.name node
 204                  nilst = map (`Container.find` il) (Node.pList node)
 205                  dilst = filter (not . Instance.running) nilst
 206                  adj_mem = sum . map Instance.mem $ dilst
 207                  delta_mem = truncate (Node.tMem node)
 208                              - Node.nMem node
 209                              - Node.fMem node
 210                              - nodeImem node il
 211                              + adj_mem
 212                  delta_dsk = truncate (Node.tDsk node)
 213                              - Node.fDsk node
 214                              - nodeIdsk node il
 215                  newn = Node.setFmem (Node.setXmem node delta_mem)
 216                         (Node.fMem node - adj_mem)
 217                  umsg1 = [printf "node %s is missing %d MB ram \
 218                                  \and %d GB disk"
 219                                  nname delta_mem (delta_dsk `div` 1024) |
 220                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 221              in (msgs ++ umsg1, newn)
 222         ) [] nl
 223
 224 -- | Compute the amount of memory used by primary instances on a node.
 225 nodeImem :: Node.Node -> Instance.List -> Int
 226 nodeImem node il =
 227     let rfind = flip Container.find il
 228     in sum . map (Instance.mem . rfind)
 229            $ Node.pList node
 230
 231 -- | Compute the amount of disk used by instances on a node (either primary
 232 -- or secondary).
 233 nodeIdsk :: Node.Node -> Instance.List -> Int
 234 nodeIdsk node il =
 235     let rfind = flip Container.find il
 236     in sum . map (Instance.dsk . rfind)
 237            $ Node.pList node ++ Node.sList node