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 Control.Monad (foldM)
  41 import Data.Function (on)
  42 import Data.List
  43 import Data.Maybe (fromJust)
  44 import Text.Printf (printf)
  45
  46 import qualified Ganeti.HTools.Container as Container
  47 import qualified Ganeti.HTools.Instance as Instance
  48 import qualified Ganeti.HTools.Node as Node
  49
  50 import Ganeti.HTools.Types
  51
  52 -- * Types
  53
  54 {-| The request type.
  55
  56 This type denotes what request we got from Ganeti and also holds
  57 request-specific fields.
  58
  59 -}
  60 data RqType
  61     = Allocate Instance.Instance Int -- ^ A new instance allocation
  62     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  63                                      -- secondary node
  64     deriving (Show)
  65
  66 -- | A complete request, as received from Ganeti.
  67 data Request = Request RqType Node.List Instance.List String
  68     deriving (Show)
  69
  70 -- * Functions
  71
  72 -- | Lookups a node into an assoc list.
  73 lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
  74 lookupNode ktn inst node =
  75     case lookup node ktn of
  76       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  77       Just idx -> return idx
  78
  79 -- | Lookups an instance into an assoc list.
  80 lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
  81 lookupInstance kti inst =
  82     case lookup inst kti of
  83       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  84       Just idx -> return idx
  85
  86 -- | Given a list of elements (and their names), assign indices to them.
  87 assignIndices :: (Element a) =>
  88                  [(String, a)]
  89               -> (NameAssoc, [(Int, a)])
  90 assignIndices =
  91     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  92           . zip [0..]
  93
  94 -- | Assoc element comparator
  95 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
  96 assocEqual = (==) `on` fst
  97
  98 -- | For each instance, add its index to its primary and secondary nodes.
  99 fixNodes :: [(Ndx, Node.Node)]
 100          -> Instance.Instance
 101          -> [(Ndx, Node.Node)]
 102 fixNodes accu inst =
 103     let
 104         pdx = Instance.pNode inst
 105         sdx = Instance.sNode inst
 106         pold = fromJust $ lookup pdx accu
 107         pnew = Node.setPri pold inst
 108         ac1 = deleteBy assocEqual (pdx, pold) accu
 109         ac2 = (pdx, pnew):ac1
 110     in
 111       if sdx /= Node.noSecondary
 112       then let sold = fromJust $ lookup sdx accu
 113                snew = Node.setSec sold inst
 114                ac3 = deleteBy assocEqual (sdx, sold) ac2
 115            in (sdx, snew):ac3
 116       else ac2
 117
 118 -- | Compute the longest common suffix of a list of strings that
 119 -- | starts with a dot.
 120 longestDomain :: [String] -> String
 121 longestDomain [] = ""
 122 longestDomain (x:xs) =
 123       foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
 124                               then suffix
 125                               else accu)
 126       "" $ filter (isPrefixOf ".") (tails x)
 127
 128 -- | Remove tail suffix from a string.
 129 stripSuffix :: Int -> String -> String
 130 stripSuffix sflen name = take (length name - sflen) name
 131
 132 -- | Initializer function that loads the data from a node and instance
 133 -- list and massages it into the correct format.
 134 mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
 135           -> (Node.AssocList,
 136               Instance.AssocList) -- ^ Data from either Text.loadData
 137                                   -- or Rapi.loadData
 138           -> Result (Node.List, Instance.List, String)
 139 mergeData um (nl, il) = do
 140   let il2 = Container.fromAssocList il
 141   il3 <- foldM (\im (name, n_util) -> do
 142                   idx <- Container.findByName im name
 143                   let inst = Container.find idx im
 144                       new_i = inst { Instance.util = n_util }
 145                   return $ Container.add idx new_i im
 146                ) il2 um
 147   let nl2 = foldl' fixNodes nl (Container.elems il3)
 148   let nl3 = Container.fromAssocList
 149             (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
 150       node_names = map Node.name $ Container.elems nl3
 151       inst_names = map Instance.name $ Container.elems il3
 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   return (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