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]           -- ^ Selected instances (if not empty)
 160               -> [String]           -- ^ Excluded instances
 161               -> Instance.Instance  -- ^ Target Instance
 162               -> Instance.Instance  -- ^ Target Instance with updated attribute
 163 updateMovable selinsts exinsts inst =
 164     if Instance.sNode inst == Node.noSecondary ||
 165        Instance.name inst `elem` exinsts ||
 166        not (null selinsts || Instance.name inst `elem` selinsts)
 167     then Instance.setMovable inst False
 168     else inst
 169
 170 -- | Compute the longest common suffix of a list of strings that
 171 -- | starts with a dot.
 172 longestDomain :: [String] -> String
 173 longestDomain [] = ""
 174 longestDomain (x:xs) =
 175       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 176                               then suffix
 177                               else accu)
 178       "" $ filter (isPrefixOf ".") (tails x)
 179
 180 -- | Extracts the exclusion tags from the cluster configuration
 181 extractExTags :: [String] -> [String]
 182 extractExTags =
 183     map (drop (length exTagsPrefix)) .
 184     filter (isPrefixOf exTagsPrefix)
 185
 186 -- | Extracts the common suffix from node\/instance names
 187 commonSuffix :: Node.List -> Instance.List -> String
 188 commonSuffix nl il =
 189     let node_names = map Node.name $ Container.elems nl
 190         inst_names = map Instance.name $ Container.elems il
 191     in longestDomain (node_names ++ inst_names)
 192
 193 -- | Initializer function that loads the data from a node and instance
 194 -- list and massages it into the correct format.
 195 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 196           -> [String]             -- ^ Exclusion tags
 197           -> [String]             -- ^ Selected instances (if not empty)
 198           -> [String]             -- ^ Excluded instances
 199           -> ClusterData          -- ^ Data from backends
 200           -> Result ClusterData   -- ^ Fixed cluster data
 201 mergeData um extags selinsts exinsts cdata@(ClusterData _ nl il2 tags) =
 202   let il = Container.elems il2
 203       il3 = foldl' (\im (name, n_util) ->
 204                         case Container.findByName im name of
 205                           Nothing -> im -- skipping unknown instance
 206                           Just inst ->
 207                               let new_i = inst { Instance.util = n_util }
 208                               in Container.add (Instance.idx inst) new_i im
 209                    ) il2 um
 210       allextags = extags ++ extractExTags tags
 211       il4 = Container.map (filterExTags allextags .
 212                            updateMovable selinsts exinsts) il3
 213       nl2 = foldl' fixNodes nl (Container.elems il4)
 214       nl3 = Container.map (flip Node.buildPeers il4) nl2
 215       node_names = map Node.name (Container.elems nl)
 216       inst_names = map Instance.name il
 217       common_suffix = longestDomain (node_names ++ inst_names)
 218       snl = Container.map (computeAlias common_suffix) nl3
 219       sil = Container.map (computeAlias common_suffix) il4
 220       all_inst_names = concatMap allNames $ Container.elems sil
 221   in if not $ all (`elem` all_inst_names) exinsts
 222      then Bad $ "Some of the excluded instances are unknown: " ++
 223           show (exinsts \\ all_inst_names)
 224      else if not $ all (`elem` all_inst_names) selinsts
 225           then Bad $ "Some of the selected instances are unknown: " ++
 226                show (selinsts \\ all_inst_names)
 227           else Ok cdata { cdNodes = snl, cdInstances = sil }
 228
 229 -- | Checks the cluster data for consistency.
 230 checkData :: Node.List -> Instance.List
 231           -> ([String], Node.List)
 232 checkData nl il =
 233     Container.mapAccum
 234         (\ msgs node ->
 235              let nname = Node.name node
 236                  nilst = map (`Container.find` il) (Node.pList node)
 237                  dilst = filter (not . Instance.running) nilst
 238                  adj_mem = sum . map Instance.mem $ dilst
 239                  delta_mem = truncate (Node.tMem node)
 240                              - Node.nMem node
 241                              - Node.fMem node
 242                              - nodeImem node il
 243                              + adj_mem
 244                  delta_dsk = truncate (Node.tDsk node)
 245                              - Node.fDsk node
 246                              - nodeIdsk node il
 247                  newn = Node.setFmem (Node.setXmem node delta_mem)
 248                         (Node.fMem node - adj_mem)
 249                  umsg1 = [printf "node %s is missing %d MB ram \
 250                                  \and %d GB disk"
 251                                  nname delta_mem (delta_dsk `div` 1024) |
 252                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 253              in (msgs ++ umsg1, newn)
 254         ) [] nl
 255
 256 -- | Compute the amount of memory used by primary instances on a node.
 257 nodeImem :: Node.Node -> Instance.List -> Int
 258 nodeImem node il =
 259     let rfind = flip Container.find il
 260     in sum . map (Instance.mem . rfind)
 261            $ Node.pList node
 262
 263 -- | Compute the amount of disk used by instances on a node (either primary
 264 -- or secondary).
 265 nodeIdsk :: Node.Node -> Instance.List -> Int
 266 nodeIdsk node il =
 267     let rfind = flip Container.find il
 268     in sum . map (Instance.dsk . rfind)
 269            $ Node.pList node ++ Node.sList node