code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Loader.hs

   1 {-| Loading data from external sources
   2
   3 This module holds the common code for loading the cluster state from external sources.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2009 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.HTools.Loader
  29     ( mergeData
  30     , checkData
  31     , assignIndices
  32     , lookupNode
  33     , lookupInstance
  34     , stripSuffix
  35     , RqType(..)
  36     , Request(..)
  37     ) where
  38
  39 import Data.Function (on)
  40 import Data.List
  41 import Data.Maybe (fromJust)
  42 import Text.Printf (printf)
  43
  44 import qualified Ganeti.HTools.Container as Container
  45 import qualified Ganeti.HTools.Instance as Instance
  46 import qualified Ganeti.HTools.Node as Node
  47
  48 import Ganeti.HTools.Types
  49
  50 -- * Types
  51
  52 {-| The request type.
  53
  54 This type denotes what request we got from Ganeti and also holds
  55 request-specific fields.
  56
  57 -}
  58 data RqType
  59     = Allocate Instance.Instance Int -- ^ A new instance allocation
  60     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  61                                      -- secondary node
  62     deriving (Show)
  63
  64 -- | A complete request, as received from Ganeti.
  65 data Request = Request RqType Node.List Instance.List String
  66     deriving (Show)
  67
  68 -- * Functions
  69
  70 -- | Lookups a node into an assoc list.
  71 lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
  72 lookupNode ktn inst node =
  73     case lookup node ktn of
  74       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  75       Just idx -> return idx
  76
  77 -- | Lookups an instance into an assoc list.
  78 lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
  79 lookupInstance kti inst =
  80     case lookup inst kti of
  81       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  82       Just idx -> return idx
  83
  84 -- | Given a list of elements (and their names), assign indices to them.
  85 assignIndices :: (Element a) =>
  86                  [(String, a)]
  87               -> (NameAssoc, [(Int, a)])
  88 assignIndices =
  89     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  90           . zip [0..]
  91
  92 -- | Assoc element comparator
  93 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
  94 assocEqual = (==) `on` fst
  95
  96 -- | For each instance, add its index to its primary and secondary nodes.
  97 fixNodes :: [(Ndx, Node.Node)]
  98          -> [(Idx, Instance.Instance)]
  99          -> [(Ndx, Node.Node)]
 100 fixNodes =
 101     foldl' (\accu (idx, inst) ->
 102                 let
 103                     pdx = Instance.pnode inst
 104                     sdx = Instance.snode inst
 105                     pold = fromJust $ lookup pdx accu
 106                     pnew = Node.setPri pold idx
 107                     pnew' = Node.addCpus pnew (Instance.vcpus inst)
 108                     ac1 = deleteBy assocEqual (pdx, pold) accu
 109                     ac2 = (pdx, pnew'):ac1
 110                 in
 111                   if sdx /= Node.noSecondary then
 112                       let
 113                           sold = fromJust $ lookup sdx accu
 114                           snew = Node.setSec sold idx
 115                           ac3 = deleteBy assocEqual (sdx, sold) ac2
 116                           ac4 = (sdx, snew):ac3
 117                       in ac4
 118                   else
 119                       ac2
 120            )
 121
 122 -- | Compute the longest common suffix of a list of strings that
 123 -- | starts with a dot.
 124 longestDomain :: [String] -> String
 125 longestDomain [] = ""
 126 longestDomain (x:xs) =
 127       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 128                               then suffix
 129                               else accu)
 130       "" $ filter (isPrefixOf ".") (tails x)
 131
 132 -- | Remove tail suffix from a string.
 133 stripSuffix :: Int -> String -> String
 134 stripSuffix sflen name = take (length name - sflen) name
 135
 136 -- | Initializer function that loads the data from a node and instance
 137 -- list and massages it into the correct format.
 138 mergeData :: (Node.AssocList,
 139               Instance.AssocList) -- ^ Data from either Text.loadData
 140                                   -- or Rapi.loadData
 141           -> Result (Node.List, Instance.List, String)
 142 mergeData (nl, il) = do
 143   let
 144       nl2 = fixNodes nl il
 145       il3 = Container.fromAssocList il
 146       nl3 = Container.fromAssocList
 147             (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
 148       node_names = map Node.name $ Container.elems nl3
 149       inst_names = map Instance.name $ Container.elems il3
 150       common_suffix = longestDomain (node_names ++ inst_names)
 151       csl = length common_suffix
 152       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 153       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
 154   return (snl, sil, common_suffix)
 155
 156 -- | Checks the cluster data for consistency.
 157 checkData :: Node.List -> Instance.List
 158           -> ([String], Node.List)
 159 checkData nl il =
 160     Container.mapAccum
 161         (\ msgs node ->
 162              let nname = Node.name node
 163                  nilst = map (flip Container.find il) (Node.plist node)
 164                  dilst = filter (not . Instance.running) nilst
 165                  adj_mem = sum . map Instance.mem $ dilst
 166                  delta_mem = truncate (Node.t_mem node)
 167                              - Node.n_mem node
 168                              - Node.f_mem node
 169                              - nodeImem node il
 170                              + adj_mem
 171                  delta_dsk = truncate (Node.t_dsk node)
 172                              - Node.f_dsk node
 173                              - nodeIdsk node il
 174                  newn = Node.setFmem (Node.setXmem node delta_mem)
 175                         (Node.f_mem node - adj_mem)
 176                  umsg1 = [printf "node %s is missing %d MB ram \
 177                                  \and %d GB disk"
 178                                  nname delta_mem (delta_dsk `div` 1024) |
 179                                  delta_mem > 512 || delta_dsk > 1024]::[String]
 180              in (msgs ++ umsg1, newn)
 181         ) [] nl
 182
 183 -- | Compute the amount of memory used by primary instances on a node.
 184 nodeImem :: Node.Node -> Instance.List -> Int
 185 nodeImem node il =
 186     let rfind = flip Container.find il
 187     in sum . map (Instance.mem . rfind)
 188            $ Node.plist node
 189
 190 -- | Compute the amount of disk used by instances on a node (either primary
 191 -- or secondary).
 192 nodeIdsk :: Node.Node -> Instance.List -> Int
 193 nodeIdsk node il =
 194     let rfind = flip Container.find il
 195     in sum . map (Instance.dsk . rfind)
 196            $ Node.plist node ++ Node.slist node