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]             -- ^ Selected instances (if not empty)
 194           -> [String]             -- ^ Excluded instances
 195           -> ClusterData          -- ^ Data from backends
 196           -> Result ClusterData   -- ^ Fixed cluster data
 197 mergeData um extags selinsts exinsts cdata@(ClusterData _ nl il2 tags) =
 198   let il = Container.elems il2
 199       il3 = foldl' (\im (name, n_util) ->
 200                         case Container.findByName im name of
 201                           Nothing -> im -- skipping unknown instance
 202                           Just inst ->
 203                               let new_i = inst { Instance.util = n_util }
 204                               in Container.add (Instance.idx inst) new_i im
 205                    ) il2 um
 206       allextags = extags ++ extractExTags tags
 207       il4 = Container.map (filterExTags allextags .
 208                            updateMovable exinsts) il3
 209       nl2 = foldl' fixNodes nl (Container.elems il4)
 210       nl3 = Container.map (flip Node.buildPeers il4) nl2
 211       node_names = map Node.name (Container.elems nl)
 212       inst_names = map Instance.name il
 213       common_suffix = longestDomain (node_names ++ inst_names)
 214       snl = Container.map (computeAlias common_suffix) nl3
 215       sil = Container.map (computeAlias common_suffix) il4
 216       all_inst_names = concatMap allNames $ Container.elems sil
 217   in if not $ all (`elem` all_inst_names) exinsts
 218      then Bad $ "Some of the excluded instances are unknown: " ++
 219           show (exinsts \\ all_inst_names)
 220      else Ok cdata { cdNodes = snl, cdInstances = sil }
 221
 222 -- | Checks the cluster data for consistency.
 223 checkData :: Node.List -> Instance.List
 224           -> ([String], Node.List)
 225 checkData nl il =
 226     Container.mapAccum
 227         (\ msgs node ->
 228              let nname = Node.name node
 229                  nilst = map (`Container.find` il) (Node.pList node)
 230                  dilst = filter (not . Instance.running) nilst
 231                  adj_mem = sum . map Instance.mem $ dilst
 232                  delta_mem = truncate (Node.tMem node)
 233                              - Node.nMem node
 234                              - Node.fMem node
 235                              - nodeImem node il
 236                              + adj_mem
 237                  delta_dsk = truncate (Node.tDsk node)
 238                              - Node.fDsk node
 239                              - nodeIdsk node il
 240                  newn = Node.setFmem (Node.setXmem node delta_mem)
 241                         (Node.fMem node - adj_mem)
 242                  umsg1 = [printf "node %s is missing %d MB ram \
 243                                  \and %d GB disk"
 244                                  nname delta_mem (delta_dsk `div` 1024) |
 245                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 246              in (msgs ++ umsg1, newn)
 247         ) [] nl
 248
 249 -- | Compute the amount of memory used by primary instances on a node.
 250 nodeImem :: Node.Node -> Instance.List -> Int
 251 nodeImem node il =
 252     let rfind = flip Container.find il
 253     in sum . map (Instance.mem . rfind)
 254            $ Node.pList node
 255
 256 -- | Compute the amount of disk used by instances on a node (either primary
 257 -- or secondary).
 258 nodeIdsk :: Node.Node -> Instance.List -> Int
 259 nodeIdsk node il =
 260     let rfind = flip Container.find il
 261     in sum . map (Instance.dsk . rfind)
 262            $ Node.pList node ++ Node.sList node