1 {-| Loading data from external sources
3 This module holds the common code for loading the cluster state from external sources.
9 Copyright (C) 2009 Google Inc.
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.
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.
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
28 module Ganeti.HTools.Loader
39 import Data.Function (on)
41 import Data.Maybe (fromJust)
42 import Text.Printf (printf)
44 import qualified Ganeti.HTools.Container as Container
45 import qualified Ganeti.HTools.Instance as Instance
46 import qualified Ganeti.HTools.Node as Node
48 import Ganeti.HTools.Types
54 This type denotes what request we got from Ganeti and also holds
55 request-specific fields.
59 = Allocate Instance.Instance Int -- ^ A new instance allocation
60 | Relocate Idx Int [Ndx] -- ^ Move an instance to a new
64 -- | A complete request, as received from Ganeti.
65 data Request = Request RqType Node.List Instance.List String
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
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
84 -- | Given a list of elements (and their names), assign indices to them.
85 assignIndices :: (Element a) =>
87 -> (NameAssoc, [(Int, a)])
89 unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
92 -- | Assoc element comparator
93 assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
94 assocEqual = (==) `on` fst
96 -- | For each instance, add its index to its primary and secondary nodes.
97 fixNodes :: [(Ndx, Node.Node)]
98 -> (Idx, Instance.Instance)
100 fixNodes accu (idx, inst) =
102 pdx = Instance.pnode inst
103 sdx = Instance.snode inst
104 pold = fromJust $ lookup pdx accu
105 pnew = Node.setPri pold idx
106 pnew' = Node.addCpus pnew (Instance.vcpus inst)
107 ac1 = deleteBy assocEqual (pdx, pold) accu
108 ac2 = (pdx, pnew'):ac1
110 if sdx /= Node.noSecondary
111 then let sold = fromJust $ lookup sdx accu
112 snew = Node.setSec sold idx
113 ac3 = deleteBy assocEqual (sdx, sold) ac2
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
125 "" $ filter (isPrefixOf ".") (tails x)
127 -- | Remove tail suffix from a string.
128 stripSuffix :: Int -> String -> String
129 stripSuffix sflen name = take (length name - sflen) name
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
136 -> Result (Node.List, Instance.List, String)
137 mergeData (nl, il) = do
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)
151 -- | Checks the cluster data for consistency.
152 checkData :: Node.List -> Instance.List
153 -> ([String], Node.List)
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.t_mem node)
166 delta_dsk = truncate (Node.t_dsk node)
169 newn = Node.setFmem (Node.setXmem node delta_mem)
170 (Node.f_mem node - adj_mem)
171 umsg1 = [printf "node %s is missing %d MB ram \
173 nname delta_mem (delta_dsk `div` 1024) |
174 delta_mem > 512 || delta_dsk > 1024]::[String]
175 in (msgs ++ umsg1, newn)
178 -- | Compute the amount of memory used by primary instances on a node.
179 nodeImem :: Node.Node -> Instance.List -> Int
181 let rfind = flip Container.find il
182 in sum . map (Instance.mem . rfind)
185 -- | Compute the amount of disk used by instances on a node (either primary
187 nodeIdsk :: Node.Node -> Instance.List -> Int
189 let rfind = flip Container.find il
190 in sum . map (Instance.dsk . rfind)
191 $ Node.plist node ++ Node.slist node