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          -> (Idx, 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 :: (Node.AssocList,
 134               Instance.AssocList) -- ^ Data from either Text.loadData
 135                                   -- or Rapi.loadData
 136           -> Result (Node.List, Instance.List, String)
 137 mergeData (nl, il) = do
 138   let
 139       nl2 = foldl' fixNodes nl il
 140       il3 = Container.fromAssocList il
 141       nl3 = Container.fromAssocList
 142             (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
 143       node_names = map Node.name $ Container.elems nl3
 144       inst_names = map Instance.name $ Container.elems il3
 145       common_suffix = longestDomain (node_names ++ inst_names)
 146       csl = length common_suffix
 147       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 148       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
 149   return (snl, sil, common_suffix)
 150
 151 -- | Checks the cluster data for consistency.
 152 checkData :: Node.List -> Instance.List
 153           -> ([String], Node.List)
 154 checkData nl il =
 155     Container.mapAccum
 156         (\ msgs node ->
 157              let nname = Node.name node
 158                  nilst = map (flip Container.find il) (Node.pList node)
 159                  dilst = filter (not . Instance.running) nilst
 160                  adj_mem = sum . map Instance.mem $ dilst
 161                  delta_mem = truncate (Node.tMem node)
 162                              - Node.nMem node
 163                              - Node.fMem node
 164                              - nodeImem node il
 165                              + adj_mem
 166                  delta_dsk = truncate (Node.tDsk node)
 167                              - Node.fDsk node
 168                              - nodeIdsk node il
 169                  newn = Node.setFmem (Node.setXmem node delta_mem)
 170                         (Node.fMem node - adj_mem)
 171                  umsg1 = [printf "node %s is missing %d MB ram \
 172                                  \and %d GB disk"
 173                                  nname delta_mem (delta_dsk `div` 1024) |
 174                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 175              in (msgs ++ umsg1, newn)
 176         ) [] nl
 177
 178 -- | Compute the amount of memory used by primary instances on a node.
 179 nodeImem :: Node.Node -> Instance.List -> Int
 180 nodeImem node il =
 181     let rfind = flip Container.find il
 182     in sum . map (Instance.mem . rfind)
 183            $ Node.pList node
 184
 185 -- | Compute the amount of disk used by instances on a node (either primary
 186 -- or secondary).
 187 nodeIdsk :: Node.Node -> Instance.List -> Int
 188 nodeIdsk node il =
 189     let rfind = flip Container.find il
 190     in sum . map (Instance.dsk . rfind)
 191            $ Node.pList node ++ Node.sList node