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