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