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.List
  40 import Data.Maybe (fromJust)
  41 import Text.Printf (printf)
  42
  43 import qualified Ganeti.HTools.Container as Container
  44 import qualified Ganeti.HTools.Instance as Instance
  45 import qualified Ganeti.HTools.Node as Node
  46
  47 import Ganeti.HTools.Types
  48
  49 -- * Types
  50
  51 {-| The request type.
  52
  53 This type denotes what request we got from Ganeti and also holds
  54 request-specific fields.
  55
  56 -}
  57 data RqType
  58     = Allocate Instance.Instance Int -- ^ A new instance allocation
  59     | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
  60                                      -- secondary node
  61     deriving (Show)
  62
  63 -- | A complete request, as received from Ganeti.
  64 data Request = Request RqType Node.List Instance.List String
  65     deriving (Show)
  66
  67 -- * Functions
  68
  69 -- | Lookups a node into an assoc list.
  70 lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
  71 lookupNode ktn inst node =
  72     case lookup node ktn of
  73       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  74       Just idx -> return idx
  75
  76 -- | Lookups an instance into an assoc list.
  77 lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
  78 lookupInstance kti inst =
  79     case lookup inst kti of
  80       Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
  81       Just idx -> return idx
  82
  83 -- | Given a list of elements (and their names), assign indices to them.
  84 assignIndices :: (Element a) =>
  85                  [(String, a)]
  86               -> (NameAssoc, [(Int, a)])
  87 assignIndices =
  88     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
  89           . zip [0..]
  90
  91 -- | For each instance, add its index to its primary and secondary nodes.
  92 fixNodes :: [(Ndx, Node.Node)]
  93          -> [(Idx, Instance.Instance)]
  94          -> [(Ndx, Node.Node)]
  95 fixNodes nl il =
  96     foldl' (\accu (idx, inst) ->
  97                 let
  98                     assocEqual = (\ (i, _) (j, _) -> i == j)
  99                     pdx = Instance.pnode inst
 100                     sdx = Instance.snode inst
 101                     pold = fromJust $ lookup pdx accu
 102                     pnew = Node.setPri pold idx
 103                     pnew' = Node.addCpus pnew (Instance.vcpus inst)
 104                     ac1 = deleteBy assocEqual (pdx, pold) accu
 105                     ac2 = (pdx, pnew'):ac1
 106                 in
 107                   if sdx /= Node.noSecondary then
 108                       let
 109                           sold = fromJust $ lookup sdx accu
 110                           snew = Node.setSec sold idx
 111                           ac3 = deleteBy assocEqual (sdx, sold) ac2
 112                           ac4 = (sdx, snew):ac3
 113                       in ac4
 114                   else
 115                       ac2
 116            ) nl il
 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 :: (Node.AssocList,
 135               Instance.AssocList) -- ^ Data from either Text.loadData
 136                                   -- or Rapi.loadData
 137           -> Result (Node.List, Instance.List, String)
 138 mergeData (nl, il) = do
 139   let
 140       nl2 = fixNodes nl il
 141       il3 = Container.fromAssocList il
 142       nl3 = Container.fromAssocList
 143             (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
 144       node_names = map Node.name $ Container.elems nl3
 145       inst_names = map Instance.name $ Container.elems il3
 146       common_suffix = longestDomain (node_names ++ inst_names)
 147       csl = length common_suffix
 148       snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
 149       sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
 150   return (snl, sil, common_suffix)
 151
 152 -- | Checks the cluster data for consistency.
 153 checkData :: Node.List -> Instance.List
 154           -> ([String], Node.List)
 155 checkData nl il =
 156     Container.mapAccum
 157         (\ msgs node ->
 158              let nname = Node.name node
 159                  nilst = map (flip Container.find $ il) (Node.plist node)
 160                  dilst = filter (not . Instance.running) nilst
 161                  adj_mem = sum . map Instance.mem $ dilst
 162                  delta_mem = (truncate $ Node.t_mem node)
 163                              - (Node.n_mem node)
 164                              - (Node.f_mem node)
 165                              - (nodeImem node il)
 166                              + adj_mem
 167                  delta_dsk = (truncate $ Node.t_dsk node)
 168                              - (Node.f_dsk node)
 169                              - (nodeIdsk node il)
 170                  newn = Node.setFmem (Node.setXmem node delta_mem)
 171                         (Node.f_mem node - adj_mem)
 172                  umsg1 = if delta_mem > 512 || delta_dsk > 1024
 173                          then [printf "node %s is missing %d MB ram \
 174                                      \and %d GB disk"
 175                                      nname delta_mem (delta_dsk `div` 1024)]
 176                          else []
 177              in (msgs ++ umsg1, newn)
 178         ) [] nl
 179
 180 -- | Compute the amount of memory used by primary instances on a node.
 181 nodeImem :: Node.Node -> Instance.List -> Int
 182 nodeImem node il =
 183     let rfind = flip Container.find $ il
 184     in sum . map Instance.mem .
 185        map rfind $ Node.plist node
 186
 187 -- | Compute the amount of disk used by instances on a node (either primary
 188 -- or secondary).
 189 nodeIdsk :: Node.Node -> Instance.List -> Int
 190 nodeIdsk node il =
 191     let rfind = flip Container.find $ il
 192     in sum . map Instance.dsk .
 193        map rfind $ (Node.plist node) ++ (Node.slist node)