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     , stripSuffix
  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] 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 -- | Remove tail suffix from a string.
 151 stripSuffix :: Int -> String -> String
 152 stripSuffix sflen name = take (length name - sflen) name
 153
 154 -- | Extracts the exclusion tags from the cluster configuration
 155 extractExTags :: [String] -> [String]
 156 extractExTags =
 157     map (drop (length exTagsPrefix)) .
 158     filter (isPrefixOf exTagsPrefix)
 159
 160 -- | Initializer function that loads the data from a node and instance
 161 -- list and massages it into the correct format.
 162 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 163           -> [String]             -- ^ Exclusion tags
 164           -> [String]             -- ^ Untouchable instances
 165           -> (Node.AssocList, Instance.AssocList, [String])
 166           -- ^ Data from backends
 167           -> Result (Node.List, Instance.List, [String], String)
 168 mergeData um extags exinsts (nl, il, tags) =
 169   let il2 = Container.fromAssocList il
 170       il3 = foldl' (\im (name, n_util) ->
 171                         case Container.findByName im name of
 172                           Nothing -> im -- skipping unknown instance
 173                           Just inst ->
 174                               let new_i = inst { Instance.util = n_util }
 175                               in Container.add (Instance.idx inst) new_i im
 176                    ) il2 um
 177       allextags = extags ++ extractExTags tags
 178       il4 = Container.map (filterExTags allextags .
 179                            updateMovable exinsts) il3
 180       nl2 = foldl' fixNodes nl (Container.elems il4)
 181       nl3 = Container.fromAssocList
 182             (map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
 183       node_names = map (Node.name . snd) nl
 184       inst_names = map (Instance.name . snd) il
 185       common_suffix = longestDomain (node_names ++ inst_names)
 186       csl = length common_suffix
 187       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 188       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il4
 189   in if not $ all (`elem` inst_names) exinsts
 190      then Bad $ "Some of the excluded instances are unknown: " ++
 191           show (exinsts \\ inst_names)
 192      else Ok (snl, sil, tags, common_suffix)
 193
 194 -- | Checks the cluster data for consistency.
 195 checkData :: Node.List -> Instance.List
 196           -> ([String], Node.List)
 197 checkData nl il =
 198     Container.mapAccum
 199         (\ msgs node ->
 200              let nname = Node.name node
 201                  nilst = map (`Container.find` il) (Node.pList node)
 202                  dilst = filter (not . Instance.running) nilst
 203                  adj_mem = sum . map Instance.mem $ dilst
 204                  delta_mem = truncate (Node.tMem node)
 205                              - Node.nMem node
 206                              - Node.fMem node
 207                              - nodeImem node il
 208                              + adj_mem
 209                  delta_dsk = truncate (Node.tDsk node)
 210                              - Node.fDsk node
 211                              - nodeIdsk node il
 212                  newn = Node.setFmem (Node.setXmem node delta_mem)
 213                         (Node.fMem node - adj_mem)
 214                  umsg1 = [printf "node %s is missing %d MB ram \
 215                                  \and %d GB disk"
 216                                  nname delta_mem (delta_dsk `div` 1024) |
 217                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 218              in (msgs ++ umsg1, newn)
 219         ) [] nl
 220
 221 -- | Compute the amount of memory used by primary instances on a node.
 222 nodeImem :: Node.Node -> Instance.List -> Int
 223 nodeImem node il =
 224     let rfind = flip Container.find il
 225     in sum . map (Instance.mem . rfind)
 226            $ Node.pList node
 227
 228 -- | Compute the amount of disk used by instances on a node (either primary
 229 -- or secondary).
 230 nodeIdsk :: Node.Node -> Instance.List -> Int
 231 nodeIdsk node il =
 232     let rfind = flip Container.find il
 233     in sum . map (Instance.dsk . rfind)
 234            $ Node.pList node ++ Node.sList node