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, 2012 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 import qualified Ganeti.HTools.Cluster as Cluster
  52
  53 import Ganeti.BasicTypes
  54 import Ganeti.HTools.Types
  55 import Ganeti.HTools.Utils
  56
  57 -- * Constants
  58
  59 -- | The exclusion tag prefix.
  60 exTagsPrefix :: String
  61 exTagsPrefix = "htools:iextags:"
  62
  63 -- * Types
  64
  65 {-| The iallocator request type.
  66
  67 This type denotes what request we got from Ganeti and also holds
  68 request-specific fields.
  69
  70 -}
  71 data RqType
  72   = Allocate Instance.Instance Int -- ^ A new instance allocation
  73   | Relocate Idx Int [Ndx]         -- ^ Choose a new secondary node
  74   | NodeEvacuate [Idx] EvacMode    -- ^ node-evacuate mode
  75   | ChangeGroup [Gdx] [Idx]        -- ^ Multi-relocate mode
  76     deriving (Show, Read)
  77
  78 -- | A complete request, as received from Ganeti.
  79 data Request = Request RqType ClusterData
  80                deriving (Show, Read)
  81
  82 -- | The cluster state.
  83 data ClusterData = ClusterData
  84   { cdGroups    :: Group.List    -- ^ The node group list
  85   , cdNodes     :: Node.List     -- ^ The node list
  86   , cdInstances :: Instance.List -- ^ The instance list
  87   , cdTags      :: [String]      -- ^ The cluster tags
  88   , cdIPolicy   :: IPolicy       -- ^ The cluster instance policy
  89   } deriving (Show, Read, Eq)
  90
  91 -- | An empty cluster.
  92 emptyCluster :: ClusterData
  93 emptyCluster = ClusterData Container.empty Container.empty Container.empty []
  94                  defIPolicy
  95
  96 -- * Functions
  97
  98 -- | Lookups a node into an assoc list.
  99 lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
 100 lookupNode ktn inst node =
 101   maybe (fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst) return $
 102     M.lookup node ktn
 103
 104 -- | Lookups an instance into an assoc list.
 105 lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
 106 lookupInstance kti inst =
 107   maybe (fail $ "Unknown instance '" ++ inst ++ "'") return $ M.lookup inst kti
 108
 109 -- | Lookups a group into an assoc list.
 110 lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx
 111 lookupGroup ktg nname gname =
 112   maybe (fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname) return $
 113     M.lookup gname ktg
 114
 115 -- | Given a list of elements (and their names), assign indices to them.
 116 assignIndices :: (Element a) =>
 117                  [(String, a)]
 118               -> (NameAssoc, Container.Container a)
 119 assignIndices nodes =
 120   let (na, idx_node) =
 121           unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
 122           . zip [0..] $ nodes
 123   in (M.fromList na, Container.fromList idx_node)
 124
 125 -- | For each instance, add its index to its primary and secondary nodes.
 126 fixNodes :: Node.List
 127          -> Instance.Instance
 128          -> Node.List
 129 fixNodes accu inst =
 130   let 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 if sdx /= Node.noSecondary
 136        then let sold = Container.find sdx accu
 137                 snew = Node.setSec sold inst
 138             in Container.add sdx snew ac2
 139        else ac2
 140
 141 -- | Set the node's policy to its group one. Note that this requires
 142 -- the group to exist (should have been checked before), otherwise it
 143 -- will abort with a runtime error.
 144 setNodePolicy :: Group.List -> Node.Node -> Node.Node
 145 setNodePolicy gl node =
 146   let grp = Container.find (Node.group node) gl
 147       gpol = Group.iPolicy grp
 148   in Node.setPolicy gpol node
 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) old_tags
 155   in inst { Instance.tags = new_tags }
 156
 157 -- | Update the movable attribute.
 158 updateMovable :: [String]           -- ^ Selected instances (if not empty)
 159               -> [String]           -- ^ Excluded instances
 160               -> Instance.Instance  -- ^ Target Instance
 161               -> Instance.Instance  -- ^ Target Instance with updated attribute
 162 updateMovable selinsts exinsts inst =
 163   if Instance.name inst `elem` exinsts ||
 164      not (null selinsts || Instance.name inst `elem` selinsts)
 165     then Instance.setMovable inst False
 166     else inst
 167
 168 -- | Disables moves for instances with a split group.
 169 disableSplitMoves :: Node.List -> Instance.Instance -> Instance.Instance
 170 disableSplitMoves nl inst =
 171   if not . isOk . Cluster.instanceGroup nl $ inst
 172     then Instance.setMovable inst False
 173     else inst
 174
 175 -- | Compute the longest common suffix of a list of strings that
 176 -- starts with a dot.
 177 longestDomain :: [String] -> String
 178 longestDomain [] = ""
 179 longestDomain (x:xs) =
 180   foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 181                             then suffix
 182                             else accu)
 183           "" $ filter (isPrefixOf ".") (tails x)
 184
 185 -- | Extracts the exclusion tags from the cluster configuration.
 186 extractExTags :: [String] -> [String]
 187 extractExTags =
 188   map (drop (length exTagsPrefix)) .
 189   filter (isPrefixOf exTagsPrefix)
 190
 191 -- | Extracts the common suffix from node\/instance names.
 192 commonSuffix :: Node.List -> Instance.List -> String
 193 commonSuffix nl il =
 194   let node_names = map Node.name $ Container.elems nl
 195       inst_names = map Instance.name $ Container.elems il
 196   in longestDomain (node_names ++ inst_names)
 197
 198 -- | Initializer function that loads the data from a node and instance
 199 -- list and massages it into the correct format.
 200 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 201           -> [String]             -- ^ Exclusion tags
 202           -> [String]             -- ^ Selected instances (if not empty)
 203           -> [String]             -- ^ Excluded instances
 204           -> ClusterData          -- ^ Data from backends
 205           -> Result ClusterData   -- ^ Fixed cluster data
 206 mergeData um extags selinsts exinsts cdata@(ClusterData gl nl il2 tags _) =
 207   let il = Container.elems il2
 208       il3 = foldl' (\im (name, n_util) ->
 209                         case Container.findByName im name of
 210                           Nothing -> im -- skipping unknown instance
 211                           Just inst ->
 212                               let new_i = inst { Instance.util = n_util }
 213                               in Container.add (Instance.idx inst) new_i im
 214                    ) il2 um
 215       allextags = extags ++ extractExTags tags
 216       inst_names = map Instance.name il
 217       selinst_lkp = map (lookupName inst_names) selinsts
 218       exinst_lkp = map (lookupName inst_names) exinsts
 219       lkp_unknown = filter (not . goodLookupResult) (selinst_lkp ++ exinst_lkp)
 220       selinst_names = map lrContent selinst_lkp
 221       exinst_names = map lrContent exinst_lkp
 222       node_names = map Node.name (Container.elems nl)
 223       common_suffix = longestDomain (node_names ++ inst_names)
 224       il4 = Container.map (computeAlias common_suffix .
 225                            filterExTags allextags .
 226                            updateMovable selinst_names exinst_names) il3
 227       nl2 = foldl' fixNodes nl (Container.elems il4)
 228       nl3 = Container.map (setNodePolicy gl .
 229                            computeAlias common_suffix .
 230                            (`Node.buildPeers` il4)) nl2
 231       il5 = Container.map (disableSplitMoves nl3) il4
 232   in if' (null lkp_unknown)
 233          (Ok cdata { cdNodes = nl3, cdInstances = il5 })
 234          (Bad $ "Unknown instance(s): " ++ show(map lrContent lkp_unknown))
 235
 236 -- | Checks the cluster data for consistency.
 237 checkData :: Node.List -> Instance.List
 238           -> ([String], Node.List)
 239 checkData nl il =
 240     Container.mapAccum
 241         (\ msgs node ->
 242              let nname = Node.name node
 243                  nilst = map (`Container.find` il) (Node.pList node)
 244                  dilst = filter Instance.instanceDown nilst
 245                  adj_mem = sum . map Instance.mem $ dilst
 246                  delta_mem = truncate (Node.tMem node)
 247                              - Node.nMem node
 248                              - Node.fMem node
 249                              - nodeImem node il
 250                              + adj_mem
 251                  delta_dsk = truncate (Node.tDsk node)
 252                              - Node.fDsk node
 253                              - nodeIdsk node il
 254                  newn = Node.setFmem (Node.setXmem node delta_mem)
 255                         (Node.fMem node - adj_mem)
 256                  umsg1 =
 257                    if delta_mem > 512 || delta_dsk > 1024
 258                       then printf "node %s is missing %d MB ram \
 259                                   \and %d GB disk"
 260                                   nname delta_mem (delta_dsk `div` 1024):msgs
 261                       else msgs
 262              in (umsg1, newn)
 263         ) [] nl
 264
 265 -- | Compute the amount of memory used by primary instances on a node.
 266 nodeImem :: Node.Node -> Instance.List -> Int
 267 nodeImem node il =
 268   let rfind = flip Container.find il
 269       il' = map rfind $ Node.pList node
 270       oil' = filter Instance.notOffline il'
 271   in sum . map Instance.mem $ oil'
 272
 273
 274 -- | Compute the amount of disk used by instances on a node (either primary
 275 -- or secondary).
 276 nodeIdsk :: Node.Node -> Instance.List -> Int
 277 nodeIdsk node il =
 278   let rfind = flip Container.find il
 279   in sum . map (Instance.dsk . rfind)
 280        $ Node.pList node ++ Node.sList node