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