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
  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 -- | Compute the longest common suffix of a list of strings that
 118 -- | starts with a dot.
 119 longestDomain :: [String] -> String
 120 longestDomain [] = ""
 121 longestDomain (x:xs) =
 122       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 123                               then suffix
 124                               else accu)
 125       "" $ filter (isPrefixOf ".") (tails x)
 126
 127 -- | Remove tail suffix from a string.
 128 stripSuffix :: Int -> String -> String
 129 stripSuffix sflen name = take (length name - sflen) name
 130
 131 -- | Initializer function that loads the data from a node and instance
 132 -- list and massages it into the correct format.
 133 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 134           -> (Node.AssocList,
 135               Instance.AssocList) -- ^ Data from either Text.loadData
 136                                   -- or Rapi.loadData
 137           -> Result (Node.List, Instance.List, String)
 138 mergeData um (nl, il) =
 139   let il2 = Container.fromAssocList il
 140       il3 = foldl' (\im (name, n_util) ->
 141                         case Container.findByName im name of
 142                           Nothing -> im -- skipping unknown instance
 143                           Just inst ->
 144                               let new_i = inst { Instance.util = n_util }
 145                               in Container.add (Instance.idx inst) new_i im
 146                    ) il2 um
 147       nl2 = foldl' fixNodes nl (Container.elems il3)
 148       nl3 = Container.fromAssocList
 149             (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
 150       node_names = map (Node.name . snd) nl
 151       inst_names = map (Instance.name . snd) il
 152       common_suffix = longestDomain (node_names ++ inst_names)
 153       csl = length common_suffix
 154       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 155       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
 156   in Ok (snl, sil, common_suffix)
 157
 158 -- | Checks the cluster data for consistency.
 159 checkData :: Node.List -> Instance.List
 160           -> ([String], Node.List)
 161 checkData nl il =
 162     Container.mapAccum
 163         (\ msgs node ->
 164              let nname = Node.name node
 165                  nilst = map (flip Container.find il) (Node.pList node)
 166                  dilst = filter (not . Instance.running) nilst
 167                  adj_mem = sum . map Instance.mem $ dilst
 168                  delta_mem = truncate (Node.tMem node)
 169                              - Node.nMem node
 170                              - Node.fMem node
 171                              - nodeImem node il
 172                              + adj_mem
 173                  delta_dsk = truncate (Node.tDsk node)
 174                              - Node.fDsk node
 175                              - nodeIdsk node il
 176                  newn = Node.setFmem (Node.setXmem node delta_mem)
 177                         (Node.fMem node - adj_mem)
 178                  umsg1 = [printf "node %s is missing %d MB ram \
 179                                  \and %d GB disk"
 180                                  nname delta_mem (delta_dsk `div` 1024) |
 181                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 182              in (msgs ++ umsg1, newn)
 183         ) [] nl
 184
 185 -- | Compute the amount of memory used by primary instances on a node.
 186 nodeImem :: Node.Node -> Instance.List -> Int
 187 nodeImem node il =
 188     let rfind = flip Container.find il
 189     in sum . map (Instance.mem . rfind)
 190            $ Node.pList node
 191
 192 -- | Compute the amount of disk used by instances on a node (either primary
 193 -- or secondary).
 194 nodeIdsk :: Node.Node -> Instance.List -> Int
 195 nodeIdsk node il =
 196     let rfind = flip Container.find il
 197     in sum . map (Instance.dsk . rfind)
 198            $ Node.pList node ++ Node.sList node