Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Cluster.hs @ 241cea1e

History | View | Annotate | Download (67.2 kB)

1 e4f08c46 Iustin Pop
{-| Implementation of cluster-wide logic.
2 e4f08c46 Iustin Pop
3 e4f08c46 Iustin Pop
This module holds all pure cluster-logic; I\/O related functionality
4 525bfb36 Iustin Pop
goes into the /Main/ module for the individual binaries.
5 e4f08c46 Iustin Pop
6 e4f08c46 Iustin Pop
-}
7 e4f08c46 Iustin Pop
8 e2fa2baf Iustin Pop
{-
9 e2fa2baf Iustin Pop
10 6d3d13ab Iustin Pop
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
11 e2fa2baf Iustin Pop
12 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
13 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
14 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
15 e2fa2baf Iustin Pop
(at your option) any later version.
16 e2fa2baf Iustin Pop
17 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
18 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
19 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20 e2fa2baf Iustin Pop
General Public License for more details.
21 e2fa2baf Iustin Pop
22 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
23 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
24 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25 e2fa2baf Iustin Pop
02110-1301, USA.
26 e2fa2baf Iustin Pop
27 e2fa2baf Iustin Pop
-}
28 e2fa2baf Iustin Pop
29 669d7e3d Iustin Pop
module Ganeti.HTools.Cluster
30 f23f21c3 Iustin Pop
  (
31 f23f21c3 Iustin Pop
    -- * Types
32 f23f21c3 Iustin Pop
    AllocSolution(..)
33 f23f21c3 Iustin Pop
  , EvacSolution(..)
34 f23f21c3 Iustin Pop
  , Table(..)
35 f23f21c3 Iustin Pop
  , CStats(..)
36 f23f21c3 Iustin Pop
  , AllocResult
37 f23f21c3 Iustin Pop
  , AllocMethod
38 c85abf30 René Nussbaumer
  , AllocSolutionList
39 f23f21c3 Iustin Pop
  -- * Generic functions
40 f23f21c3 Iustin Pop
  , totalResources
41 f23f21c3 Iustin Pop
  , computeAllocationDelta
42 f23f21c3 Iustin Pop
  -- * First phase functions
43 f23f21c3 Iustin Pop
  , computeBadItems
44 f23f21c3 Iustin Pop
  -- * Second phase functions
45 f23f21c3 Iustin Pop
  , printSolutionLine
46 f23f21c3 Iustin Pop
  , formatCmds
47 f23f21c3 Iustin Pop
  , involvedNodes
48 f23f21c3 Iustin Pop
  , splitJobs
49 f23f21c3 Iustin Pop
  -- * Display functions
50 f23f21c3 Iustin Pop
  , printNodes
51 f23f21c3 Iustin Pop
  , printInsts
52 f23f21c3 Iustin Pop
  -- * Balacing functions
53 f23f21c3 Iustin Pop
  , checkMove
54 f23f21c3 Iustin Pop
  , doNextBalance
55 f23f21c3 Iustin Pop
  , tryBalance
56 f23f21c3 Iustin Pop
  , compCV
57 f23f21c3 Iustin Pop
  , compCVNodes
58 f23f21c3 Iustin Pop
  , compDetailedCV
59 f23f21c3 Iustin Pop
  , printStats
60 f23f21c3 Iustin Pop
  , iMoveToJob
61 f23f21c3 Iustin Pop
  -- * IAllocator functions
62 f23f21c3 Iustin Pop
  , genAllocNodes
63 f23f21c3 Iustin Pop
  , tryAlloc
64 f23f21c3 Iustin Pop
  , tryMGAlloc
65 f23f21c3 Iustin Pop
  , tryNodeEvac
66 f23f21c3 Iustin Pop
  , tryChangeGroup
67 f23f21c3 Iustin Pop
  , collapseFailures
68 c85abf30 René Nussbaumer
  , allocList
69 f23f21c3 Iustin Pop
  -- * Allocation functions
70 f23f21c3 Iustin Pop
  , iterateAlloc
71 f23f21c3 Iustin Pop
  , tieredAlloc
72 f23f21c3 Iustin Pop
  -- * Node group functions
73 f23f21c3 Iustin Pop
  , instanceGroup
74 f23f21c3 Iustin Pop
  , findSplitInstances
75 f23f21c3 Iustin Pop
  , splitCluster
76 f23f21c3 Iustin Pop
  ) where
77 e4f08c46 Iustin Pop
78 63a78055 Iustin Pop
import qualified Data.IntSet as IntSet
79 e4f08c46 Iustin Pop
import Data.List
80 129734d3 Iustin Pop
import Data.Maybe (fromJust, isNothing)
81 5182e970 Iustin Pop
import Data.Ord (comparing)
82 e4f08c46 Iustin Pop
import Text.Printf (printf)
83 e4f08c46 Iustin Pop
84 01e52493 Iustin Pop
import Ganeti.BasicTypes
85 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Container as Container
86 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
87 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Node as Node
88 aec636b9 Iustin Pop
import qualified Ganeti.HTools.Group as Group
89 e4c5beaf Iustin Pop
import Ganeti.HTools.Types
90 f3baf5ef Iustin Pop
import Ganeti.Compat
91 6b20875c Iustin Pop
import qualified Ganeti.OpCodes as OpCodes
92 26d62e4c Iustin Pop
import Ganeti.Utils
93 c7d249d0 Iustin Pop
import Ganeti.Types (mkNonEmpty)
94 e4f08c46 Iustin Pop
95 9188aeef Iustin Pop
-- * Types
96 9188aeef Iustin Pop
97 0c936d24 Iustin Pop
-- | Allocation\/relocation solution.
98 85d0ddc3 Iustin Pop
data AllocSolution = AllocSolution
99 129734d3 Iustin Pop
  { asFailures :: [FailMode]              -- ^ Failure counts
100 129734d3 Iustin Pop
  , asAllocs   :: Int                     -- ^ Good allocation count
101 129734d3 Iustin Pop
  , asSolution :: Maybe Node.AllocElement -- ^ The actual allocation result
102 129734d3 Iustin Pop
  , asLog      :: [String]                -- ^ Informational messages
103 85d0ddc3 Iustin Pop
  }
104 85d0ddc3 Iustin Pop
105 47eed3f4 Iustin Pop
-- | Node evacuation/group change iallocator result type. This result
106 47eed3f4 Iustin Pop
-- type consists of actual opcodes (a restricted subset) that are
107 47eed3f4 Iustin Pop
-- transmitted back to Ganeti.
108 47eed3f4 Iustin Pop
data EvacSolution = EvacSolution
109 f23f21c3 Iustin Pop
  { esMoved   :: [(Idx, Gdx, [Ndx])]  -- ^ Instances moved successfully
110 f23f21c3 Iustin Pop
  , esFailed  :: [(Idx, String)]      -- ^ Instances which were not
111 f23f21c3 Iustin Pop
                                      -- relocated
112 f23f21c3 Iustin Pop
  , esOpCodes :: [[OpCodes.OpCode]]   -- ^ List of jobs
113 6a855aaa Iustin Pop
  } deriving (Show)
114 47eed3f4 Iustin Pop
115 40ee14bc Iustin Pop
-- | Allocation results, as used in 'iterateAlloc' and 'tieredAlloc'.
116 40ee14bc Iustin Pop
type AllocResult = (FailStats, Node.List, Instance.List,
117 40ee14bc Iustin Pop
                    [Instance.Instance], [CStats])
118 40ee14bc Iustin Pop
119 c85abf30 René Nussbaumer
-- | Type alias for easier handling.
120 c85abf30 René Nussbaumer
type AllocSolutionList = [(Instance.Instance, AllocSolution)]
121 c85abf30 René Nussbaumer
122 6cb1649f Iustin Pop
-- | A type denoting the valid allocation mode/pairs.
123 525bfb36 Iustin Pop
--
124 b0631f10 Iustin Pop
-- For a one-node allocation, this will be a @Left ['Ndx']@, whereas
125 b0631f10 Iustin Pop
-- for a two-node allocation, this will be a @Right [('Ndx',
126 b0631f10 Iustin Pop
-- ['Ndx'])]@. In the latter case, the list is basically an
127 b0631f10 Iustin Pop
-- association list, grouped by primary node and holding the potential
128 b0631f10 Iustin Pop
-- secondary nodes in the sub-list.
129 b0631f10 Iustin Pop
type AllocNodes = Either [Ndx] [(Ndx, [Ndx])]
130 6cb1649f Iustin Pop
131 525bfb36 Iustin Pop
-- | The empty solution we start with when computing allocations.
132 97936d51 Iustin Pop
emptyAllocSolution :: AllocSolution
133 97936d51 Iustin Pop
emptyAllocSolution = AllocSolution { asFailures = [], asAllocs = 0
134 129734d3 Iustin Pop
                                   , asSolution = Nothing, asLog = [] }
135 78694255 Iustin Pop
136 47eed3f4 Iustin Pop
-- | The empty evac solution.
137 47eed3f4 Iustin Pop
emptyEvacSolution :: EvacSolution
138 47eed3f4 Iustin Pop
emptyEvacSolution = EvacSolution { esMoved = []
139 47eed3f4 Iustin Pop
                                 , esFailed = []
140 47eed3f4 Iustin Pop
                                 , esOpCodes = []
141 47eed3f4 Iustin Pop
                                 }
142 47eed3f4 Iustin Pop
143 525bfb36 Iustin Pop
-- | The complete state for the balancing solution.
144 262a08a2 Iustin Pop
data Table = Table Node.List Instance.List Score [Placement]
145 139c0683 Iustin Pop
             deriving (Show)
146 e4f08c46 Iustin Pop
147 179c0828 Iustin Pop
-- | Cluster statistics data type.
148 33e17565 Iustin Pop
data CStats = CStats
149 33e17565 Iustin Pop
  { csFmem :: Integer -- ^ Cluster free mem
150 33e17565 Iustin Pop
  , csFdsk :: Integer -- ^ Cluster free disk
151 33e17565 Iustin Pop
  , csAmem :: Integer -- ^ Cluster allocatable mem
152 33e17565 Iustin Pop
  , csAdsk :: Integer -- ^ Cluster allocatable disk
153 33e17565 Iustin Pop
  , csAcpu :: Integer -- ^ Cluster allocatable cpus
154 33e17565 Iustin Pop
  , csMmem :: Integer -- ^ Max node allocatable mem
155 33e17565 Iustin Pop
  , csMdsk :: Integer -- ^ Max node allocatable disk
156 33e17565 Iustin Pop
  , csMcpu :: Integer -- ^ Max node allocatable cpu
157 33e17565 Iustin Pop
  , csImem :: Integer -- ^ Instance used mem
158 33e17565 Iustin Pop
  , csIdsk :: Integer -- ^ Instance used disk
159 33e17565 Iustin Pop
  , csIcpu :: Integer -- ^ Instance used cpu
160 33e17565 Iustin Pop
  , csTmem :: Double  -- ^ Cluster total mem
161 33e17565 Iustin Pop
  , csTdsk :: Double  -- ^ Cluster total disk
162 33e17565 Iustin Pop
  , csTcpu :: Double  -- ^ Cluster total cpus
163 90c2f1e8 Iustin Pop
  , csVcpu :: Integer -- ^ Cluster total virtual cpus
164 90c2f1e8 Iustin Pop
  , csNcpu :: Double  -- ^ Equivalent to 'csIcpu' but in terms of
165 90c2f1e8 Iustin Pop
                      -- physical CPUs, i.e. normalised used phys CPUs
166 33e17565 Iustin Pop
  , csXmem :: Integer -- ^ Unnacounted for mem
167 33e17565 Iustin Pop
  , csNmem :: Integer -- ^ Node own memory
168 33e17565 Iustin Pop
  , csScore :: Score  -- ^ The cluster score
169 33e17565 Iustin Pop
  , csNinst :: Int    -- ^ The total number of instances
170 139c0683 Iustin Pop
  } deriving (Show)
171 1a7eff0e Iustin Pop
172 7eda951b Iustin Pop
-- | A simple type for allocation functions.
173 7eda951b Iustin Pop
type AllocMethod =  Node.List           -- ^ Node list
174 7eda951b Iustin Pop
                 -> Instance.List       -- ^ Instance list
175 7eda951b Iustin Pop
                 -> Maybe Int           -- ^ Optional allocation limit
176 7eda951b Iustin Pop
                 -> Instance.Instance   -- ^ Instance spec for allocation
177 7eda951b Iustin Pop
                 -> AllocNodes          -- ^ Which nodes we should allocate on
178 7eda951b Iustin Pop
                 -> [Instance.Instance] -- ^ Allocated instances
179 7eda951b Iustin Pop
                 -> [CStats]            -- ^ Running cluster stats
180 7eda951b Iustin Pop
                 -> Result AllocResult  -- ^ Allocation result
181 7eda951b Iustin Pop
182 bebe7a73 Iustin Pop
-- | A simple type for the running solution of evacuations.
183 bebe7a73 Iustin Pop
type EvacInnerState =
184 bebe7a73 Iustin Pop
  Either String (Node.List, Instance.Instance, Score, Ndx)
185 bebe7a73 Iustin Pop
186 9188aeef Iustin Pop
-- * Utility functions
187 9188aeef Iustin Pop
188 e4f08c46 Iustin Pop
-- | Verifies the N+1 status and return the affected nodes.
189 e4f08c46 Iustin Pop
verifyN1 :: [Node.Node] -> [Node.Node]
190 9f6dcdea Iustin Pop
verifyN1 = filter Node.failN1
191 e4f08c46 Iustin Pop
192 9188aeef Iustin Pop
{-| Computes the pair of bad nodes and instances.
193 9188aeef Iustin Pop
194 9188aeef Iustin Pop
The bad node list is computed via a simple 'verifyN1' check, and the
195 9188aeef Iustin Pop
bad instance list is the list of primary and secondary instances of
196 9188aeef Iustin Pop
those nodes.
197 9188aeef Iustin Pop
198 9188aeef Iustin Pop
-}
199 9188aeef Iustin Pop
computeBadItems :: Node.List -> Instance.List ->
200 9188aeef Iustin Pop
                   ([Node.Node], [Instance.Instance])
201 9188aeef Iustin Pop
computeBadItems nl il =
202 dbba5246 Iustin Pop
  let bad_nodes = verifyN1 $ getOnline nl
203 5182e970 Iustin Pop
      bad_instances = map (`Container.find` il) .
204 9f6dcdea Iustin Pop
                      sort . nub $
205 2060348b Iustin Pop
                      concatMap (\ n -> Node.sList n ++ Node.pList n) bad_nodes
206 9188aeef Iustin Pop
  in
207 9188aeef Iustin Pop
    (bad_nodes, bad_instances)
208 9188aeef Iustin Pop
209 255f55a9 Iustin Pop
-- | Extracts the node pairs for an instance. This can fail if the
210 255f55a9 Iustin Pop
-- instance is single-homed. FIXME: this needs to be improved,
211 255f55a9 Iustin Pop
-- together with the general enhancement for handling non-DRBD moves.
212 255f55a9 Iustin Pop
instanceNodes :: Node.List -> Instance.Instance ->
213 255f55a9 Iustin Pop
                 (Ndx, Ndx, Node.Node, Node.Node)
214 255f55a9 Iustin Pop
instanceNodes nl inst =
215 255f55a9 Iustin Pop
  let old_pdx = Instance.pNode inst
216 255f55a9 Iustin Pop
      old_sdx = Instance.sNode inst
217 255f55a9 Iustin Pop
      old_p = Container.find old_pdx nl
218 255f55a9 Iustin Pop
      old_s = Container.find old_sdx nl
219 255f55a9 Iustin Pop
  in (old_pdx, old_sdx, old_p, old_s)
220 255f55a9 Iustin Pop
221 525bfb36 Iustin Pop
-- | Zero-initializer for the CStats type.
222 1a7eff0e Iustin Pop
emptyCStats :: CStats
223 90c2f1e8 Iustin Pop
emptyCStats = CStats 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
224 1a7eff0e Iustin Pop
225 525bfb36 Iustin Pop
-- | Update stats with data from a new node.
226 1a7eff0e Iustin Pop
updateCStats :: CStats -> Node.Node -> CStats
227 1a7eff0e Iustin Pop
updateCStats cs node =
228 f23f21c3 Iustin Pop
  let CStats { csFmem = x_fmem, csFdsk = x_fdsk,
229 f23f21c3 Iustin Pop
               csAmem = x_amem, csAcpu = x_acpu, csAdsk = x_adsk,
230 f23f21c3 Iustin Pop
               csMmem = x_mmem, csMdsk = x_mdsk, csMcpu = x_mcpu,
231 f23f21c3 Iustin Pop
               csImem = x_imem, csIdsk = x_idsk, csIcpu = x_icpu,
232 f23f21c3 Iustin Pop
               csTmem = x_tmem, csTdsk = x_tdsk, csTcpu = x_tcpu,
233 90c2f1e8 Iustin Pop
               csVcpu = x_vcpu, csNcpu = x_ncpu,
234 f23f21c3 Iustin Pop
               csXmem = x_xmem, csNmem = x_nmem, csNinst = x_ninst
235 f23f21c3 Iustin Pop
             }
236 f23f21c3 Iustin Pop
        = cs
237 f23f21c3 Iustin Pop
      inc_amem = Node.fMem node - Node.rMem node
238 f23f21c3 Iustin Pop
      inc_amem' = if inc_amem > 0 then inc_amem else 0
239 f23f21c3 Iustin Pop
      inc_adsk = Node.availDisk node
240 f23f21c3 Iustin Pop
      inc_imem = truncate (Node.tMem node) - Node.nMem node
241 f23f21c3 Iustin Pop
                 - Node.xMem node - Node.fMem node
242 f23f21c3 Iustin Pop
      inc_icpu = Node.uCpu node
243 f23f21c3 Iustin Pop
      inc_idsk = truncate (Node.tDsk node) - Node.fDsk node
244 f23f21c3 Iustin Pop
      inc_vcpu = Node.hiCpu node
245 f23f21c3 Iustin Pop
      inc_acpu = Node.availCpu node
246 90c2f1e8 Iustin Pop
      inc_ncpu = fromIntegral (Node.uCpu node) /
247 90c2f1e8 Iustin Pop
                 iPolicyVcpuRatio (Node.iPolicy node)
248 f23f21c3 Iustin Pop
  in cs { csFmem = x_fmem + fromIntegral (Node.fMem node)
249 f23f21c3 Iustin Pop
        , csFdsk = x_fdsk + fromIntegral (Node.fDsk node)
250 f23f21c3 Iustin Pop
        , csAmem = x_amem + fromIntegral inc_amem'
251 f23f21c3 Iustin Pop
        , csAdsk = x_adsk + fromIntegral inc_adsk
252 f23f21c3 Iustin Pop
        , csAcpu = x_acpu + fromIntegral inc_acpu
253 f23f21c3 Iustin Pop
        , csMmem = max x_mmem (fromIntegral inc_amem')
254 f23f21c3 Iustin Pop
        , csMdsk = max x_mdsk (fromIntegral inc_adsk)
255 f23f21c3 Iustin Pop
        , csMcpu = max x_mcpu (fromIntegral inc_acpu)
256 f23f21c3 Iustin Pop
        , csImem = x_imem + fromIntegral inc_imem
257 f23f21c3 Iustin Pop
        , csIdsk = x_idsk + fromIntegral inc_idsk
258 f23f21c3 Iustin Pop
        , csIcpu = x_icpu + fromIntegral inc_icpu
259 f23f21c3 Iustin Pop
        , csTmem = x_tmem + Node.tMem node
260 f23f21c3 Iustin Pop
        , csTdsk = x_tdsk + Node.tDsk node
261 f23f21c3 Iustin Pop
        , csTcpu = x_tcpu + Node.tCpu node
262 f23f21c3 Iustin Pop
        , csVcpu = x_vcpu + fromIntegral inc_vcpu
263 90c2f1e8 Iustin Pop
        , csNcpu = x_ncpu + inc_ncpu
264 f23f21c3 Iustin Pop
        , csXmem = x_xmem + fromIntegral (Node.xMem node)
265 f23f21c3 Iustin Pop
        , csNmem = x_nmem + fromIntegral (Node.nMem node)
266 f23f21c3 Iustin Pop
        , csNinst = x_ninst + length (Node.pList node)
267 f23f21c3 Iustin Pop
        }
268 1a7eff0e Iustin Pop
269 9188aeef Iustin Pop
-- | Compute the total free disk and memory in the cluster.
270 1a7eff0e Iustin Pop
totalResources :: Node.List -> CStats
271 de4ac2c2 Iustin Pop
totalResources nl =
272 f23f21c3 Iustin Pop
  let cs = foldl' updateCStats emptyCStats . Container.elems $ nl
273 f23f21c3 Iustin Pop
  in cs { csScore = compCV nl }
274 9188aeef Iustin Pop
275 9b8fac3d Iustin Pop
-- | Compute the delta between two cluster state.
276 9b8fac3d Iustin Pop
--
277 9b8fac3d Iustin Pop
-- This is used when doing allocations, to understand better the
278 e2436511 Iustin Pop
-- available cluster resources. The return value is a triple of the
279 e2436511 Iustin Pop
-- current used values, the delta that was still allocated, and what
280 e2436511 Iustin Pop
-- was left unallocated.
281 9b8fac3d Iustin Pop
computeAllocationDelta :: CStats -> CStats -> AllocStats
282 9b8fac3d Iustin Pop
computeAllocationDelta cini cfin =
283 80d7d8a1 Iustin Pop
  let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu,
284 80d7d8a1 Iustin Pop
              csNcpu = i_ncpu } = cini
285 f23f21c3 Iustin Pop
      CStats {csImem = f_imem, csIdsk = f_idsk, csIcpu = f_icpu,
286 80d7d8a1 Iustin Pop
              csTmem = t_mem, csTdsk = t_dsk, csVcpu = f_vcpu,
287 80d7d8a1 Iustin Pop
              csNcpu = f_ncpu, csTcpu = f_tcpu } = cfin
288 80d7d8a1 Iustin Pop
      rini = AllocInfo { allocInfoVCpus = fromIntegral i_icpu
289 80d7d8a1 Iustin Pop
                       , allocInfoNCpus = i_ncpu
290 80d7d8a1 Iustin Pop
                       , allocInfoMem   = fromIntegral i_imem
291 80d7d8a1 Iustin Pop
                       , allocInfoDisk  = fromIntegral i_idsk
292 80d7d8a1 Iustin Pop
                       }
293 80d7d8a1 Iustin Pop
      rfin = AllocInfo { allocInfoVCpus = fromIntegral (f_icpu - i_icpu)
294 80d7d8a1 Iustin Pop
                       , allocInfoNCpus = f_ncpu - i_ncpu
295 80d7d8a1 Iustin Pop
                       , allocInfoMem   = fromIntegral (f_imem - i_imem)
296 80d7d8a1 Iustin Pop
                       , allocInfoDisk  = fromIntegral (f_idsk - i_idsk)
297 80d7d8a1 Iustin Pop
                       }
298 80d7d8a1 Iustin Pop
      runa = AllocInfo { allocInfoVCpus = fromIntegral (f_vcpu - f_icpu)
299 80d7d8a1 Iustin Pop
                       , allocInfoNCpus = f_tcpu - f_ncpu
300 80d7d8a1 Iustin Pop
                       , allocInfoMem   = truncate t_mem - fromIntegral f_imem
301 80d7d8a1 Iustin Pop
                       , allocInfoDisk  = truncate t_dsk - fromIntegral f_idsk
302 80d7d8a1 Iustin Pop
                       }
303 f23f21c3 Iustin Pop
  in (rini, rfin, runa)
304 9b8fac3d Iustin Pop
305 525bfb36 Iustin Pop
-- | The names and weights of the individual elements in the CV list.
306 8a3b30ca Iustin Pop
detailedCVInfo :: [(Double, String)]
307 8a3b30ca Iustin Pop
detailedCVInfo = [ (1,  "free_mem_cv")
308 8a3b30ca Iustin Pop
                 , (1,  "free_disk_cv")
309 8a3b30ca Iustin Pop
                 , (1,  "n1_cnt")
310 8a3b30ca Iustin Pop
                 , (1,  "reserved_mem_cv")
311 8a3b30ca Iustin Pop
                 , (4,  "offline_all_cnt")
312 8a3b30ca Iustin Pop
                 , (16, "offline_pri_cnt")
313 8a3b30ca Iustin Pop
                 , (1,  "vcpu_ratio_cv")
314 8a3b30ca Iustin Pop
                 , (1,  "cpu_load_cv")
315 8a3b30ca Iustin Pop
                 , (1,  "mem_load_cv")
316 8a3b30ca Iustin Pop
                 , (1,  "disk_load_cv")
317 8a3b30ca Iustin Pop
                 , (1,  "net_load_cv")
318 306cccd5 Iustin Pop
                 , (2,  "pri_tags_score")
319 084565ac Iustin Pop
                 , (1,  "spindles_cv")
320 8a3b30ca Iustin Pop
                 ]
321 8a3b30ca Iustin Pop
322 179c0828 Iustin Pop
-- | Holds the weights used by 'compCVNodes' for each metric.
323 8a3b30ca Iustin Pop
detailedCVWeights :: [Double]
324 8a3b30ca Iustin Pop
detailedCVWeights = map fst detailedCVInfo
325 fca250e9 Iustin Pop
326 9188aeef Iustin Pop
-- | Compute the mem and disk covariance.
327 9bb5721c Iustin Pop
compDetailedCV :: [Node.Node] -> [Double]
328 9bb5721c Iustin Pop
compDetailedCV all_nodes =
329 f23f21c3 Iustin Pop
  let (offline, nodes) = partition Node.offline all_nodes
330 f23f21c3 Iustin Pop
      mem_l = map Node.pMem nodes
331 f23f21c3 Iustin Pop
      dsk_l = map Node.pDsk nodes
332 f23f21c3 Iustin Pop
      -- metric: memory covariance
333 f23f21c3 Iustin Pop
      mem_cv = stdDev mem_l
334 f23f21c3 Iustin Pop
      -- metric: disk covariance
335 f23f21c3 Iustin Pop
      dsk_cv = stdDev dsk_l
336 f23f21c3 Iustin Pop
      -- metric: count of instances living on N1 failing nodes
337 f23f21c3 Iustin Pop
      n1_score = fromIntegral . sum . map (\n -> length (Node.sList n) +
338 f23f21c3 Iustin Pop
                                                 length (Node.pList n)) .
339 f23f21c3 Iustin Pop
                 filter Node.failN1 $ nodes :: Double
340 f23f21c3 Iustin Pop
      res_l = map Node.pRem nodes
341 f23f21c3 Iustin Pop
      -- metric: reserved memory covariance
342 f23f21c3 Iustin Pop
      res_cv = stdDev res_l
343 f23f21c3 Iustin Pop
      -- offline instances metrics
344 f23f21c3 Iustin Pop
      offline_ipri = sum . map (length . Node.pList) $ offline
345 f23f21c3 Iustin Pop
      offline_isec = sum . map (length . Node.sList) $ offline
346 f23f21c3 Iustin Pop
      -- metric: count of instances on offline nodes
347 f23f21c3 Iustin Pop
      off_score = fromIntegral (offline_ipri + offline_isec)::Double
348 f23f21c3 Iustin Pop
      -- metric: count of primary instances on offline nodes (this
349 f23f21c3 Iustin Pop
      -- helps with evacuation/failover of primary instances on
350 f23f21c3 Iustin Pop
      -- 2-node clusters with one node offline)
351 f23f21c3 Iustin Pop
      off_pri_score = fromIntegral offline_ipri::Double
352 f23f21c3 Iustin Pop
      cpu_l = map Node.pCpu nodes
353 f23f21c3 Iustin Pop
      -- metric: covariance of vcpu/pcpu ratio
354 f23f21c3 Iustin Pop
      cpu_cv = stdDev cpu_l
355 f23f21c3 Iustin Pop
      -- metrics: covariance of cpu, memory, disk and network load
356 f23f21c3 Iustin Pop
      (c_load, m_load, d_load, n_load) =
357 f23f21c3 Iustin Pop
        unzip4 $ map (\n ->
358 f23f21c3 Iustin Pop
                      let DynUtil c1 m1 d1 n1 = Node.utilLoad n
359 f23f21c3 Iustin Pop
                          DynUtil c2 m2 d2 n2 = Node.utilPool n
360 f23f21c3 Iustin Pop
                      in (c1/c2, m1/m2, d1/d2, n1/n2)) nodes
361 f23f21c3 Iustin Pop
      -- metric: conflicting instance count
362 f23f21c3 Iustin Pop
      pri_tags_inst = sum $ map Node.conflictingPrimaries nodes
363 f23f21c3 Iustin Pop
      pri_tags_score = fromIntegral pri_tags_inst::Double
364 084565ac Iustin Pop
      -- metric: spindles %
365 084565ac Iustin Pop
      spindles_cv = map (\n -> Node.instSpindles n / Node.hiSpindles n) nodes
366 f23f21c3 Iustin Pop
  in [ mem_cv, dsk_cv, n1_score, res_cv, off_score, off_pri_score, cpu_cv
367 f23f21c3 Iustin Pop
     , stdDev c_load, stdDev m_load , stdDev d_load, stdDev n_load
368 084565ac Iustin Pop
     , pri_tags_score, stdDev spindles_cv ]
369 9188aeef Iustin Pop
370 9188aeef Iustin Pop
-- | Compute the /total/ variance.
371 9bb5721c Iustin Pop
compCVNodes :: [Node.Node] -> Double
372 9bb5721c Iustin Pop
compCVNodes = sum . zipWith (*) detailedCVWeights . compDetailedCV
373 9bb5721c Iustin Pop
374 9bb5721c Iustin Pop
-- | Wrapper over 'compCVNodes' for callers that have a 'Node.List'.
375 9188aeef Iustin Pop
compCV :: Node.List -> Double
376 9bb5721c Iustin Pop
compCV = compCVNodes . Container.elems
377 9bb5721c Iustin Pop
378 525bfb36 Iustin Pop
-- | Compute online nodes from a 'Node.List'.
379 dbba5246 Iustin Pop
getOnline :: Node.List -> [Node.Node]
380 dbba5246 Iustin Pop
getOnline = filter (not . Node.offline) . Container.elems
381 dbba5246 Iustin Pop
382 525bfb36 Iustin Pop
-- * Balancing functions
383 9188aeef Iustin Pop
384 9188aeef Iustin Pop
-- | Compute best table. Note that the ordering of the arguments is important.
385 9188aeef Iustin Pop
compareTables :: Table -> Table -> Table
386 9188aeef Iustin Pop
compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
387 f23f21c3 Iustin Pop
  if a_cv > b_cv then b else a
388 9188aeef Iustin Pop
389 9188aeef Iustin Pop
-- | Applies an instance move to a given node list and instance.
390 262a08a2 Iustin Pop
applyMove :: Node.List -> Instance.Instance
391 8880d889 Iustin Pop
          -> IMove -> OpResult (Node.List, Instance.Instance, Ndx, Ndx)
392 00b51a14 Iustin Pop
-- Failover (f)
393 e4f08c46 Iustin Pop
applyMove nl inst Failover =
394 255f55a9 Iustin Pop
  let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
395 f23f21c3 Iustin Pop
      int_p = Node.removePri old_p inst
396 f23f21c3 Iustin Pop
      int_s = Node.removeSec old_s inst
397 f23f21c3 Iustin Pop
      new_nl = do -- Maybe monad
398 3603605a Iustin Pop
        new_p <- Node.addPriEx (Node.offline old_p) int_s inst
399 f23f21c3 Iustin Pop
        new_s <- Node.addSec int_p inst old_sdx
400 f23f21c3 Iustin Pop
        let new_inst = Instance.setBoth inst old_sdx old_pdx
401 f23f21c3 Iustin Pop
        return (Container.addTwo old_pdx new_s old_sdx new_p nl,
402 f23f21c3 Iustin Pop
                new_inst, old_sdx, old_pdx)
403 f23f21c3 Iustin Pop
  in new_nl
404 e4f08c46 Iustin Pop
405 0c8cef35 Iustin Pop
-- Failover to any (fa)
406 0c8cef35 Iustin Pop
applyMove nl inst (FailoverToAny new_pdx) = do
407 0c8cef35 Iustin Pop
  let (old_pdx, old_sdx, old_pnode, _) = instanceNodes nl inst
408 0c8cef35 Iustin Pop
      new_pnode = Container.find new_pdx nl
409 0c8cef35 Iustin Pop
      force_failover = Node.offline old_pnode
410 0c8cef35 Iustin Pop
  new_pnode' <- Node.addPriEx force_failover new_pnode inst
411 0c8cef35 Iustin Pop
  let old_pnode' = Node.removePri old_pnode inst
412 0c8cef35 Iustin Pop
      inst' = Instance.setPri inst new_pdx
413 0c8cef35 Iustin Pop
      nl' = Container.addTwo old_pdx old_pnode' new_pdx new_pnode' nl
414 0c8cef35 Iustin Pop
  return (nl', inst', new_pdx, old_sdx)
415 0c8cef35 Iustin Pop
416 00b51a14 Iustin Pop
-- Replace the primary (f:, r:np, f)
417 e4f08c46 Iustin Pop
applyMove nl inst (ReplacePrimary new_pdx) =
418 255f55a9 Iustin Pop
  let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
419 f23f21c3 Iustin Pop
      tgt_n = Container.find new_pdx nl
420 f23f21c3 Iustin Pop
      int_p = Node.removePri old_p inst
421 f23f21c3 Iustin Pop
      int_s = Node.removeSec old_s inst
422 f23f21c3 Iustin Pop
      force_p = Node.offline old_p
423 f23f21c3 Iustin Pop
      new_nl = do -- Maybe monad
424 f23f21c3 Iustin Pop
                  -- check that the current secondary can host the instance
425 f23f21c3 Iustin Pop
                  -- during the migration
426 f23f21c3 Iustin Pop
        tmp_s <- Node.addPriEx force_p int_s inst
427 f23f21c3 Iustin Pop
        let tmp_s' = Node.removePri tmp_s inst
428 f23f21c3 Iustin Pop
        new_p <- Node.addPriEx force_p tgt_n inst
429 f23f21c3 Iustin Pop
        new_s <- Node.addSecEx force_p tmp_s' inst new_pdx
430 f23f21c3 Iustin Pop
        let new_inst = Instance.setPri inst new_pdx
431 f23f21c3 Iustin Pop
        return (Container.add new_pdx new_p $
432 f23f21c3 Iustin Pop
                Container.addTwo old_pdx int_p old_sdx new_s nl,
433 f23f21c3 Iustin Pop
                new_inst, new_pdx, old_sdx)
434 f23f21c3 Iustin Pop
  in new_nl
435 e4f08c46 Iustin Pop
436 00b51a14 Iustin Pop
-- Replace the secondary (r:ns)
437 e4f08c46 Iustin Pop
applyMove nl inst (ReplaceSecondary new_sdx) =
438 f23f21c3 Iustin Pop
  let old_pdx = Instance.pNode inst
439 f23f21c3 Iustin Pop
      old_sdx = Instance.sNode inst
440 f23f21c3 Iustin Pop
      old_s = Container.find old_sdx nl
441 f23f21c3 Iustin Pop
      tgt_n = Container.find new_sdx nl
442 f23f21c3 Iustin Pop
      int_s = Node.removeSec old_s inst
443 f23f21c3 Iustin Pop
      force_s = Node.offline old_s
444 f23f21c3 Iustin Pop
      new_inst = Instance.setSec inst new_sdx
445 f23f21c3 Iustin Pop
      new_nl = Node.addSecEx force_s tgt_n inst old_pdx >>=
446 f23f21c3 Iustin Pop
               \new_s -> return (Container.addTwo new_sdx
447 f23f21c3 Iustin Pop
                                 new_s old_sdx int_s nl,
448 f23f21c3 Iustin Pop
                                 new_inst, old_pdx, new_sdx)
449 f23f21c3 Iustin Pop
  in new_nl
450 e4f08c46 Iustin Pop
451 00b51a14 Iustin Pop
-- Replace the secondary and failover (r:np, f)
452 79ac6b6f Iustin Pop
applyMove nl inst (ReplaceAndFailover new_pdx) =
453 255f55a9 Iustin Pop
  let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
454 f23f21c3 Iustin Pop
      tgt_n = Container.find new_pdx nl
455 f23f21c3 Iustin Pop
      int_p = Node.removePri old_p inst
456 f23f21c3 Iustin Pop
      int_s = Node.removeSec old_s inst
457 f23f21c3 Iustin Pop
      force_s = Node.offline old_s
458 f23f21c3 Iustin Pop
      new_nl = do -- Maybe monad
459 f23f21c3 Iustin Pop
        new_p <- Node.addPri tgt_n inst
460 f23f21c3 Iustin Pop
        new_s <- Node.addSecEx force_s int_p inst new_pdx
461 f23f21c3 Iustin Pop
        let new_inst = Instance.setBoth inst new_pdx old_pdx
462 f23f21c3 Iustin Pop
        return (Container.add new_pdx new_p $
463 f23f21c3 Iustin Pop
                Container.addTwo old_pdx new_s old_sdx int_s nl,
464 f23f21c3 Iustin Pop
                new_inst, new_pdx, old_pdx)
465 f23f21c3 Iustin Pop
  in new_nl
466 79ac6b6f Iustin Pop
467 19493d33 Iustin Pop
-- Failver and replace the secondary (f, r:ns)
468 19493d33 Iustin Pop
applyMove nl inst (FailoverAndReplace new_sdx) =
469 255f55a9 Iustin Pop
  let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
470 f23f21c3 Iustin Pop
      tgt_n = Container.find new_sdx nl
471 f23f21c3 Iustin Pop
      int_p = Node.removePri old_p inst
472 f23f21c3 Iustin Pop
      int_s = Node.removeSec old_s inst
473 f23f21c3 Iustin Pop
      force_p = Node.offline old_p
474 f23f21c3 Iustin Pop
      new_nl = do -- Maybe monad
475 f23f21c3 Iustin Pop
        new_p <- Node.addPriEx force_p int_s inst
476 f23f21c3 Iustin Pop
        new_s <- Node.addSecEx force_p tgt_n inst old_sdx
477 f23f21c3 Iustin Pop
        let new_inst = Instance.setBoth inst old_sdx new_sdx
478 f23f21c3 Iustin Pop
        return (Container.add new_sdx new_s $
479 f23f21c3 Iustin Pop
                Container.addTwo old_sdx new_p old_pdx int_p nl,
480 f23f21c3 Iustin Pop
                new_inst, old_sdx, new_sdx)
481 f23f21c3 Iustin Pop
  in new_nl
482 19493d33 Iustin Pop
483 9188aeef Iustin Pop
-- | Tries to allocate an instance on one given node.
484 0d66ea67 Iustin Pop
allocateOnSingle :: Node.List -> Instance.Instance -> Ndx
485 1fe81531 Iustin Pop
                 -> OpResult Node.AllocElement
486 0d66ea67 Iustin Pop
allocateOnSingle nl inst new_pdx =
487 f23f21c3 Iustin Pop
  let p = Container.find new_pdx nl
488 f23f21c3 Iustin Pop
      new_inst = Instance.setBoth inst new_pdx Node.noSecondary
489 aa5b2f07 Iustin Pop
  in do
490 aa5b2f07 Iustin Pop
    Instance.instMatchesPolicy inst (Node.iPolicy p)
491 aa5b2f07 Iustin Pop
    new_p <- Node.addPri p inst
492 f23f21c3 Iustin Pop
    let new_nl = Container.add new_pdx new_p nl
493 14b5d45f Iustin Pop
        new_score = compCV new_nl
494 f23f21c3 Iustin Pop
    return (new_nl, new_inst, [new_p], new_score)
495 5e15f460 Iustin Pop
496 9188aeef Iustin Pop
-- | Tries to allocate an instance on a given pair of nodes.
497 0d66ea67 Iustin Pop
allocateOnPair :: Node.List -> Instance.Instance -> Ndx -> Ndx
498 1fe81531 Iustin Pop
               -> OpResult Node.AllocElement
499 0d66ea67 Iustin Pop
allocateOnPair nl inst new_pdx new_sdx =
500 f23f21c3 Iustin Pop
  let tgt_p = Container.find new_pdx nl
501 f23f21c3 Iustin Pop
      tgt_s = Container.find new_sdx nl
502 f23f21c3 Iustin Pop
  in do
503 aa5b2f07 Iustin Pop
    Instance.instMatchesPolicy inst (Node.iPolicy tgt_p)
504 f23f21c3 Iustin Pop
    new_p <- Node.addPri tgt_p inst
505 f23f21c3 Iustin Pop
    new_s <- Node.addSec tgt_s inst new_pdx
506 f23f21c3 Iustin Pop
    let new_inst = Instance.setBoth inst new_pdx new_sdx
507 f23f21c3 Iustin Pop
        new_nl = Container.addTwo new_pdx new_p new_sdx new_s nl
508 f23f21c3 Iustin Pop
    return (new_nl, new_inst, [new_p, new_s], compCV new_nl)
509 4a340313 Iustin Pop
510 9188aeef Iustin Pop
-- | Tries to perform an instance move and returns the best table
511 9188aeef Iustin Pop
-- between the original one and the new one.
512 e4f08c46 Iustin Pop
checkSingleStep :: Table -- ^ The original table
513 e4f08c46 Iustin Pop
                -> Instance.Instance -- ^ The instance to move
514 e4f08c46 Iustin Pop
                -> Table -- ^ The current best table
515 e4f08c46 Iustin Pop
                -> IMove -- ^ The move to apply
516 e4f08c46 Iustin Pop
                -> Table -- ^ The final best table
517 e4f08c46 Iustin Pop
checkSingleStep ini_tbl target cur_tbl move =
518 f23f21c3 Iustin Pop
  let Table ini_nl ini_il _ ini_plc = ini_tbl
519 f23f21c3 Iustin Pop
      tmp_resu = applyMove ini_nl target move
520 f23f21c3 Iustin Pop
  in case tmp_resu of
521 a8038349 Iustin Pop
       Bad _ -> cur_tbl
522 a8038349 Iustin Pop
       Ok (upd_nl, new_inst, pri_idx, sec_idx) ->
523 f23f21c3 Iustin Pop
         let tgt_idx = Instance.idx target
524 f23f21c3 Iustin Pop
             upd_cvar = compCV upd_nl
525 f23f21c3 Iustin Pop
             upd_il = Container.add tgt_idx new_inst ini_il
526 f23f21c3 Iustin Pop
             upd_plc = (tgt_idx, pri_idx, sec_idx, move, upd_cvar):ini_plc
527 f23f21c3 Iustin Pop
             upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
528 f23f21c3 Iustin Pop
         in compareTables cur_tbl upd_tbl
529 e4f08c46 Iustin Pop
530 c0501c69 Iustin Pop
-- | Given the status of the current secondary as a valid new node and
531 c0501c69 Iustin Pop
-- the current candidate target node, generate the possible moves for
532 c0501c69 Iustin Pop
-- a instance.
533 5f4464db Iustin Pop
possibleMoves :: MirrorType -- ^ The mirroring type of the instance
534 5f4464db Iustin Pop
              -> Bool       -- ^ Whether the secondary node is a valid new node
535 5f4464db Iustin Pop
              -> Bool       -- ^ Whether we can change the primary node
536 5f4464db Iustin Pop
              -> Ndx        -- ^ Target node candidate
537 5f4464db Iustin Pop
              -> [IMove]    -- ^ List of valid result moves
538 e08424a8 Guido Trotter
539 5f4464db Iustin Pop
possibleMoves MirrorNone _ _ _ = []
540 e08424a8 Guido Trotter
541 0c8cef35 Iustin Pop
possibleMoves MirrorExternal _ False _ = []
542 0c8cef35 Iustin Pop
543 0c8cef35 Iustin Pop
possibleMoves MirrorExternal _ True tdx =
544 0c8cef35 Iustin Pop
  [ FailoverToAny tdx ]
545 5f4464db Iustin Pop
546 5f4464db Iustin Pop
possibleMoves MirrorInternal _ False tdx =
547 5f4464db Iustin Pop
  [ ReplaceSecondary tdx ]
548 5f4464db Iustin Pop
549 5f4464db Iustin Pop
possibleMoves MirrorInternal True True tdx =
550 f23f21c3 Iustin Pop
  [ ReplaceSecondary tdx
551 f23f21c3 Iustin Pop
  , ReplaceAndFailover tdx
552 f23f21c3 Iustin Pop
  , ReplacePrimary tdx
553 f23f21c3 Iustin Pop
  , FailoverAndReplace tdx
554 f23f21c3 Iustin Pop
  ]
555 40d4eba0 Iustin Pop
556 5f4464db Iustin Pop
possibleMoves MirrorInternal False True tdx =
557 f23f21c3 Iustin Pop
  [ ReplaceSecondary tdx
558 f23f21c3 Iustin Pop
  , ReplaceAndFailover tdx
559 f23f21c3 Iustin Pop
  ]
560 40d4eba0 Iustin Pop
561 40d4eba0 Iustin Pop
-- | Compute the best move for a given instance.
562 c0501c69 Iustin Pop
checkInstanceMove :: [Ndx]             -- ^ Allowed target node indices
563 c0501c69 Iustin Pop
                  -> Bool              -- ^ Whether disk moves are allowed
564 e08424a8 Guido Trotter
                  -> Bool              -- ^ Whether instance moves are allowed
565 c0501c69 Iustin Pop
                  -> Table             -- ^ Original table
566 c0501c69 Iustin Pop
                  -> Instance.Instance -- ^ Instance to move
567 c0501c69 Iustin Pop
                  -> Table             -- ^ Best new table for this instance
568 e08424a8 Guido Trotter
checkInstanceMove nodes_idx disk_moves inst_moves ini_tbl target =
569 f23f21c3 Iustin Pop
  let opdx = Instance.pNode target
570 f23f21c3 Iustin Pop
      osdx = Instance.sNode target
571 3603605a Iustin Pop
      bad_nodes = [opdx, osdx]
572 3603605a Iustin Pop
      nodes = filter (`notElem` bad_nodes) nodes_idx
573 fafd0773 Iustin Pop
      mir_type = Instance.mirrorType target
574 f23f21c3 Iustin Pop
      use_secondary = elem osdx nodes_idx && inst_moves
575 5f4464db Iustin Pop
      aft_failover = if mir_type == MirrorInternal && use_secondary
576 5f4464db Iustin Pop
                       -- if drbd and allowed to failover
577 40d4eba0 Iustin Pop
                       then checkSingleStep ini_tbl target ini_tbl Failover
578 40d4eba0 Iustin Pop
                       else ini_tbl
579 5f4464db Iustin Pop
      all_moves =
580 5f4464db Iustin Pop
        if disk_moves
581 5f4464db Iustin Pop
          then concatMap (possibleMoves mir_type use_secondary inst_moves)
582 5f4464db Iustin Pop
               nodes
583 5f4464db Iustin Pop
          else []
584 4e25d1c2 Iustin Pop
    in
585 4e25d1c2 Iustin Pop
      -- iterate over the possible nodes for this instance
586 9dc6023f Iustin Pop
      foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
587 4e25d1c2 Iustin Pop
588 e4f08c46 Iustin Pop
-- | Compute the best next move.
589 608efcce Iustin Pop
checkMove :: [Ndx]               -- ^ Allowed target node indices
590 c0501c69 Iustin Pop
          -> Bool                -- ^ Whether disk moves are allowed
591 e08424a8 Guido Trotter
          -> Bool                -- ^ Whether instance moves are allowed
592 256810de Iustin Pop
          -> Table               -- ^ The current solution
593 e4f08c46 Iustin Pop
          -> [Instance.Instance] -- ^ List of instances still to move
594 256810de Iustin Pop
          -> Table               -- ^ The new solution
595 e08424a8 Guido Trotter
checkMove nodes_idx disk_moves inst_moves ini_tbl victims =
596 f23f21c3 Iustin Pop
  let Table _ _ _ ini_plc = ini_tbl
597 f23f21c3 Iustin Pop
      -- we're using rwhnf from the Control.Parallel.Strategies
598 f23f21c3 Iustin Pop
      -- package; we don't need to use rnf as that would force too
599 f23f21c3 Iustin Pop
      -- much evaluation in single-threaded cases, and in
600 f23f21c3 Iustin Pop
      -- multi-threaded case the weak head normal form is enough to
601 f23f21c3 Iustin Pop
      -- spark the evaluation
602 f23f21c3 Iustin Pop
      tables = parMap rwhnf (checkInstanceMove nodes_idx disk_moves
603 f23f21c3 Iustin Pop
                             inst_moves ini_tbl)
604 f23f21c3 Iustin Pop
               victims
605 f23f21c3 Iustin Pop
      -- iterate over all instances, computing the best move
606 f23f21c3 Iustin Pop
      best_tbl = foldl' compareTables ini_tbl tables
607 f23f21c3 Iustin Pop
      Table _ _ _ best_plc = best_tbl
608 f23f21c3 Iustin Pop
  in if length best_plc == length ini_plc
609 a804261a Iustin Pop
       then ini_tbl -- no advancement
610 a804261a Iustin Pop
       else best_tbl
611 e4f08c46 Iustin Pop
612 525bfb36 Iustin Pop
-- | Check if we are allowed to go deeper in the balancing.
613 3fea6959 Iustin Pop
doNextBalance :: Table     -- ^ The starting table
614 3fea6959 Iustin Pop
              -> Int       -- ^ Remaining length
615 3fea6959 Iustin Pop
              -> Score     -- ^ Score at which to stop
616 3fea6959 Iustin Pop
              -> Bool      -- ^ The resulting table and commands
617 5ad86777 Iustin Pop
doNextBalance ini_tbl max_rounds min_score =
618 f23f21c3 Iustin Pop
  let Table _ _ ini_cv ini_plc = ini_tbl
619 f23f21c3 Iustin Pop
      ini_plc_len = length ini_plc
620 f23f21c3 Iustin Pop
  in (max_rounds < 0 || ini_plc_len < max_rounds) && ini_cv > min_score
621 5ad86777 Iustin Pop
622 525bfb36 Iustin Pop
-- | Run a balance move.
623 f25e5aac Iustin Pop
tryBalance :: Table       -- ^ The starting table
624 f25e5aac Iustin Pop
           -> Bool        -- ^ Allow disk moves
625 e08424a8 Guido Trotter
           -> Bool        -- ^ Allow instance moves
626 2e28ac32 Iustin Pop
           -> Bool        -- ^ Only evacuate moves
627 848b65c9 Iustin Pop
           -> Score       -- ^ Min gain threshold
628 848b65c9 Iustin Pop
           -> Score       -- ^ Min gain
629 f25e5aac Iustin Pop
           -> Maybe Table -- ^ The resulting table and commands
630 e08424a8 Guido Trotter
tryBalance ini_tbl disk_moves inst_moves evac_mode mg_limit min_gain =
631 5ad86777 Iustin Pop
    let Table ini_nl ini_il ini_cv _ = ini_tbl
632 5ad86777 Iustin Pop
        all_inst = Container.elems ini_il
633 73d12eab Iustin Pop
        all_nodes = Container.elems ini_nl
634 73d12eab Iustin Pop
        (offline_nodes, online_nodes) = partition Node.offline all_nodes
635 2e28ac32 Iustin Pop
        all_inst' = if evac_mode
636 73d12eab Iustin Pop
                      then let bad_nodes = map Node.idx offline_nodes
637 73d12eab Iustin Pop
                           in filter (any (`elem` bad_nodes) .
638 73d12eab Iustin Pop
                                          Instance.allNodes) all_inst
639 73d12eab Iustin Pop
                      else all_inst
640 a3d1dc0a Iustin Pop
        reloc_inst = filter (\i -> Instance.movable i &&
641 a3d1dc0a Iustin Pop
                                   Instance.autoBalance i) all_inst'
642 73d12eab Iustin Pop
        node_idx = map Node.idx online_nodes
643 e08424a8 Guido Trotter
        fin_tbl = checkMove node_idx disk_moves inst_moves ini_tbl reloc_inst
644 5ad86777 Iustin Pop
        (Table _ _ fin_cv _) = fin_tbl
645 f25e5aac Iustin Pop
    in
646 848b65c9 Iustin Pop
      if fin_cv < ini_cv && (ini_cv > mg_limit || ini_cv - fin_cv >= min_gain)
647 5ad86777 Iustin Pop
      then Just fin_tbl -- this round made success, return the new table
648 f25e5aac Iustin Pop
      else Nothing
649 f25e5aac Iustin Pop
650 478df686 Iustin Pop
-- * Allocation functions
651 478df686 Iustin Pop
652 525bfb36 Iustin Pop
-- | Build failure stats out of a list of failures.
653 478df686 Iustin Pop
collapseFailures :: [FailMode] -> FailStats
654 478df686 Iustin Pop
collapseFailures flst =
655 b4bae394 Iustin Pop
    map (\k -> (k, foldl' (\a e -> if e == k then a + 1 else a) 0 flst))
656 b4bae394 Iustin Pop
            [minBound..maxBound]
657 478df686 Iustin Pop
658 6d3d13ab Iustin Pop
-- | Compares two Maybe AllocElement and chooses the best score.
659 d7339c99 Iustin Pop
bestAllocElement :: Maybe Node.AllocElement
660 d7339c99 Iustin Pop
                 -> Maybe Node.AllocElement
661 d7339c99 Iustin Pop
                 -> Maybe Node.AllocElement
662 d7339c99 Iustin Pop
bestAllocElement a Nothing = a
663 d7339c99 Iustin Pop
bestAllocElement Nothing b = b
664 d7339c99 Iustin Pop
bestAllocElement a@(Just (_, _, _, ascore)) b@(Just (_, _, _, bscore)) =
665 9fc18384 Iustin Pop
  if ascore < bscore then a else b
666 d7339c99 Iustin Pop
667 478df686 Iustin Pop
-- | Update current Allocation solution and failure stats with new
668 525bfb36 Iustin Pop
-- elements.
669 1fe81531 Iustin Pop
concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution
670 a8038349 Iustin Pop
concatAllocs as (Bad reason) = as { asFailures = reason : asFailures as }
671 478df686 Iustin Pop
672 a8038349 Iustin Pop
concatAllocs as (Ok ns) =
673 9fc18384 Iustin Pop
  let -- Choose the old or new solution, based on the cluster score
674 9fc18384 Iustin Pop
    cntok = asAllocs as
675 9fc18384 Iustin Pop
    osols = asSolution as
676 9fc18384 Iustin Pop
    nsols = bestAllocElement osols (Just ns)
677 9fc18384 Iustin Pop
    nsuc = cntok + 1
678 478df686 Iustin Pop
    -- Note: we force evaluation of nsols here in order to keep the
679 478df686 Iustin Pop
    -- memory profile low - we know that we will need nsols for sure
680 478df686 Iustin Pop
    -- in the next cycle, so we force evaluation of nsols, since the
681 478df686 Iustin Pop
    -- foldl' in the caller will only evaluate the tuple, but not the
682 7d11799b Iustin Pop
    -- elements of the tuple
683 9fc18384 Iustin Pop
  in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolution = nsols }
684 dbba5246 Iustin Pop
685 f828f4aa Iustin Pop
-- | Sums two 'AllocSolution' structures.
686 f828f4aa Iustin Pop
sumAllocs :: AllocSolution -> AllocSolution -> AllocSolution
687 f828f4aa Iustin Pop
sumAllocs (AllocSolution aFails aAllocs aSols aLog)
688 f828f4aa Iustin Pop
          (AllocSolution bFails bAllocs bSols bLog) =
689 9fc18384 Iustin Pop
  -- note: we add b first, since usually it will be smaller; when
690 9fc18384 Iustin Pop
  -- fold'ing, a will grow and grow whereas b is the per-group
691 9fc18384 Iustin Pop
  -- result, hence smaller
692 9fc18384 Iustin Pop
  let nFails  = bFails ++ aFails
693 9fc18384 Iustin Pop
      nAllocs = aAllocs + bAllocs
694 9fc18384 Iustin Pop
      nSols   = bestAllocElement aSols bSols
695 9fc18384 Iustin Pop
      nLog    = bLog ++ aLog
696 9fc18384 Iustin Pop
  in AllocSolution nFails nAllocs nSols nLog
697 f828f4aa Iustin Pop
698 525bfb36 Iustin Pop
-- | Given a solution, generates a reasonable description for it.
699 859fc11d Iustin Pop
describeSolution :: AllocSolution -> String
700 859fc11d Iustin Pop
describeSolution as =
701 859fc11d Iustin Pop
  let fcnt = asFailures as
702 129734d3 Iustin Pop
      sols = asSolution as
703 859fc11d Iustin Pop
      freasons =
704 859fc11d Iustin Pop
        intercalate ", " . map (\(a, b) -> printf "%s: %d" (show a) b) .
705 859fc11d Iustin Pop
        filter ((> 0) . snd) . collapseFailures $ fcnt
706 129734d3 Iustin Pop
  in case sols of
707 129734d3 Iustin Pop
     Nothing -> "No valid allocation solutions, failure reasons: " ++
708 129734d3 Iustin Pop
                (if null fcnt then "unknown reasons" else freasons)
709 129734d3 Iustin Pop
     Just (_, _, nodes, cv) ->
710 129734d3 Iustin Pop
         printf ("score: %.8f, successes %d, failures %d (%s)" ++
711 129734d3 Iustin Pop
                 " for node(s) %s") cv (asAllocs as) (length fcnt) freasons
712 129734d3 Iustin Pop
               (intercalate "/" . map Node.name $ nodes)
713 859fc11d Iustin Pop
714 525bfb36 Iustin Pop
-- | Annotates a solution with the appropriate string.
715 859fc11d Iustin Pop
annotateSolution :: AllocSolution -> AllocSolution
716 859fc11d Iustin Pop
annotateSolution as = as { asLog = describeSolution as : asLog as }
717 859fc11d Iustin Pop
718 47eed3f4 Iustin Pop
-- | Reverses an evacuation solution.
719 47eed3f4 Iustin Pop
--
720 47eed3f4 Iustin Pop
-- Rationale: we always concat the results to the top of the lists, so
721 47eed3f4 Iustin Pop
-- for proper jobset execution, we should reverse all lists.
722 47eed3f4 Iustin Pop
reverseEvacSolution :: EvacSolution -> EvacSolution
723 47eed3f4 Iustin Pop
reverseEvacSolution (EvacSolution f m o) =
724 9fc18384 Iustin Pop
  EvacSolution (reverse f) (reverse m) (reverse o)
725 47eed3f4 Iustin Pop
726 6cb1649f Iustin Pop
-- | Generate the valid node allocation singles or pairs for a new instance.
727 6d0bc5ca Iustin Pop
genAllocNodes :: Group.List        -- ^ Group list
728 6d0bc5ca Iustin Pop
              -> Node.List         -- ^ The node map
729 6cb1649f Iustin Pop
              -> Int               -- ^ The number of nodes required
730 6d0bc5ca Iustin Pop
              -> Bool              -- ^ Whether to drop or not
731 6d0bc5ca Iustin Pop
                                   -- unallocable nodes
732 6cb1649f Iustin Pop
              -> Result AllocNodes -- ^ The (monadic) result
733 6d0bc5ca Iustin Pop
genAllocNodes gl nl count drop_unalloc =
734 9fc18384 Iustin Pop
  let filter_fn = if drop_unalloc
735 e4491427 Iustin Pop
                    then filter (Group.isAllocable .
736 e4491427 Iustin Pop
                                 flip Container.find gl . Node.group)
737 6d0bc5ca Iustin Pop
                    else id
738 9fc18384 Iustin Pop
      all_nodes = filter_fn $ getOnline nl
739 9fc18384 Iustin Pop
      all_pairs = [(Node.idx p,
740 9fc18384 Iustin Pop
                    [Node.idx s | s <- all_nodes,
741 9fc18384 Iustin Pop
                                       Node.idx p /= Node.idx s,
742 9fc18384 Iustin Pop
                                       Node.group p == Node.group s]) |
743 9fc18384 Iustin Pop
                   p <- all_nodes]
744 9fc18384 Iustin Pop
  in case count of
745 9fc18384 Iustin Pop
       1 -> Ok (Left (map Node.idx all_nodes))
746 9fc18384 Iustin Pop
       2 -> Ok (Right (filter (not . null . snd) all_pairs))
747 9fc18384 Iustin Pop
       _ -> Bad "Unsupported number of nodes, only one or two  supported"
748 6cb1649f Iustin Pop
749 dbba5246 Iustin Pop
-- | Try to allocate an instance on the cluster.
750 dbba5246 Iustin Pop
tryAlloc :: (Monad m) =>
751 dbba5246 Iustin Pop
            Node.List         -- ^ The node list
752 dbba5246 Iustin Pop
         -> Instance.List     -- ^ The instance list
753 dbba5246 Iustin Pop
         -> Instance.Instance -- ^ The instance to allocate
754 6cb1649f Iustin Pop
         -> AllocNodes        -- ^ The allocation targets
755 78694255 Iustin Pop
         -> m AllocSolution   -- ^ Possible solution list
756 1bf6d813 Iustin Pop
tryAlloc _  _ _    (Right []) = fail "Not enough online nodes"
757 6cb1649f Iustin Pop
tryAlloc nl _ inst (Right ok_pairs) =
758 9fc18384 Iustin Pop
  let psols = parMap rwhnf (\(p, ss) ->
759 9fc18384 Iustin Pop
                              foldl' (\cstate ->
760 9fc18384 Iustin Pop
                                        concatAllocs cstate .
761 9fc18384 Iustin Pop
                                        allocateOnPair nl inst p)
762 9fc18384 Iustin Pop
                              emptyAllocSolution ss) ok_pairs
763 9fc18384 Iustin Pop
      sols = foldl' sumAllocs emptyAllocSolution psols
764 9fc18384 Iustin Pop
  in return $ annotateSolution sols
765 dbba5246 Iustin Pop
766 1bf6d813 Iustin Pop
tryAlloc _  _ _    (Left []) = fail "No online nodes"
767 6cb1649f Iustin Pop
tryAlloc nl _ inst (Left all_nodes) =
768 9fc18384 Iustin Pop
  let sols = foldl' (\cstate ->
769 9fc18384 Iustin Pop
                       concatAllocs cstate . allocateOnSingle nl inst
770 9fc18384 Iustin Pop
                    ) emptyAllocSolution all_nodes
771 9fc18384 Iustin Pop
  in return $ annotateSolution sols
772 dbba5246 Iustin Pop
773 525bfb36 Iustin Pop
-- | Given a group/result, describe it as a nice (list of) messages.
774 aec636b9 Iustin Pop
solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
775 aec636b9 Iustin Pop
solutionDescription gl (groupId, result) =
776 9b1584fc Iustin Pop
  case result of
777 73206d0a Iustin Pop
    Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution)
778 aec636b9 Iustin Pop
    Bad message -> [printf "Group %s: error %s" gname message]
779 73206d0a Iustin Pop
  where grp = Container.find groupId gl
780 73206d0a Iustin Pop
        gname = Group.name grp
781 5f828ce4 Agata Murawska
        pol = allocPolicyToRaw (Group.allocPolicy grp)
782 9b1584fc Iustin Pop
783 9b1584fc Iustin Pop
-- | From a list of possibly bad and possibly empty solutions, filter
784 88253d03 Iustin Pop
-- only the groups with a valid result. Note that the result will be
785 525bfb36 Iustin Pop
-- reversed compared to the original list.
786 73206d0a Iustin Pop
filterMGResults :: Group.List
787 73206d0a Iustin Pop
                -> [(Gdx, Result AllocSolution)]
788 73206d0a Iustin Pop
                -> [(Gdx, AllocSolution)]
789 88253d03 Iustin Pop
filterMGResults gl = foldl' fn []
790 9fc18384 Iustin Pop
  where unallocable = not . Group.isAllocable . flip Container.find gl
791 9fc18384 Iustin Pop
        fn accu (gdx, rasol) =
792 9fc18384 Iustin Pop
          case rasol of
793 9fc18384 Iustin Pop
            Bad _ -> accu
794 9fc18384 Iustin Pop
            Ok sol | isNothing (asSolution sol) -> accu
795 9fc18384 Iustin Pop
                   | unallocable gdx -> accu
796 9fc18384 Iustin Pop
                   | otherwise -> (gdx, sol):accu
797 9b1584fc Iustin Pop
798 525bfb36 Iustin Pop
-- | Sort multigroup results based on policy and score.
799 73206d0a Iustin Pop
sortMGResults :: Group.List
800 73206d0a Iustin Pop
             -> [(Gdx, AllocSolution)]
801 73206d0a Iustin Pop
             -> [(Gdx, AllocSolution)]
802 73206d0a Iustin Pop
sortMGResults gl sols =
803 9fc18384 Iustin Pop
  let extractScore (_, _, _, x) = x
804 9fc18384 Iustin Pop
      solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
805 9fc18384 Iustin Pop
                             (extractScore . fromJust . asSolution) sol)
806 9fc18384 Iustin Pop
  in sortBy (comparing solScore) sols
807 73206d0a Iustin Pop
808 8fd09137 Iustin Pop
-- | Finds the best group for an instance on a multi-group cluster.
809 d72ff6c3 Iustin Pop
--
810 d72ff6c3 Iustin Pop
-- Only solutions in @preferred@ and @last_resort@ groups will be
811 d72ff6c3 Iustin Pop
-- accepted as valid, and additionally if the allowed groups parameter
812 d72ff6c3 Iustin Pop
-- is not null then allocation will only be run for those group
813 d72ff6c3 Iustin Pop
-- indices.
814 8fd09137 Iustin Pop
findBestAllocGroup :: Group.List           -- ^ The group list
815 8fd09137 Iustin Pop
                   -> Node.List            -- ^ The node list
816 8fd09137 Iustin Pop
                   -> Instance.List        -- ^ The instance list
817 d72ff6c3 Iustin Pop
                   -> Maybe [Gdx]          -- ^ The allowed groups
818 8fd09137 Iustin Pop
                   -> Instance.Instance    -- ^ The instance to allocate
819 8fd09137 Iustin Pop
                   -> Int                  -- ^ Required number of nodes
820 8fd09137 Iustin Pop
                   -> Result (Gdx, AllocSolution, [String])
821 d72ff6c3 Iustin Pop
findBestAllocGroup mggl mgnl mgil allowed_gdxs inst cnt =
822 9b1584fc Iustin Pop
  let groups = splitCluster mgnl mgil
823 d72ff6c3 Iustin Pop
      groups' = maybe groups (\gs -> filter ((`elem` gs) . fst) groups)
824 d72ff6c3 Iustin Pop
                allowed_gdxs
825 9b1584fc Iustin Pop
      sols = map (\(gid, (nl, il)) ->
826 6d0bc5ca Iustin Pop
                   (gid, genAllocNodes mggl nl cnt False >>=
827 6d0bc5ca Iustin Pop
                       tryAlloc nl il inst))
828 d72ff6c3 Iustin Pop
             groups'::[(Gdx, Result AllocSolution)]
829 aec636b9 Iustin Pop
      all_msgs = concatMap (solutionDescription mggl) sols
830 73206d0a Iustin Pop
      goodSols = filterMGResults mggl sols
831 73206d0a Iustin Pop
      sortedSols = sortMGResults mggl goodSols
832 72747d91 Iustin Pop
  in case sortedSols of
833 72747d91 Iustin Pop
       [] -> Bad $ if null groups'
834 72747d91 Iustin Pop
                     then "no groups for evacuation: allowed groups was" ++
835 72747d91 Iustin Pop
                          show allowed_gdxs ++ ", all groups: " ++
836 72747d91 Iustin Pop
                          show (map fst groups)
837 72747d91 Iustin Pop
                     else intercalate ", " all_msgs
838 72747d91 Iustin Pop
       (final_group, final_sol):_ -> return (final_group, final_sol, all_msgs)
839 8fd09137 Iustin Pop
840 8fd09137 Iustin Pop
-- | Try to allocate an instance on a multi-group cluster.
841 8fd09137 Iustin Pop
tryMGAlloc :: Group.List           -- ^ The group list
842 8fd09137 Iustin Pop
           -> Node.List            -- ^ The node list
843 8fd09137 Iustin Pop
           -> Instance.List        -- ^ The instance list
844 8fd09137 Iustin Pop
           -> Instance.Instance    -- ^ The instance to allocate
845 8fd09137 Iustin Pop
           -> Int                  -- ^ Required number of nodes
846 8fd09137 Iustin Pop
           -> Result AllocSolution -- ^ Possible solution list
847 8fd09137 Iustin Pop
tryMGAlloc mggl mgnl mgil inst cnt = do
848 8fd09137 Iustin Pop
  (best_group, solution, all_msgs) <-
849 d72ff6c3 Iustin Pop
      findBestAllocGroup mggl mgnl mgil Nothing inst cnt
850 8fd09137 Iustin Pop
  let group_name = Group.name $ Container.find best_group mggl
851 8fd09137 Iustin Pop
      selmsg = "Selected group: " ++ group_name
852 8fd09137 Iustin Pop
  return $ solution { asLog = selmsg:all_msgs }
853 9b1584fc Iustin Pop
854 c85abf30 René Nussbaumer
-- | Calculate the new instance list after allocation solution.
855 c85abf30 René Nussbaumer
updateIl :: Instance.List           -- ^ The original instance list
856 c85abf30 René Nussbaumer
         -> Maybe Node.AllocElement -- ^ The result of the allocation attempt
857 c85abf30 René Nussbaumer
         -> Instance.List           -- ^ The updated instance list
858 c85abf30 René Nussbaumer
updateIl il Nothing = il
859 c85abf30 René Nussbaumer
updateIl il (Just (_, xi, _, _)) = Container.add (Container.size il) xi il
860 c85abf30 René Nussbaumer
861 c85abf30 René Nussbaumer
-- | Extract the the new node list from the allocation solution.
862 c85abf30 René Nussbaumer
extractNl :: Node.List               -- ^ The original node list
863 c85abf30 René Nussbaumer
          -> Maybe Node.AllocElement -- ^ The result of the allocation attempt
864 c85abf30 René Nussbaumer
          -> Node.List               -- ^ The new node list
865 c85abf30 René Nussbaumer
extractNl nl Nothing = nl
866 c85abf30 René Nussbaumer
extractNl _ (Just (xnl, _, _, _)) = xnl
867 c85abf30 René Nussbaumer
868 c85abf30 René Nussbaumer
-- | Try to allocate a list of instances on a multi-group cluster.
869 c85abf30 René Nussbaumer
allocList :: Group.List                  -- ^ The group list
870 c85abf30 René Nussbaumer
          -> Node.List                   -- ^ The node list
871 c85abf30 René Nussbaumer
          -> Instance.List               -- ^ The instance list
872 c85abf30 René Nussbaumer
          -> [(Instance.Instance, Int)]  -- ^ The instance to allocate
873 c85abf30 René Nussbaumer
          -> AllocSolutionList           -- ^ Possible solution list
874 c85abf30 René Nussbaumer
          -> Result (Node.List, Instance.List,
875 c85abf30 René Nussbaumer
                     AllocSolutionList)  -- ^ The final solution list
876 c85abf30 René Nussbaumer
allocList _  nl il [] result = Ok (nl, il, result)
877 c85abf30 René Nussbaumer
allocList gl nl il ((xi, xicnt):xies) result = do
878 c85abf30 René Nussbaumer
  ares <- tryMGAlloc gl nl il xi xicnt
879 c85abf30 René Nussbaumer
  let sol = asSolution ares
880 c85abf30 René Nussbaumer
      nl' = extractNl nl sol
881 c85abf30 René Nussbaumer
      il' = updateIl il sol
882 c85abf30 René Nussbaumer
  allocList gl nl' il' xies ((xi, ares):result)
883 c85abf30 René Nussbaumer
884 47eed3f4 Iustin Pop
-- | Function which fails if the requested mode is change secondary.
885 47eed3f4 Iustin Pop
--
886 47eed3f4 Iustin Pop
-- This is useful since except DRBD, no other disk template can
887 47eed3f4 Iustin Pop
-- execute change secondary; thus, we can just call this function
888 47eed3f4 Iustin Pop
-- instead of always checking for secondary mode. After the call to
889 47eed3f4 Iustin Pop
-- this function, whatever mode we have is just a primary change.
890 47eed3f4 Iustin Pop
failOnSecondaryChange :: (Monad m) => EvacMode -> DiskTemplate -> m ()
891 47eed3f4 Iustin Pop
failOnSecondaryChange ChangeSecondary dt =
892 9fc18384 Iustin Pop
  fail $ "Instances with disk template '" ++ diskTemplateToRaw dt ++
893 47eed3f4 Iustin Pop
         "' can't execute change secondary"
894 47eed3f4 Iustin Pop
failOnSecondaryChange _ _ = return ()
895 47eed3f4 Iustin Pop
896 47eed3f4 Iustin Pop
-- | Run evacuation for a single instance.
897 20b376ff Iustin Pop
--
898 20b376ff Iustin Pop
-- /Note:/ this function should correctly execute both intra-group
899 20b376ff Iustin Pop
-- evacuations (in all modes) and inter-group evacuations (in the
900 20b376ff Iustin Pop
-- 'ChangeAll' mode). Of course, this requires that the correct list
901 20b376ff Iustin Pop
-- of target nodes is passed.
902 47eed3f4 Iustin Pop
nodeEvacInstance :: Node.List         -- ^ The node list (cluster-wide)
903 47eed3f4 Iustin Pop
                 -> Instance.List     -- ^ Instance list (cluster-wide)
904 47eed3f4 Iustin Pop
                 -> EvacMode          -- ^ The evacuation mode
905 47eed3f4 Iustin Pop
                 -> Instance.Instance -- ^ The instance to be evacuated
906 a86fbf36 Iustin Pop
                 -> Gdx               -- ^ The group we're targetting
907 47eed3f4 Iustin Pop
                 -> [Ndx]             -- ^ The list of available nodes
908 47eed3f4 Iustin Pop
                                      -- for allocation
909 47eed3f4 Iustin Pop
                 -> Result (Node.List, Instance.List, [OpCodes.OpCode])
910 f9f6480e Iustin Pop
nodeEvacInstance nl il mode inst@(Instance.Instance
911 f9f6480e Iustin Pop
                                  {Instance.diskTemplate = dt@DTDiskless})
912 f9f6480e Iustin Pop
                 gdx avail_nodes =
913 f9f6480e Iustin Pop
                   failOnSecondaryChange mode dt >>
914 f9f6480e Iustin Pop
                   evacOneNodeOnly nl il inst gdx avail_nodes
915 47eed3f4 Iustin Pop
916 47eed3f4 Iustin Pop
nodeEvacInstance _ _ _ (Instance.Instance
917 a86fbf36 Iustin Pop
                        {Instance.diskTemplate = DTPlain}) _ _ =
918 47eed3f4 Iustin Pop
                  fail "Instances of type plain cannot be relocated"
919 47eed3f4 Iustin Pop
920 47eed3f4 Iustin Pop
nodeEvacInstance _ _ _ (Instance.Instance
921 a86fbf36 Iustin Pop
                        {Instance.diskTemplate = DTFile}) _ _ =
922 47eed3f4 Iustin Pop
                  fail "Instances of type file cannot be relocated"
923 47eed3f4 Iustin Pop
924 f9f6480e Iustin Pop
nodeEvacInstance nl il mode inst@(Instance.Instance
925 f9f6480e Iustin Pop
                                  {Instance.diskTemplate = dt@DTSharedFile})
926 f9f6480e Iustin Pop
                 gdx avail_nodes =
927 f9f6480e Iustin Pop
                   failOnSecondaryChange mode dt >>
928 f9f6480e Iustin Pop
                   evacOneNodeOnly nl il inst gdx avail_nodes
929 47eed3f4 Iustin Pop
930 f9f6480e Iustin Pop
nodeEvacInstance nl il mode inst@(Instance.Instance
931 f9f6480e Iustin Pop
                                  {Instance.diskTemplate = dt@DTBlock})
932 f9f6480e Iustin Pop
                 gdx avail_nodes =
933 f9f6480e Iustin Pop
                   failOnSecondaryChange mode dt >>
934 f9f6480e Iustin Pop
                   evacOneNodeOnly nl il inst gdx avail_nodes
935 47eed3f4 Iustin Pop
936 f9f6480e Iustin Pop
nodeEvacInstance nl il mode inst@(Instance.Instance
937 f9f6480e Iustin Pop
                                  {Instance.diskTemplate = dt@DTRbd})
938 f9f6480e Iustin Pop
                 gdx avail_nodes =
939 f9f6480e Iustin Pop
                   failOnSecondaryChange mode dt >>
940 f9f6480e Iustin Pop
                   evacOneNodeOnly nl il inst gdx avail_nodes
941 bdd6931c Guido Trotter
942 277a2ec9 Constantinos Venetsanopoulos
nodeEvacInstance nl il mode inst@(Instance.Instance
943 277a2ec9 Constantinos Venetsanopoulos
                                  {Instance.diskTemplate = dt@DTExt})
944 277a2ec9 Constantinos Venetsanopoulos
                 gdx avail_nodes =
945 277a2ec9 Constantinos Venetsanopoulos
                   failOnSecondaryChange mode dt >>
946 277a2ec9 Constantinos Venetsanopoulos
                   evacOneNodeOnly nl il inst gdx avail_nodes
947 277a2ec9 Constantinos Venetsanopoulos
948 bef83fd1 Iustin Pop
nodeEvacInstance nl il ChangePrimary
949 a86fbf36 Iustin Pop
                 inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
950 a86fbf36 Iustin Pop
                 _ _ =
951 bef83fd1 Iustin Pop
  do
952 bef83fd1 Iustin Pop
    (nl', inst', _, _) <- opToResult $ applyMove nl inst Failover
953 bef83fd1 Iustin Pop
    let idx = Instance.idx inst
954 bef83fd1 Iustin Pop
        il' = Container.add idx inst' il
955 bef83fd1 Iustin Pop
        ops = iMoveToJob nl' il' idx Failover
956 bef83fd1 Iustin Pop
    return (nl', il', ops)
957 bef83fd1 Iustin Pop
958 db56cfc4 Iustin Pop
nodeEvacInstance nl il ChangeSecondary
959 db56cfc4 Iustin Pop
                 inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
960 a86fbf36 Iustin Pop
                 gdx avail_nodes =
961 6ab3ce90 Iustin Pop
  evacOneNodeOnly nl il inst gdx avail_nodes
962 db56cfc4 Iustin Pop
963 97da6b71 Iustin Pop
-- The algorithm for ChangeAll is as follows:
964 97da6b71 Iustin Pop
--
965 97da6b71 Iustin Pop
-- * generate all (primary, secondary) node pairs for the target groups
966 97da6b71 Iustin Pop
-- * for each pair, execute the needed moves (r:s, f, r:s) and compute
967 97da6b71 Iustin Pop
--   the final node list state and group score
968 97da6b71 Iustin Pop
-- * select the best choice via a foldl that uses the same Either
969 97da6b71 Iustin Pop
--   String solution as the ChangeSecondary mode
970 d52d41de Iustin Pop
nodeEvacInstance nl il ChangeAll
971 d52d41de Iustin Pop
                 inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
972 a86fbf36 Iustin Pop
                 gdx avail_nodes =
973 d52d41de Iustin Pop
  do
974 97da6b71 Iustin Pop
    let no_nodes = Left "no nodes available"
975 97da6b71 Iustin Pop
        node_pairs = [(p,s) | p <- avail_nodes, s <- avail_nodes, p /= s]
976 97da6b71 Iustin Pop
    (nl', il', ops, _) <-
977 2cdaf225 Iustin Pop
        annotateResult "Can't find any good nodes for relocation" .
978 d52d41de Iustin Pop
        eitherToResult $
979 97da6b71 Iustin Pop
        foldl'
980 97da6b71 Iustin Pop
        (\accu nodes -> case evacDrbdAllInner nl il inst gdx nodes of
981 97da6b71 Iustin Pop
                          Bad msg ->
982 97da6b71 Iustin Pop
                              case accu of
983 97da6b71 Iustin Pop
                                Right _ -> accu
984 97da6b71 Iustin Pop
                                -- we don't need more details (which
985 97da6b71 Iustin Pop
                                -- nodes, etc.) as we only selected
986 97da6b71 Iustin Pop
                                -- this group if we can allocate on
987 97da6b71 Iustin Pop
                                -- it, hence failures will not
988 97da6b71 Iustin Pop
                                -- propagate out of this fold loop
989 97da6b71 Iustin Pop
                                Left _ -> Left $ "Allocation failed: " ++ msg
990 97da6b71 Iustin Pop
                          Ok result@(_, _, _, new_cv) ->
991 97da6b71 Iustin Pop
                              let new_accu = Right result in
992 97da6b71 Iustin Pop
                              case accu of
993 97da6b71 Iustin Pop
                                Left _ -> new_accu
994 97da6b71 Iustin Pop
                                Right (_, _, _, old_cv) ->
995 97da6b71 Iustin Pop
                                    if old_cv < new_cv
996 97da6b71 Iustin Pop
                                    then accu
997 97da6b71 Iustin Pop
                                    else new_accu
998 97da6b71 Iustin Pop
        ) no_nodes node_pairs
999 97da6b71 Iustin Pop
1000 97da6b71 Iustin Pop
    return (nl', il', ops)
1001 47eed3f4 Iustin Pop
1002 6ab3ce90 Iustin Pop
-- | Generic function for changing one node of an instance.
1003 6ab3ce90 Iustin Pop
--
1004 6ab3ce90 Iustin Pop
-- This is similar to 'nodeEvacInstance' but will be used in a few of
1005 a1741ae5 Iustin Pop
-- its sub-patterns. It folds the inner function 'evacOneNodeInner'
1006 a1741ae5 Iustin Pop
-- over the list of available nodes, which results in the best choice
1007 a1741ae5 Iustin Pop
-- for relocation.
1008 6ab3ce90 Iustin Pop
evacOneNodeOnly :: Node.List         -- ^ The node list (cluster-wide)
1009 6ab3ce90 Iustin Pop
                -> Instance.List     -- ^ Instance list (cluster-wide)
1010 6ab3ce90 Iustin Pop
                -> Instance.Instance -- ^ The instance to be evacuated
1011 6ab3ce90 Iustin Pop
                -> Gdx               -- ^ The group we're targetting
1012 6ab3ce90 Iustin Pop
                -> [Ndx]             -- ^ The list of available nodes
1013 6ab3ce90 Iustin Pop
                                      -- for allocation
1014 6ab3ce90 Iustin Pop
                -> Result (Node.List, Instance.List, [OpCodes.OpCode])
1015 6ab3ce90 Iustin Pop
evacOneNodeOnly nl il inst gdx avail_nodes = do
1016 fafd0773 Iustin Pop
  op_fn <- case Instance.mirrorType inst of
1017 6ab3ce90 Iustin Pop
             MirrorNone -> Bad "Can't relocate/evacuate non-mirrored instances"
1018 6ab3ce90 Iustin Pop
             MirrorInternal -> Ok ReplaceSecondary
1019 6ab3ce90 Iustin Pop
             MirrorExternal -> Ok FailoverToAny
1020 2cdaf225 Iustin Pop
  (nl', inst', _, ndx) <- annotateResult "Can't find any good node" .
1021 6ab3ce90 Iustin Pop
                          eitherToResult $
1022 a1741ae5 Iustin Pop
                          foldl' (evacOneNodeInner nl inst gdx op_fn)
1023 6ab3ce90 Iustin Pop
                          (Left "no nodes available") avail_nodes
1024 6ab3ce90 Iustin Pop
  let idx = Instance.idx inst
1025 6ab3ce90 Iustin Pop
      il' = Container.add idx inst' il
1026 6ab3ce90 Iustin Pop
      ops = iMoveToJob nl' il' idx (op_fn ndx)
1027 6ab3ce90 Iustin Pop
  return (nl', il', ops)
1028 6ab3ce90 Iustin Pop
1029 a1741ae5 Iustin Pop
-- | Inner fold function for changing one node of an instance.
1030 a1741ae5 Iustin Pop
--
1031 a1741ae5 Iustin Pop
-- Depending on the instance disk template, this will either change
1032 a1741ae5 Iustin Pop
-- the secondary (for DRBD) or the primary node (for shared
1033 a1741ae5 Iustin Pop
-- storage). However, the operation is generic otherwise.
1034 db56cfc4 Iustin Pop
--
1035 97da6b71 Iustin Pop
-- The running solution is either a @Left String@, which means we
1036 db56cfc4 Iustin Pop
-- don't have yet a working solution, or a @Right (...)@, which
1037 db56cfc4 Iustin Pop
-- represents a valid solution; it holds the modified node list, the
1038 db56cfc4 Iustin Pop
-- modified instance (after evacuation), the score of that solution,
1039 db56cfc4 Iustin Pop
-- and the new secondary node index.
1040 a1741ae5 Iustin Pop
evacOneNodeInner :: Node.List         -- ^ Cluster node list
1041 a1741ae5 Iustin Pop
                 -> Instance.Instance -- ^ Instance being evacuated
1042 a1741ae5 Iustin Pop
                 -> Gdx               -- ^ The group index of the instance
1043 a1741ae5 Iustin Pop
                 -> (Ndx -> IMove)    -- ^ Operation constructor
1044 a1741ae5 Iustin Pop
                 -> EvacInnerState    -- ^ Current best solution
1045 a1741ae5 Iustin Pop
                 -> Ndx               -- ^ Node we're evaluating as target
1046 a1741ae5 Iustin Pop
                 -> EvacInnerState    -- ^ New best solution
1047 a1741ae5 Iustin Pop
evacOneNodeInner nl inst gdx op_fn accu ndx =
1048 80b27509 Iustin Pop
  case applyMove nl inst (op_fn ndx) of
1049 a8038349 Iustin Pop
    Bad fm -> let fail_msg = "Node " ++ Container.nameOf nl ndx ++
1050 a8038349 Iustin Pop
                             " failed: " ++ show fm
1051 a8038349 Iustin Pop
              in either (const $ Left fail_msg) (const accu) accu
1052 a8038349 Iustin Pop
    Ok (nl', inst', _, _) ->
1053 9fc18384 Iustin Pop
      let nodes = Container.elems nl'
1054 9fc18384 Iustin Pop
          -- The fromJust below is ugly (it can fail nastily), but
1055 9fc18384 Iustin Pop
          -- at this point we should have any internal mismatches,
1056 9fc18384 Iustin Pop
          -- and adding a monad here would be quite involved
1057 9fc18384 Iustin Pop
          grpnodes = fromJust (gdx `lookup` Node.computeGroups nodes)
1058 9fc18384 Iustin Pop
          new_cv = compCVNodes grpnodes
1059 9fc18384 Iustin Pop
          new_accu = Right (nl', inst', new_cv, ndx)
1060 9fc18384 Iustin Pop
      in case accu of
1061 9fc18384 Iustin Pop
           Left _ -> new_accu
1062 9fc18384 Iustin Pop
           Right (_, _, old_cv, _) ->
1063 9fc18384 Iustin Pop
             if old_cv < new_cv
1064 9fc18384 Iustin Pop
               then accu
1065 9fc18384 Iustin Pop
               else new_accu
1066 db56cfc4 Iustin Pop
1067 97da6b71 Iustin Pop
-- | Compute result of changing all nodes of a DRBD instance.
1068 97da6b71 Iustin Pop
--
1069 97da6b71 Iustin Pop
-- Given the target primary and secondary node (which might be in a
1070 97da6b71 Iustin Pop
-- different group or not), this function will 'execute' all the
1071 97da6b71 Iustin Pop
-- required steps and assuming all operations succceed, will return
1072 97da6b71 Iustin Pop
-- the modified node and instance lists, the opcodes needed for this
1073 97da6b71 Iustin Pop
-- and the new group score.
1074 97da6b71 Iustin Pop
evacDrbdAllInner :: Node.List         -- ^ Cluster node list
1075 97da6b71 Iustin Pop
                 -> Instance.List     -- ^ Cluster instance list
1076 97da6b71 Iustin Pop
                 -> Instance.Instance -- ^ The instance to be moved
1077 97da6b71 Iustin Pop
                 -> Gdx               -- ^ The target group index
1078 97da6b71 Iustin Pop
                                      -- (which can differ from the
1079 97da6b71 Iustin Pop
                                      -- current group of the
1080 97da6b71 Iustin Pop
                                      -- instance)
1081 97da6b71 Iustin Pop
                 -> (Ndx, Ndx)        -- ^ Tuple of new
1082 97da6b71 Iustin Pop
                                      -- primary\/secondary nodes
1083 97da6b71 Iustin Pop
                 -> Result (Node.List, Instance.List, [OpCodes.OpCode], Score)
1084 9fc18384 Iustin Pop
evacDrbdAllInner nl il inst gdx (t_pdx, t_sdx) = do
1085 9fc18384 Iustin Pop
  let primary = Container.find (Instance.pNode inst) nl
1086 9fc18384 Iustin Pop
      idx = Instance.idx inst
1087 9fc18384 Iustin Pop
  -- if the primary is offline, then we first failover
1088 9fc18384 Iustin Pop
  (nl1, inst1, ops1) <-
1089 9fc18384 Iustin Pop
    if Node.offline primary
1090 9fc18384 Iustin Pop
      then do
1091 9fc18384 Iustin Pop
        (nl', inst', _, _) <-
1092 2cdaf225 Iustin Pop
          annotateResult "Failing over to the secondary" .
1093 9fc18384 Iustin Pop
          opToResult $ applyMove nl inst Failover
1094 9fc18384 Iustin Pop
        return (nl', inst', [Failover])
1095 9fc18384 Iustin Pop
      else return (nl, inst, [])
1096 9fc18384 Iustin Pop
  let (o1, o2, o3) = (ReplaceSecondary t_pdx,
1097 9fc18384 Iustin Pop
                      Failover,
1098 9fc18384 Iustin Pop
                      ReplaceSecondary t_sdx)
1099 9fc18384 Iustin Pop
  -- we now need to execute a replace secondary to the future
1100 9fc18384 Iustin Pop
  -- primary node
1101 9fc18384 Iustin Pop
  (nl2, inst2, _, _) <-
1102 2cdaf225 Iustin Pop
    annotateResult "Changing secondary to new primary" .
1103 9fc18384 Iustin Pop
    opToResult $
1104 9fc18384 Iustin Pop
    applyMove nl1 inst1 o1
1105 9fc18384 Iustin Pop
  let ops2 = o1:ops1
1106 9fc18384 Iustin Pop
  -- we now execute another failover, the primary stays fixed now
1107 2cdaf225 Iustin Pop
  (nl3, inst3, _, _) <- annotateResult "Failing over to new primary" .
1108 9fc18384 Iustin Pop
                        opToResult $ applyMove nl2 inst2 o2
1109 9fc18384 Iustin Pop
  let ops3 = o2:ops2
1110 9fc18384 Iustin Pop
  -- and finally another replace secondary, to the final secondary
1111 9fc18384 Iustin Pop
  (nl4, inst4, _, _) <-
1112 2cdaf225 Iustin Pop
    annotateResult "Changing secondary to final secondary" .
1113 9fc18384 Iustin Pop
    opToResult $
1114 9fc18384 Iustin Pop
    applyMove nl3 inst3 o3
1115 9fc18384 Iustin Pop
  let ops4 = o3:ops3
1116 9fc18384 Iustin Pop
      il' = Container.add idx inst4 il
1117 9fc18384 Iustin Pop
      ops = concatMap (iMoveToJob nl4 il' idx) $ reverse ops4
1118 9fc18384 Iustin Pop
  let nodes = Container.elems nl4
1119 9fc18384 Iustin Pop
      -- The fromJust below is ugly (it can fail nastily), but
1120 9fc18384 Iustin Pop
      -- at this point we should have any internal mismatches,
1121 9fc18384 Iustin Pop
      -- and adding a monad here would be quite involved
1122 9fc18384 Iustin Pop
      grpnodes = fromJust (gdx `lookup` Node.computeGroups nodes)
1123 9fc18384 Iustin Pop
      new_cv = compCVNodes grpnodes
1124 9fc18384 Iustin Pop
  return (nl4, il', ops, new_cv)
1125 97da6b71 Iustin Pop
1126 c9a9b853 Iustin Pop
-- | Computes the nodes in a given group which are available for
1127 c9a9b853 Iustin Pop
-- allocation.
1128 c9a9b853 Iustin Pop
availableGroupNodes :: [(Gdx, [Ndx])] -- ^ Group index/node index assoc list
1129 c9a9b853 Iustin Pop
                    -> IntSet.IntSet  -- ^ Nodes that are excluded
1130 c9a9b853 Iustin Pop
                    -> Gdx            -- ^ The group for which we
1131 c9a9b853 Iustin Pop
                                      -- query the nodes
1132 c9a9b853 Iustin Pop
                    -> Result [Ndx]   -- ^ List of available node indices
1133 c9a9b853 Iustin Pop
availableGroupNodes group_nodes excl_ndx gdx = do
1134 47eed3f4 Iustin Pop
  local_nodes <- maybe (Bad $ "Can't find group with index " ++ show gdx)
1135 47eed3f4 Iustin Pop
                 Ok (lookup gdx group_nodes)
1136 47eed3f4 Iustin Pop
  let avail_nodes = filter (not . flip IntSet.member excl_ndx) local_nodes
1137 47eed3f4 Iustin Pop
  return avail_nodes
1138 47eed3f4 Iustin Pop
1139 47eed3f4 Iustin Pop
-- | Updates the evac solution with the results of an instance
1140 47eed3f4 Iustin Pop
-- evacuation.
1141 47eed3f4 Iustin Pop
updateEvacSolution :: (Node.List, Instance.List, EvacSolution)
1142 5440c877 Iustin Pop
                   -> Idx
1143 47eed3f4 Iustin Pop
                   -> Result (Node.List, Instance.List, [OpCodes.OpCode])
1144 47eed3f4 Iustin Pop
                   -> (Node.List, Instance.List, EvacSolution)
1145 5440c877 Iustin Pop
updateEvacSolution (nl, il, es) idx (Bad msg) =
1146 9fc18384 Iustin Pop
  (nl, il, es { esFailed = (idx, msg):esFailed es})
1147 5440c877 Iustin Pop
updateEvacSolution (_, _, es) idx (Ok (nl, il, opcodes)) =
1148 9fc18384 Iustin Pop
  (nl, il, es { esMoved = new_elem:esMoved es
1149 9fc18384 Iustin Pop
              , esOpCodes = opcodes:esOpCodes es })
1150 9fc18384 Iustin Pop
    where inst = Container.find idx il
1151 9fc18384 Iustin Pop
          new_elem = (idx,
1152 9fc18384 Iustin Pop
                      instancePriGroup nl inst,
1153 9fc18384 Iustin Pop
                      Instance.allNodes inst)
1154 47eed3f4 Iustin Pop
1155 47eed3f4 Iustin Pop
-- | Node-evacuation IAllocator mode main function.
1156 47eed3f4 Iustin Pop
tryNodeEvac :: Group.List    -- ^ The cluster groups
1157 47eed3f4 Iustin Pop
            -> Node.List     -- ^ The node list (cluster-wide, not per group)
1158 47eed3f4 Iustin Pop
            -> Instance.List -- ^ Instance list (cluster-wide)
1159 47eed3f4 Iustin Pop
            -> EvacMode      -- ^ The evacuation mode
1160 47eed3f4 Iustin Pop
            -> [Idx]         -- ^ List of instance (indices) to be evacuated
1161 4036f63a Iustin Pop
            -> Result (Node.List, Instance.List, EvacSolution)
1162 47eed3f4 Iustin Pop
tryNodeEvac _ ini_nl ini_il mode idxs =
1163 9fc18384 Iustin Pop
  let evac_ndx = nodesToEvacuate ini_il mode idxs
1164 9fc18384 Iustin Pop
      offline = map Node.idx . filter Node.offline $ Container.elems ini_nl
1165 9fc18384 Iustin Pop
      excl_ndx = foldl' (flip IntSet.insert) evac_ndx offline
1166 9fc18384 Iustin Pop
      group_ndx = map (\(gdx, (nl, _)) -> (gdx, map Node.idx
1167 9fc18384 Iustin Pop
                                           (Container.elems nl))) $
1168 9fc18384 Iustin Pop
                  splitCluster ini_nl ini_il
1169 9fc18384 Iustin Pop
      (fin_nl, fin_il, esol) =
1170 9fc18384 Iustin Pop
        foldl' (\state@(nl, il, _) inst ->
1171 9fc18384 Iustin Pop
                  let gdx = instancePriGroup nl inst
1172 9fc18384 Iustin Pop
                      pdx = Instance.pNode inst in
1173 9fc18384 Iustin Pop
                  updateEvacSolution state (Instance.idx inst) $
1174 9fc18384 Iustin Pop
                  availableGroupNodes group_ndx
1175 9fc18384 Iustin Pop
                    (IntSet.insert pdx excl_ndx) gdx >>=
1176 9fc18384 Iustin Pop
                      nodeEvacInstance nl il mode inst gdx
1177 9fc18384 Iustin Pop
               )
1178 9fc18384 Iustin Pop
        (ini_nl, ini_il, emptyEvacSolution)
1179 9fc18384 Iustin Pop
        (map (`Container.find` ini_il) idxs)
1180 9fc18384 Iustin Pop
  in return (fin_nl, fin_il, reverseEvacSolution esol)
1181 47eed3f4 Iustin Pop
1182 20b376ff Iustin Pop
-- | Change-group IAllocator mode main function.
1183 20b376ff Iustin Pop
--
1184 20b376ff Iustin Pop
-- This is very similar to 'tryNodeEvac', the only difference is that
1185 20b376ff Iustin Pop
-- we don't choose as target group the current instance group, but
1186 20b376ff Iustin Pop
-- instead:
1187 20b376ff Iustin Pop
--
1188 20b376ff Iustin Pop
--   1. at the start of the function, we compute which are the target
1189 20b376ff Iustin Pop
--   groups; either no groups were passed in, in which case we choose
1190 20b376ff Iustin Pop
--   all groups out of which we don't evacuate instance, or there were
1191 20b376ff Iustin Pop
--   some groups passed, in which case we use those
1192 20b376ff Iustin Pop
--
1193 20b376ff Iustin Pop
--   2. for each instance, we use 'findBestAllocGroup' to choose the
1194 20b376ff Iustin Pop
--   best group to hold the instance, and then we do what
1195 20b376ff Iustin Pop
--   'tryNodeEvac' does, except for this group instead of the current
1196 20b376ff Iustin Pop
--   instance group.
1197 20b376ff Iustin Pop
--
1198 20b376ff Iustin Pop
-- Note that the correct behaviour of this function relies on the
1199 20b376ff Iustin Pop
-- function 'nodeEvacInstance' to be able to do correctly both
1200 20b376ff Iustin Pop
-- intra-group and inter-group moves when passed the 'ChangeAll' mode.
1201 20b376ff Iustin Pop
tryChangeGroup :: Group.List    -- ^ The cluster groups
1202 20b376ff Iustin Pop
               -> Node.List     -- ^ The node list (cluster-wide)
1203 20b376ff Iustin Pop
               -> Instance.List -- ^ Instance list (cluster-wide)
1204 20b376ff Iustin Pop
               -> [Gdx]         -- ^ Target groups; if empty, any
1205 20b376ff Iustin Pop
                                -- groups not being evacuated
1206 20b376ff Iustin Pop
               -> [Idx]         -- ^ List of instance (indices) to be evacuated
1207 4036f63a Iustin Pop
               -> Result (Node.List, Instance.List, EvacSolution)
1208 20b376ff Iustin Pop
tryChangeGroup gl ini_nl ini_il gdxs idxs =
1209 9fc18384 Iustin Pop
  let evac_gdxs = nub $ map (instancePriGroup ini_nl .
1210 9fc18384 Iustin Pop
                             flip Container.find ini_il) idxs
1211 9fc18384 Iustin Pop
      target_gdxs = (if null gdxs
1212 20b376ff Iustin Pop
                       then Container.keys gl
1213 20b376ff Iustin Pop
                       else gdxs) \\ evac_gdxs
1214 9fc18384 Iustin Pop
      offline = map Node.idx . filter Node.offline $ Container.elems ini_nl
1215 9fc18384 Iustin Pop
      excl_ndx = foldl' (flip IntSet.insert) IntSet.empty offline
1216 9fc18384 Iustin Pop
      group_ndx = map (\(gdx, (nl, _)) -> (gdx, map Node.idx
1217 9fc18384 Iustin Pop
                                           (Container.elems nl))) $
1218 9fc18384 Iustin Pop
                  splitCluster ini_nl ini_il
1219 9fc18384 Iustin Pop
      (fin_nl, fin_il, esol) =
1220 9fc18384 Iustin Pop
        foldl' (\state@(nl, il, _) inst ->
1221 9fc18384 Iustin Pop
                  let solution = do
1222 9fc18384 Iustin Pop
                        let ncnt = Instance.requiredNodes $
1223 9fc18384 Iustin Pop
                                   Instance.diskTemplate inst
1224 9fc18384 Iustin Pop
                        (gdx, _, _) <- findBestAllocGroup gl nl il
1225 9fc18384 Iustin Pop
                                       (Just target_gdxs) inst ncnt
1226 9fc18384 Iustin Pop
                        av_nodes <- availableGroupNodes group_ndx
1227 9fc18384 Iustin Pop
                                    excl_ndx gdx
1228 9fc18384 Iustin Pop
                        nodeEvacInstance nl il ChangeAll inst gdx av_nodes
1229 9fc18384 Iustin Pop
                  in updateEvacSolution state (Instance.idx inst) solution
1230 9fc18384 Iustin Pop
               )
1231 9fc18384 Iustin Pop
        (ini_nl, ini_il, emptyEvacSolution)
1232 9fc18384 Iustin Pop
        (map (`Container.find` ini_il) idxs)
1233 9fc18384 Iustin Pop
  in return (fin_nl, fin_il, reverseEvacSolution esol)
1234 20b376ff Iustin Pop
1235 7eda951b Iustin Pop
-- | Standard-sized allocation method.
1236 7eda951b Iustin Pop
--
1237 7eda951b Iustin Pop
-- This places instances of the same size on the cluster until we're
1238 7eda951b Iustin Pop
-- out of space. The result will be a list of identically-sized
1239 7eda951b Iustin Pop
-- instances.
1240 7eda951b Iustin Pop
iterateAlloc :: AllocMethod
1241 8f48f67d Iustin Pop
iterateAlloc nl il limit newinst allocnodes ixes cstats =
1242 9fc18384 Iustin Pop
  let depth = length ixes
1243 9fc18384 Iustin Pop
      newname = printf "new-%d" depth::String
1244 dce9bbb3 Iustin Pop
      newidx = Container.size il
1245 9fc18384 Iustin Pop
      newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
1246 9fc18384 Iustin Pop
      newlimit = fmap (flip (-) 1) limit
1247 9fc18384 Iustin Pop
  in case tryAlloc nl il newi2 allocnodes of
1248 9fc18384 Iustin Pop
       Bad s -> Bad s
1249 9fc18384 Iustin Pop
       Ok (AllocSolution { asFailures = errs, asSolution = sols3 }) ->
1250 9fc18384 Iustin Pop
         let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in
1251 9fc18384 Iustin Pop
         case sols3 of
1252 9fc18384 Iustin Pop
           Nothing -> newsol
1253 9fc18384 Iustin Pop
           Just (xnl, xi, _, _) ->
1254 9fc18384 Iustin Pop
             if limit == Just 0
1255 9fc18384 Iustin Pop
               then newsol
1256 9fc18384 Iustin Pop
               else iterateAlloc xnl (Container.add newidx xi il)
1257 9fc18384 Iustin Pop
                      newlimit newinst allocnodes (xi:ixes)
1258 9fc18384 Iustin Pop
                      (totalResources xnl:cstats)
1259 3ce8009a Iustin Pop
1260 7eda951b Iustin Pop
-- | Tiered allocation method.
1261 7eda951b Iustin Pop
--
1262 7eda951b Iustin Pop
-- This places instances on the cluster, and decreases the spec until
1263 7eda951b Iustin Pop
-- we can allocate again. The result will be a list of decreasing
1264 7eda951b Iustin Pop
-- instance specs.
1265 7eda951b Iustin Pop
tieredAlloc :: AllocMethod
1266 8f48f67d Iustin Pop
tieredAlloc nl il limit newinst allocnodes ixes cstats =
1267 9fc18384 Iustin Pop
  case iterateAlloc nl il limit newinst allocnodes ixes cstats of
1268 9fc18384 Iustin Pop
    Bad s -> Bad s
1269 9fc18384 Iustin Pop
    Ok (errs, nl', il', ixes', cstats') ->
1270 9fc18384 Iustin Pop
      let newsol = Ok (errs, nl', il', ixes', cstats')
1271 9fc18384 Iustin Pop
          ixes_cnt = length ixes'
1272 9fc18384 Iustin Pop
          (stop, newlimit) = case limit of
1273 9fc18384 Iustin Pop
                               Nothing -> (False, Nothing)
1274 9fc18384 Iustin Pop
                               Just n -> (n <= ixes_cnt,
1275 9fc18384 Iustin Pop
                                            Just (n - ixes_cnt)) in
1276 9fc18384 Iustin Pop
      if stop then newsol else
1277 3ce8009a Iustin Pop
          case Instance.shrinkByType newinst . fst . last $
1278 3ce8009a Iustin Pop
               sortBy (comparing snd) errs of
1279 8f48f67d Iustin Pop
            Bad _ -> newsol
1280 8f48f67d Iustin Pop
            Ok newinst' -> tieredAlloc nl' il' newlimit
1281 8f48f67d Iustin Pop
                           newinst' allocnodes ixes' cstats'
1282 3ce8009a Iustin Pop
1283 9188aeef Iustin Pop
-- * Formatting functions
1284 e4f08c46 Iustin Pop
1285 e4f08c46 Iustin Pop
-- | Given the original and final nodes, computes the relocation description.
1286 c9926b22 Iustin Pop
computeMoves :: Instance.Instance -- ^ The instance to be moved
1287 c9926b22 Iustin Pop
             -> String -- ^ The instance name
1288 668c03b3 Iustin Pop
             -> IMove  -- ^ The move being performed
1289 e4f08c46 Iustin Pop
             -> String -- ^ New primary
1290 e4f08c46 Iustin Pop
             -> String -- ^ New secondary
1291 e4f08c46 Iustin Pop
             -> (String, [String])
1292 e4f08c46 Iustin Pop
                -- ^ Tuple of moves and commands list; moves is containing
1293 e4f08c46 Iustin Pop
                -- either @/f/@ for failover or @/r:name/@ for replace
1294 e4f08c46 Iustin Pop
                -- secondary, while the command list holds gnt-instance
1295 e4f08c46 Iustin Pop
                -- commands (without that prefix), e.g \"@failover instance1@\"
1296 668c03b3 Iustin Pop
computeMoves i inam mv c d =
1297 9fc18384 Iustin Pop
  case mv of
1298 9fc18384 Iustin Pop
    Failover -> ("f", [mig])
1299 0c8cef35 Iustin Pop
    FailoverToAny _ -> (printf "fa:%s" c, [mig_any])
1300 9fc18384 Iustin Pop
    FailoverAndReplace _ -> (printf "f r:%s" d, [mig, rep d])
1301 9fc18384 Iustin Pop
    ReplaceSecondary _ -> (printf "r:%s" d, [rep d])
1302 9fc18384 Iustin Pop
    ReplaceAndFailover _ -> (printf "r:%s f" c, [rep c, mig])
1303 9fc18384 Iustin Pop
    ReplacePrimary _ -> (printf "f r:%s f" c, [mig, rep c, mig])
1304 7959cbb9 Iustin Pop
  where morf = if Instance.isRunning i then "migrate" else "failover"
1305 9fc18384 Iustin Pop
        mig = printf "%s -f %s" morf inam::String
1306 5850e990 Iustin Pop
        mig_any = printf "%s -f -n %s %s" morf c inam::String
1307 5850e990 Iustin Pop
        rep n = printf "replace-disks -n %s %s" n inam::String
1308 e4f08c46 Iustin Pop
1309 9188aeef Iustin Pop
-- | Converts a placement to string format.
1310 9188aeef Iustin Pop
printSolutionLine :: Node.List     -- ^ The node list
1311 9188aeef Iustin Pop
                  -> Instance.List -- ^ The instance list
1312 9188aeef Iustin Pop
                  -> Int           -- ^ Maximum node name length
1313 9188aeef Iustin Pop
                  -> Int           -- ^ Maximum instance name length
1314 9188aeef Iustin Pop
                  -> Placement     -- ^ The current placement
1315 9188aeef Iustin Pop
                  -> Int           -- ^ The index of the placement in
1316 9188aeef Iustin Pop
                                   -- the solution
1317 db1bcfe8 Iustin Pop
                  -> (String, [String])
1318 db1bcfe8 Iustin Pop
printSolutionLine nl il nmlen imlen plc pos =
1319 9fc18384 Iustin Pop
  let pmlen = (2*nmlen + 1)
1320 9fc18384 Iustin Pop
      (i, p, s, mv, c) = plc
1321 e85444d0 Iustin Pop
      old_sec = Instance.sNode inst
1322 9fc18384 Iustin Pop
      inst = Container.find i il
1323 9fc18384 Iustin Pop
      inam = Instance.alias inst
1324 9fc18384 Iustin Pop
      npri = Node.alias $ Container.find p nl
1325 9fc18384 Iustin Pop
      nsec = Node.alias $ Container.find s nl
1326 9fc18384 Iustin Pop
      opri = Node.alias $ Container.find (Instance.pNode inst) nl
1327 e85444d0 Iustin Pop
      osec = Node.alias $ Container.find old_sec nl
1328 9fc18384 Iustin Pop
      (moves, cmds) =  computeMoves inst inam mv npri nsec
1329 e85444d0 Iustin Pop
      -- FIXME: this should check instead/also the disk template
1330 e85444d0 Iustin Pop
      ostr = if old_sec == Node.noSecondary
1331 5850e990 Iustin Pop
               then printf "%s" opri::String
1332 5850e990 Iustin Pop
               else printf "%s:%s" opri osec::String
1333 e85444d0 Iustin Pop
      nstr = if s == Node.noSecondary
1334 5850e990 Iustin Pop
               then printf "%s" npri::String
1335 5850e990 Iustin Pop
               else printf "%s:%s" npri nsec::String
1336 255d140d Iustin Pop
  in (printf "  %3d. %-*s %-*s => %-*s %12.8f a=%s"
1337 5850e990 Iustin Pop
      pos imlen inam pmlen ostr pmlen nstr c moves,
1338 9fc18384 Iustin Pop
      cmds)
1339 ca8258d9 Iustin Pop
1340 0e8ae201 Iustin Pop
-- | Return the instance and involved nodes in an instance move.
1341 77ecfa82 Iustin Pop
--
1342 77ecfa82 Iustin Pop
-- Note that the output list length can vary, and is not required nor
1343 77ecfa82 Iustin Pop
-- guaranteed to be of any specific length.
1344 77ecfa82 Iustin Pop
involvedNodes :: Instance.List -- ^ Instance list, used for retrieving
1345 77ecfa82 Iustin Pop
                               -- the instance from its index; note
1346 77ecfa82 Iustin Pop
                               -- that this /must/ be the original
1347 77ecfa82 Iustin Pop
                               -- instance list, so that we can
1348 77ecfa82 Iustin Pop
                               -- retrieve the old nodes
1349 77ecfa82 Iustin Pop
              -> Placement     -- ^ The placement we're investigating,
1350 77ecfa82 Iustin Pop
                               -- containing the new nodes and
1351 77ecfa82 Iustin Pop
                               -- instance index
1352 77ecfa82 Iustin Pop
              -> [Ndx]         -- ^ Resulting list of node indices
1353 0e8ae201 Iustin Pop
involvedNodes il plc =
1354 9fc18384 Iustin Pop
  let (i, np, ns, _, _) = plc
1355 9fc18384 Iustin Pop
      inst = Container.find i il
1356 9fc18384 Iustin Pop
  in nub $ [np, ns] ++ Instance.allNodes inst
1357 0e8ae201 Iustin Pop
1358 0e8ae201 Iustin Pop
-- | Inner function for splitJobs, that either appends the next job to
1359 0e8ae201 Iustin Pop
-- the current jobset, or starts a new jobset.
1360 0e8ae201 Iustin Pop
mergeJobs :: ([JobSet], [Ndx]) -> MoveJob -> ([JobSet], [Ndx])
1361 924f9c16 Iustin Pop
mergeJobs ([], _) n@(ndx, _, _, _) = ([[n]], ndx)
1362 924f9c16 Iustin Pop
mergeJobs (cjs@(j:js), nbuf) n@(ndx, _, _, _)
1363 9fc18384 Iustin Pop
  | null (ndx `intersect` nbuf) = ((n:j):js, ndx ++ nbuf)
1364 9fc18384 Iustin Pop
  | otherwise = ([n]:cjs, ndx)
1365 0e8ae201 Iustin Pop
1366 0e8ae201 Iustin Pop
-- | Break a list of moves into independent groups. Note that this
1367 0e8ae201 Iustin Pop
-- will reverse the order of jobs.
1368 0e8ae201 Iustin Pop
splitJobs :: [MoveJob] -> [JobSet]
1369 0e8ae201 Iustin Pop
splitJobs = fst . foldl mergeJobs ([], [])
1370 0e8ae201 Iustin Pop
1371 0e8ae201 Iustin Pop
-- | Given a list of commands, prefix them with @gnt-instance@ and
1372 0e8ae201 Iustin Pop
-- also beautify the display a little.
1373 0e8ae201 Iustin Pop
formatJob :: Int -> Int -> (Int, MoveJob) -> [String]
1374 924f9c16 Iustin Pop
formatJob jsn jsl (sn, (_, _, _, cmds)) =
1375 9fc18384 Iustin Pop
  let out =
1376 9fc18384 Iustin Pop
        printf "  echo job %d/%d" jsn sn:
1377 9fc18384 Iustin Pop
        printf "  check":
1378 9fc18384 Iustin Pop
        map ("  gnt-instance " ++) cmds
1379 9fc18384 Iustin Pop
  in if sn == 1
1380 0e8ae201 Iustin Pop
       then ["", printf "echo jobset %d, %d jobs" jsn jsl] ++ out
1381 0e8ae201 Iustin Pop
       else out
1382 0e8ae201 Iustin Pop
1383 9188aeef Iustin Pop
-- | Given a list of commands, prefix them with @gnt-instance@ and
1384 9188aeef Iustin Pop
-- also beautify the display a little.
1385 0e8ae201 Iustin Pop
formatCmds :: [JobSet] -> String
1386 9f6dcdea Iustin Pop
formatCmds =
1387 9fc18384 Iustin Pop
  unlines .
1388 9fc18384 Iustin Pop
  concatMap (\(jsn, js) -> concatMap (formatJob jsn (length js))
1389 9fc18384 Iustin Pop
                           (zip [1..] js)) .
1390 9fc18384 Iustin Pop
  zip [1..]
1391 142538ff Iustin Pop
1392 e4f08c46 Iustin Pop
-- | Print the node list.
1393 e98fb766 Iustin Pop
printNodes :: Node.List -> [String] -> String
1394 e98fb766 Iustin Pop
printNodes nl fs =
1395 9fc18384 Iustin Pop
  let fields = case fs of
1396 9fc18384 Iustin Pop
                 [] -> Node.defaultFields
1397 9fc18384 Iustin Pop
                 "+":rest -> Node.defaultFields ++ rest
1398 9fc18384 Iustin Pop
                 _ -> fs
1399 9fc18384 Iustin Pop
      snl = sortBy (comparing Node.idx) (Container.elems nl)
1400 9fc18384 Iustin Pop
      (header, isnum) = unzip $ map Node.showHeader fields
1401 c3024b7e René Nussbaumer
  in printTable "" header (map (Node.list fields) snl) isnum
1402 e4f08c46 Iustin Pop
1403 507fda3f Iustin Pop
-- | Print the instance list.
1404 507fda3f Iustin Pop
printInsts :: Node.List -> Instance.List -> String
1405 507fda3f Iustin Pop
printInsts nl il =
1406 9fc18384 Iustin Pop
  let sil = sortBy (comparing Instance.idx) (Container.elems il)
1407 7959cbb9 Iustin Pop
      helper inst = [ if Instance.isRunning inst then "R" else " "
1408 9fc18384 Iustin Pop
                    , Instance.name inst
1409 9fc18384 Iustin Pop
                    , Container.nameOf nl (Instance.pNode inst)
1410 9fc18384 Iustin Pop
                    , let sdx = Instance.sNode inst
1411 9fc18384 Iustin Pop
                      in if sdx == Node.noSecondary
1412 5182e970 Iustin Pop
                           then  ""
1413 5182e970 Iustin Pop
                           else Container.nameOf nl sdx
1414 9fc18384 Iustin Pop
                    , if Instance.autoBalance inst then "Y" else "N"
1415 9fc18384 Iustin Pop
                    , printf "%3d" $ Instance.vcpus inst
1416 9fc18384 Iustin Pop
                    , printf "%5d" $ Instance.mem inst
1417 9fc18384 Iustin Pop
                    , printf "%5d" $ Instance.dsk inst `div` 1024
1418 9fc18384 Iustin Pop
                    , printf "%5.3f" lC
1419 9fc18384 Iustin Pop
                    , printf "%5.3f" lM
1420 9fc18384 Iustin Pop
                    , printf "%5.3f" lD
1421 9fc18384 Iustin Pop
                    , printf "%5.3f" lN
1422 9fc18384 Iustin Pop
                    ]
1423 9fc18384 Iustin Pop
          where DynUtil lC lM lD lN = Instance.util inst
1424 9fc18384 Iustin Pop
      header = [ "F", "Name", "Pri_node", "Sec_node", "Auto_bal"
1425 9fc18384 Iustin Pop
               , "vcpu", "mem" , "dsk", "lCpu", "lMem", "lDsk", "lNet" ]
1426 9fc18384 Iustin Pop
      isnum = False:False:False:False:False:repeat True
1427 c3024b7e René Nussbaumer
  in printTable "" header (map helper sil) isnum
1428 507fda3f Iustin Pop
1429 9188aeef Iustin Pop
-- | Shows statistics for a given node list.
1430 2922d2c5 René Nussbaumer
printStats :: String -> Node.List -> String
1431 2922d2c5 René Nussbaumer
printStats lp nl =
1432 9fc18384 Iustin Pop
  let dcvs = compDetailedCV $ Container.elems nl
1433 9fc18384 Iustin Pop
      (weights, names) = unzip detailedCVInfo
1434 9fc18384 Iustin Pop
      hd = zip3 (weights ++ repeat 1) (names ++ repeat "unknown") dcvs
1435 2922d2c5 René Nussbaumer
      header = [ "Field", "Value", "Weight" ]
1436 2922d2c5 René Nussbaumer
      formatted = map (\(w, h, val) ->
1437 2922d2c5 René Nussbaumer
                         [ h
1438 2922d2c5 René Nussbaumer
                         , printf "%.8f" val
1439 2922d2c5 René Nussbaumer
                         , printf "x%.2f" w
1440 2922d2c5 René Nussbaumer
                         ]) hd
1441 c3024b7e René Nussbaumer
  in printTable lp header formatted $ False:repeat True
1442 6b20875c Iustin Pop
1443 6b20875c Iustin Pop
-- | Convert a placement into a list of OpCodes (basically a job).
1444 179c0828 Iustin Pop
iMoveToJob :: Node.List        -- ^ The node list; only used for node
1445 179c0828 Iustin Pop
                               -- names, so any version is good
1446 179c0828 Iustin Pop
                               -- (before or after the operation)
1447 179c0828 Iustin Pop
           -> Instance.List    -- ^ The instance list; also used for
1448 179c0828 Iustin Pop
                               -- names only
1449 179c0828 Iustin Pop
           -> Idx              -- ^ The index of the instance being
1450 179c0828 Iustin Pop
                               -- moved
1451 179c0828 Iustin Pop
           -> IMove            -- ^ The actual move to be described
1452 179c0828 Iustin Pop
           -> [OpCodes.OpCode] -- ^ The list of opcodes equivalent to
1453 179c0828 Iustin Pop
                               -- the given move
1454 3e4480e0 Iustin Pop
iMoveToJob nl il idx move =
1455 9fc18384 Iustin Pop
  let inst = Container.find idx il
1456 9fc18384 Iustin Pop
      iname = Instance.name inst
1457 c7d249d0 Iustin Pop
      lookNode  n = case mkNonEmpty (Container.nameOf nl n) of
1458 c7d249d0 Iustin Pop
                      -- FIXME: convert htools codebase to non-empty strings
1459 c7d249d0 Iustin Pop
                      Bad msg -> error $ "Empty node name for idx " ++
1460 c7d249d0 Iustin Pop
                                 show n ++ ": " ++ msg ++ "??"
1461 c7d249d0 Iustin Pop
                      Ok ne -> Just ne
1462 3d7e87b8 Iustin Pop
      opF = OpCodes.OpInstanceMigrate
1463 3d7e87b8 Iustin Pop
              { OpCodes.opInstanceName        = iname
1464 3d7e87b8 Iustin Pop
              , OpCodes.opMigrationMode       = Nothing -- default
1465 3d7e87b8 Iustin Pop
              , OpCodes.opOldLiveMode         = Nothing -- default as well
1466 3d7e87b8 Iustin Pop
              , OpCodes.opTargetNode          = Nothing -- this is drbd
1467 3d7e87b8 Iustin Pop
              , OpCodes.opAllowRuntimeChanges = False
1468 3d7e87b8 Iustin Pop
              , OpCodes.opIgnoreIpolicy       = False
1469 3d7e87b8 Iustin Pop
              , OpCodes.opMigrationCleanup    = False
1470 3d7e87b8 Iustin Pop
              , OpCodes.opIallocator          = Nothing
1471 3d7e87b8 Iustin Pop
              , OpCodes.opAllowFailover       = True }
1472 3d7e87b8 Iustin Pop
      opFA n = opF { OpCodes.opTargetNode = lookNode n } -- not drbd
1473 3d7e87b8 Iustin Pop
      opR n = OpCodes.OpInstanceReplaceDisks
1474 3d7e87b8 Iustin Pop
                { OpCodes.opInstanceName     = iname
1475 3d7e87b8 Iustin Pop
                , OpCodes.opEarlyRelease     = False
1476 3d7e87b8 Iustin Pop
                , OpCodes.opIgnoreIpolicy    = False
1477 3d7e87b8 Iustin Pop
                , OpCodes.opReplaceDisksMode = OpCodes.ReplaceNewSecondary
1478 3d7e87b8 Iustin Pop
                , OpCodes.opReplaceDisksList = []
1479 3d7e87b8 Iustin Pop
                , OpCodes.opRemoteNode       = lookNode n
1480 3d7e87b8 Iustin Pop
                , OpCodes.opIallocator       = Nothing
1481 3d7e87b8 Iustin Pop
                }
1482 9fc18384 Iustin Pop
  in case move of
1483 9fc18384 Iustin Pop
       Failover -> [ opF ]
1484 0c8cef35 Iustin Pop
       FailoverToAny np -> [ opFA np ]
1485 9fc18384 Iustin Pop
       ReplacePrimary np -> [ opF, opR np, opF ]
1486 9fc18384 Iustin Pop
       ReplaceSecondary ns -> [ opR ns ]
1487 9fc18384 Iustin Pop
       ReplaceAndFailover np -> [ opR np, opF ]
1488 9fc18384 Iustin Pop
       FailoverAndReplace ns -> [ opF, opR ns ]
1489 32b8d9c0 Iustin Pop
1490 949397c8 Iustin Pop
-- * Node group functions
1491 949397c8 Iustin Pop
1492 525bfb36 Iustin Pop
-- | Computes the group of an instance.
1493 10ef6b4e Iustin Pop
instanceGroup :: Node.List -> Instance.Instance -> Result Gdx
1494 32b8d9c0 Iustin Pop
instanceGroup nl i =
1495 32b8d9c0 Iustin Pop
  let sidx = Instance.sNode i
1496 32b8d9c0 Iustin Pop
      pnode = Container.find (Instance.pNode i) nl
1497 32b8d9c0 Iustin Pop
      snode = if sidx == Node.noSecondary
1498 32b8d9c0 Iustin Pop
              then pnode
1499 32b8d9c0 Iustin Pop
              else Container.find sidx nl
1500 10ef6b4e Iustin Pop
      pgroup = Node.group pnode
1501 10ef6b4e Iustin Pop
      sgroup = Node.group snode
1502 10ef6b4e Iustin Pop
  in if pgroup /= sgroup
1503 9fc18384 Iustin Pop
       then fail ("Instance placed accross two node groups, primary " ++
1504 9fc18384 Iustin Pop
                  show pgroup ++ ", secondary " ++ show sgroup)
1505 9fc18384 Iustin Pop
       else return pgroup
1506 32b8d9c0 Iustin Pop
1507 525bfb36 Iustin Pop
-- | Computes the group of an instance per the primary node.
1508 4bc33d60 Iustin Pop
instancePriGroup :: Node.List -> Instance.Instance -> Gdx
1509 4bc33d60 Iustin Pop
instancePriGroup nl i =
1510 4bc33d60 Iustin Pop
  let pnode = Container.find (Instance.pNode i) nl
1511 4bc33d60 Iustin Pop
  in  Node.group pnode
1512 4bc33d60 Iustin Pop
1513 32b8d9c0 Iustin Pop
-- | Compute the list of badly allocated instances (split across node
1514 525bfb36 Iustin Pop
-- groups).
1515 32b8d9c0 Iustin Pop
findSplitInstances :: Node.List -> Instance.List -> [Instance.Instance]
1516 2a8e2dc9 Iustin Pop
findSplitInstances nl =
1517 2a8e2dc9 Iustin Pop
  filter (not . isOk . instanceGroup nl) . Container.elems
1518 f4161783 Iustin Pop
1519 525bfb36 Iustin Pop
-- | Splits a cluster into the component node groups.
1520 f4161783 Iustin Pop
splitCluster :: Node.List -> Instance.List ->
1521 10ef6b4e Iustin Pop
                [(Gdx, (Node.List, Instance.List))]
1522 f4161783 Iustin Pop
splitCluster nl il =
1523 f4161783 Iustin Pop
  let ngroups = Node.computeGroups (Container.elems nl)
1524 f4161783 Iustin Pop
  in map (\(guuid, nodes) ->
1525 f4161783 Iustin Pop
           let nidxs = map Node.idx nodes
1526 f4161783 Iustin Pop
               nodes' = zip nidxs nodes
1527 f4161783 Iustin Pop
               instances = Container.filter ((`elem` nidxs) . Instance.pNode) il
1528 cb0c77ff Iustin Pop
           in (guuid, (Container.fromList nodes', instances))) ngroups
1529 1f4ae205 Iustin Pop
1530 63a78055 Iustin Pop
-- | Compute the list of nodes that are to be evacuated, given a list
1531 63a78055 Iustin Pop
-- of instances and an evacuation mode.
1532 63a78055 Iustin Pop
nodesToEvacuate :: Instance.List -- ^ The cluster-wide instance list
1533 63a78055 Iustin Pop
                -> EvacMode      -- ^ The evacuation mode we're using
1534 63a78055 Iustin Pop
                -> [Idx]         -- ^ List of instance indices being evacuated
1535 63a78055 Iustin Pop
                -> IntSet.IntSet -- ^ Set of node indices
1536 63a78055 Iustin Pop
nodesToEvacuate il mode =
1537 9fc18384 Iustin Pop
  IntSet.delete Node.noSecondary .
1538 9fc18384 Iustin Pop
  foldl' (\ns idx ->
1539 9fc18384 Iustin Pop
            let i = Container.find idx il
1540 9fc18384 Iustin Pop
                pdx = Instance.pNode i
1541 9fc18384 Iustin Pop
                sdx = Instance.sNode i
1542 9fc18384 Iustin Pop
                dt = Instance.diskTemplate i
1543 9fc18384 Iustin Pop
                withSecondary = case dt of
1544 9fc18384 Iustin Pop
                                  DTDrbd8 -> IntSet.insert sdx ns
1545 9fc18384 Iustin Pop
                                  _ -> ns
1546 9fc18384 Iustin Pop
            in case mode of
1547 9fc18384 Iustin Pop
                 ChangePrimary   -> IntSet.insert pdx ns
1548 9fc18384 Iustin Pop
                 ChangeSecondary -> withSecondary
1549 9fc18384 Iustin Pop
                 ChangeAll       -> IntSet.insert pdx withSecondary
1550 9fc18384 Iustin Pop
         ) IntSet.empty