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