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, 2010 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 qualified Data.Map as M
  44 import Text.Printf (printf)
  45
  46 import qualified Ganeti.HTools.Container as Container
  47 import qualified Ganeti.HTools.Instance as Instance
  48 import qualified Ganeti.HTools.Node as Node
  49
  50 import Ganeti.HTools.Types
  51
  52 -- * Constants
  53
  54 -- | The exclusion tag prefix
  55 exTagsPrefix :: String
  56 exTagsPrefix = "htools:iextags:"
  57
  58 -- * Types
  59
  60 {-| The iallocator request type.
  61
  62 This type denotes what request we got from Ganeti and also holds
  63 request-specific fields.
  64
  65 -}
  66 data RqType
  67     = Allocate Instance.Instance Int -- ^ A new instance allocation
  68     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  69                                      -- secondary node
  70     | Evacuate [Ndx]                 -- ^ Evacuate nodes
  71     deriving (Show)
  72
  73 -- | A complete request, as received from Ganeti.
  74 data Request = Request RqType Node.List Instance.List [String]
  75     deriving (Show)
  76
  77 -- * Functions
  78
  79 -- | Lookups a node into an assoc list.
  80 lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
  81 lookupNode ktn inst node =
  82     case M.lookup node ktn of
  83       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  84       Just idx -> return idx
  85
  86 -- | Lookups an instance into an assoc list.
  87 lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
  88 lookupInstance kti inst =
  89     case M.lookup inst kti of
  90       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  91       Just idx -> return idx
  92
  93 -- | Given a list of elements (and their names), assign indices to them.
  94 assignIndices :: (Element a) =>
  95                  [(String, a)]
  96               -> (NameAssoc, [(Int, a)])
  97 assignIndices nodes =
  98   let (na, idx_node) =
  99           unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
 100           . zip [0..] $ nodes
 101   in (M.fromList na, idx_node)
 102
 103 -- | Assoc element comparator
 104 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
 105 assocEqual = (==) `on` fst
 106
 107 -- | For each instance, add its index to its primary and secondary nodes.
 108 fixNodes :: [(Ndx, Node.Node)]
 109          -> Instance.Instance
 110          -> [(Ndx, Node.Node)]
 111 fixNodes accu inst =
 112     let
 113         pdx = Instance.pNode inst
 114         sdx = Instance.sNode inst
 115         pold = fromJust $ lookup pdx accu
 116         pnew = Node.setPri pold inst
 117         ac1 = deleteBy assocEqual (pdx, pold) accu
 118         ac2 = (pdx, pnew):ac1
 119     in
 120       if sdx /= Node.noSecondary
 121       then let sold = fromJust $ lookup sdx accu
 122                snew = Node.setSec sold inst
 123                ac3 = deleteBy assocEqual (sdx, sold) ac2
 124            in (sdx, snew):ac3
 125       else ac2
 126
 127 -- | Remove non-selected tags from the exclusion list
 128 filterExTags :: [String] -> Instance.Instance -> Instance.Instance
 129 filterExTags tl inst =
 130     let old_tags = Instance.tags inst
 131         new_tags = filter (\tag -> any (`isPrefixOf` tag) tl)
 132                    old_tags
 133     in inst { Instance.tags = new_tags }
 134
 135 -- | Update the movable attribute
 136 updateMovable :: [String] -> Instance.Instance -> Instance.Instance
 137 updateMovable exinst inst =
 138     if Instance.sNode inst == Node.noSecondary ||
 139        Instance.name inst `elem` exinst
 140     then Instance.setMovable inst False
 141     else inst
 142
 143 -- | Compute the longest common suffix of a list of strings that
 144 -- | starts with a dot.
 145 longestDomain :: [String] -> String
 146 longestDomain [] = ""
 147 longestDomain (x:xs) =
 148       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 149                               then suffix
 150                               else accu)
 151       "" $ filter (isPrefixOf ".") (tails x)
 152
 153 -- | Extracts the exclusion tags from the cluster configuration
 154 extractExTags :: [String] -> [String]
 155 extractExTags =
 156     map (drop (length exTagsPrefix)) .
 157     filter (isPrefixOf exTagsPrefix)
 158
 159 -- | Extracts the common suffix from node\/instance names
 160 commonSuffix :: Node.List -> Instance.List -> String
 161 commonSuffix nl il =
 162     let node_names = map Node.name $ Container.elems nl
 163         inst_names = map Instance.name $ Container.elems il
 164     in longestDomain (node_names ++ inst_names)
 165
 166 -- | Initializer function that loads the data from a node and instance
 167 -- list and massages it into the correct format.
 168 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 169           -> [String]             -- ^ Exclusion tags
 170           -> [String]             -- ^ Untouchable instances
 171           -> (Node.AssocList, Instance.AssocList, [String])
 172           -- ^ Data from backends
 173           -> Result (Node.List, Instance.List, [String])
 174 mergeData um extags exinsts (nl, il, tags) =
 175   let il2 = Container.fromAssocList il
 176       il3 = foldl' (\im (name, n_util) ->
 177                         case Container.findByName im name of
 178                           Nothing -> im -- skipping unknown instance
 179                           Just inst ->
 180                               let new_i = inst { Instance.util = n_util }
 181                               in Container.add (Instance.idx inst) new_i im
 182                    ) il2 um
 183       allextags = extags ++ extractExTags tags
 184       il4 = Container.map (filterExTags allextags .
 185                            updateMovable exinsts) il3
 186       nl2 = foldl' fixNodes nl (Container.elems il4)
 187       nl3 = Container.fromAssocList
 188             (map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
 189       node_names = map (Node.name . snd) nl
 190       inst_names = map (Instance.name . snd) il
 191       common_suffix = longestDomain (node_names ++ inst_names)
 192       snl = Container.map (computeAlias common_suffix) nl3
 193       sil = Container.map (computeAlias common_suffix) il4
 194       all_inst_names = concatMap allNames $ Container.elems sil
 195   in if not $ all (`elem` all_inst_names) exinsts
 196      then Bad $ "Some of the excluded instances are unknown: " ++
 197           show (exinsts \\ all_inst_names)
 198      else Ok (snl, sil, tags)
 199
 200 -- | Checks the cluster data for consistency.
 201 checkData :: Node.List -> Instance.List
 202           -> ([String], Node.List)
 203 checkData nl il =
 204     Container.mapAccum
 205         (\ msgs node ->
 206              let nname = Node.name node
 207                  nilst = map (`Container.find` il) (Node.pList node)
 208                  dilst = filter (not . Instance.running) nilst
 209                  adj_mem = sum . map Instance.mem $ dilst
 210                  delta_mem = truncate (Node.tMem node)
 211                              - Node.nMem node
 212                              - Node.fMem node
 213                              - nodeImem node il
 214                              + adj_mem
 215                  delta_dsk = truncate (Node.tDsk node)
 216                              - Node.fDsk node
 217                              - nodeIdsk node il
 218                  newn = Node.setFmem (Node.setXmem node delta_mem)
 219                         (Node.fMem node - adj_mem)
 220                  umsg1 = [printf "node %s is missing %d MB ram \
 221                                  \and %d GB disk"
 222                                  nname delta_mem (delta_dsk `div` 1024) |
 223                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 224              in (msgs ++ umsg1, newn)
 225         ) [] nl
 226
 227 -- | Compute the amount of memory used by primary instances on a node.
 228 nodeImem :: Node.Node -> Instance.List -> Int
 229 nodeImem node il =
 230     let rfind = flip Container.find il
 231     in sum . map (Instance.mem . rfind)
 232            $ Node.pList node
 233
 234 -- | Compute the amount of disk used by instances on a node (either primary
 235 -- or secondary).
 236 nodeIdsk :: Node.Node -> Instance.List -> Int
 237 nodeIdsk node il =
 238     let rfind = flip Container.find il
 239     in sum . map (Instance.dsk . rfind)
 240            $ Node.pList node ++ Node.sList node