code.grnet.gr Git - ganeti-local/blob - 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 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     , stripSuffix
  36     , RqType(..)
  37     , Request(..)
  38     ) where
  39
  40 import Data.Function (on)
  41 import Data.List
  42 import Data.Maybe (fromJust)
  43 import Text.Printf (printf)
  44
  45 import qualified Ganeti.HTools.Container as Container
  46 import qualified Ganeti.HTools.Instance as Instance
  47 import qualified Ganeti.HTools.Node as Node
  48
  49 import Ganeti.HTools.Types
  50
  51 -- * Constants
  52
  53 -- | The exclusion tag prefix
  54 exTagsPrefix :: String
  55 exTagsPrefix = "htools:iextags:"
  56
  57 -- * Types
  58
  59 {-| The request type.
  60
  61 This type denotes what request we got from Ganeti and also holds
  62 request-specific fields.
  63
  64 -}
  65 data RqType
  66     = Allocate Instance.Instance Int -- ^ A new instance allocation
  67     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  68                                      -- secondary node
  69     deriving (Show)
  70
  71 -- | A complete request, as received from Ganeti.
  72 data Request = Request RqType Node.List Instance.List [String] String
  73     deriving (Show)
  74
  75 -- * Functions
  76
  77 -- | Lookups a node into an assoc list.
  78 lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
  79 lookupNode ktn inst node =
  80     case lookup node ktn of
  81       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  82       Just idx -> return idx
  83
  84 -- | Lookups an instance into an assoc list.
  85 lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
  86 lookupInstance kti inst =
  87     case lookup inst kti of
  88       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  89       Just idx -> return idx
  90
  91 -- | Given a list of elements (and their names), assign indices to them.
  92 assignIndices :: (Element a) =>
  93                  [(String, a)]
  94               -> (NameAssoc, [(Int, a)])
  95 assignIndices =
  96     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  97           . zip [0..]
  98
  99 -- | Assoc element comparator
 100 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
 101 assocEqual = (==) `on` fst
 102
 103 -- | For each instance, add its index to its primary and secondary nodes.
 104 fixNodes :: [(Ndx, Node.Node)]
 105          -> Instance.Instance
 106          -> [(Ndx, Node.Node)]
 107 fixNodes accu inst =
 108     let
 109         pdx = Instance.pNode inst
 110         sdx = Instance.sNode inst
 111         pold = fromJust $ lookup pdx accu
 112         pnew = Node.setPri pold inst
 113         ac1 = deleteBy assocEqual (pdx, pold) accu
 114         ac2 = (pdx, pnew):ac1
 115     in
 116       if sdx /= Node.noSecondary
 117       then let sold = fromJust $ lookup sdx accu
 118                snew = Node.setSec sold inst
 119                ac3 = deleteBy assocEqual (sdx, sold) ac2
 120            in (sdx, snew):ac3
 121       else ac2
 122
 123 -- | Remove non-selected tags from the exclusion list
 124 filterExTags :: [String] -> Instance.Instance -> Instance.Instance
 125 filterExTags tl inst =
 126     let old_tags = Instance.tags inst
 127         new_tags = filter (\tag -> any (\extag -> isPrefixOf extag tag) tl)
 128                    old_tags
 129     in inst { Instance.tags = new_tags }
 130
 131 -- | Compute the longest common suffix of a list of strings that
 132 -- | starts with a dot.
 133 longestDomain :: [String] -> String
 134 longestDomain [] = ""
 135 longestDomain (x:xs) =
 136       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 137                               then suffix
 138                               else accu)
 139       "" $ filter (isPrefixOf ".") (tails x)
 140
 141 -- | Remove tail suffix from a string.
 142 stripSuffix :: Int -> String -> String
 143 stripSuffix sflen name = take (length name - sflen) name
 144
 145 -- | Extracts the exclusion tags from the cluster configuration
 146 extractExTags :: [String] -> [String]
 147 extractExTags =
 148     map (drop (length exTagsPrefix)) .
 149     filter (isPrefixOf exTagsPrefix)
 150
 151 -- | Initializer function that loads the data from a node and instance
 152 -- list and massages it into the correct format.
 153 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 154           -> [String]             -- ^ Exclusion tags
 155           -> (Node.AssocList, Instance.AssocList, [String])
 156           -- ^ Data from backends
 157           -> Result (Node.List, Instance.List, [String], String)
 158 mergeData um extags (nl, il, tags) =
 159   let il2 = Container.fromAssocList il
 160       il3 = foldl' (\im (name, n_util) ->
 161                         case Container.findByName im name of
 162                           Nothing -> im -- skipping unknown instance
 163                           Just inst ->
 164                               let new_i = inst { Instance.util = n_util }
 165                               in Container.add (Instance.idx inst) new_i im
 166                    ) il2 um
 167       allextags = extags ++ extractExTags tags
 168       il4 = Container.map (filterExTags allextags) il3
 169       nl2 = foldl' fixNodes nl (Container.elems il4)
 170       nl3 = Container.fromAssocList
 171             (map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
 172       node_names = map (Node.name . snd) nl
 173       inst_names = map (Instance.name . snd) il
 174       common_suffix = longestDomain (node_names ++ inst_names)
 175       csl = length common_suffix
 176       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 177       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il4
 178   in Ok (snl, sil, tags, common_suffix)
 179
 180 -- | Checks the cluster data for consistency.
 181 checkData :: Node.List -> Instance.List
 182           -> ([String], Node.List)
 183 checkData nl il =
 184     Container.mapAccum
 185         (\ msgs node ->
 186              let nname = Node.name node
 187                  nilst = map (flip Container.find il) (Node.pList node)
 188                  dilst = filter (not . Instance.running) nilst
 189                  adj_mem = sum . map Instance.mem $ dilst
 190                  delta_mem = truncate (Node.tMem node)
 191                              - Node.nMem node
 192                              - Node.fMem node
 193                              - nodeImem node il
 194                              + adj_mem
 195                  delta_dsk = truncate (Node.tDsk node)
 196                              - Node.fDsk node
 197                              - nodeIdsk node il
 198                  newn = Node.setFmem (Node.setXmem node delta_mem)
 199                         (Node.fMem node - adj_mem)
 200                  umsg1 = [printf "node %s is missing %d MB ram \
 201                                  \and %d GB disk"
 202                                  nname delta_mem (delta_dsk `div` 1024) |
 203                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 204              in (msgs ++ umsg1, newn)
 205         ) [] nl
 206
 207 -- | Compute the amount of memory used by primary instances on a node.
 208 nodeImem :: Node.Node -> Instance.List -> Int
 209 nodeImem node il =
 210     let rfind = flip Container.find il
 211     in sum . map (Instance.mem . rfind)
 212            $ Node.pList node
 213
 214 -- | Compute the amount of disk used by instances on a node (either primary
 215 -- or secondary).
 216 nodeIdsk :: Node.Node -> Instance.List -> Int
 217 nodeIdsk node il =
 218     let rfind = flip Container.find il
 219     in sum . map (Instance.dsk . rfind)
 220            $ Node.pList node ++ Node.sList node