Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / Cluster.hs @ d52d41de

History | View | Annotate | Download (58.4 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 4bc33d60 Iustin Pop
Copyright (C) 2009, 2010, 2011 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 e4f08c46 Iustin Pop
    (
31 e4f08c46 Iustin Pop
     -- * Types
32 85d0ddc3 Iustin Pop
      AllocSolution(..)
33 47eed3f4 Iustin Pop
    , EvacSolution(..)
34 e4f08c46 Iustin Pop
    , Table(..)
35 1a7eff0e Iustin Pop
    , CStats(..)
36 9b8fac3d Iustin Pop
    , AllocStats
37 e4f08c46 Iustin Pop
    -- * Generic functions
38 e4f08c46 Iustin Pop
    , totalResources
39 9b8fac3d Iustin Pop
    , computeAllocationDelta
40 e4f08c46 Iustin Pop
    -- * First phase functions
41 e4f08c46 Iustin Pop
    , computeBadItems
42 e4f08c46 Iustin Pop
    -- * Second phase functions
43 7dfaafb1 Iustin Pop
    , printSolutionLine
44 142538ff Iustin Pop
    , formatCmds
45 0e8ae201 Iustin Pop
    , involvedNodes
46 0e8ae201 Iustin Pop
    , splitJobs
47 507fda3f Iustin Pop
    -- * Display functions
48 507fda3f Iustin Pop
    , printNodes
49 507fda3f Iustin Pop
    , printInsts
50 e4f08c46 Iustin Pop
    -- * Balacing functions
51 e4f08c46 Iustin Pop
    , checkMove
52 5ad86777 Iustin Pop
    , doNextBalance
53 f25e5aac Iustin Pop
    , tryBalance
54 e4f08c46 Iustin Pop
    , compCV
55 9bb5721c Iustin Pop
    , compCVNodes
56 6bc39970 Iustin Pop
    , compDetailedCV
57 e4f08c46 Iustin Pop
    , printStats
58 6b20875c Iustin Pop
    , iMoveToJob
59 4a340313 Iustin Pop
    -- * IAllocator functions
60 6cb1649f Iustin Pop
    , genAllocNodes
61 dbba5246 Iustin Pop
    , tryAlloc
62 9b1584fc Iustin Pop
    , tryMGAlloc
63 dbba5246 Iustin Pop
    , tryReloc
64 4bc33d60 Iustin Pop
    , tryMGReloc
65 12b0511d Iustin Pop
    , tryEvac
66 1bc47d38 Iustin Pop
    , tryMGEvac
67 47eed3f4 Iustin Pop
    , tryNodeEvac
68 478df686 Iustin Pop
    , collapseFailures
69 3ce8009a Iustin Pop
    -- * Allocation functions
70 3ce8009a Iustin Pop
    , iterateAlloc
71 3ce8009a Iustin Pop
    , tieredAlloc
72 949397c8 Iustin Pop
    , tieredSpecMap
73 949397c8 Iustin Pop
     -- * Node group functions
74 32b8d9c0 Iustin Pop
    , instanceGroup
75 32b8d9c0 Iustin Pop
    , findSplitInstances
76 f4161783 Iustin Pop
    , splitCluster
77 e4f08c46 Iustin Pop
    ) where
78 e4f08c46 Iustin Pop
79 949397c8 Iustin Pop
import Data.Function (on)
80 63a78055 Iustin Pop
import qualified Data.IntSet as IntSet
81 e4f08c46 Iustin Pop
import Data.List
82 db56cfc4 Iustin Pop
import Data.Maybe (fromJust)
83 5182e970 Iustin Pop
import Data.Ord (comparing)
84 e4f08c46 Iustin Pop
import Text.Printf (printf)
85 9d3fada5 Iustin Pop
import Control.Monad
86 a3eee4ad Iustin Pop
import Control.Parallel.Strategies
87 e4f08c46 Iustin Pop
88 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Container as Container
89 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
90 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Node as Node
91 aec636b9 Iustin Pop
import qualified Ganeti.HTools.Group as Group
92 e4c5beaf Iustin Pop
import Ganeti.HTools.Types
93 669d7e3d Iustin Pop
import Ganeti.HTools.Utils
94 6b20875c Iustin Pop
import qualified Ganeti.OpCodes as OpCodes
95 e4f08c46 Iustin Pop
96 9188aeef Iustin Pop
-- * Types
97 9188aeef Iustin Pop
98 0c936d24 Iustin Pop
-- | Allocation\/relocation solution.
99 85d0ddc3 Iustin Pop
data AllocSolution = AllocSolution
100 85d0ddc3 Iustin Pop
  { asFailures  :: [FailMode]          -- ^ Failure counts
101 85d0ddc3 Iustin Pop
  , asAllocs    :: Int                 -- ^ Good allocation count
102 85d0ddc3 Iustin Pop
  , asSolutions :: [Node.AllocElement] -- ^ The actual result, length
103 85d0ddc3 Iustin Pop
                                       -- of the list depends on the
104 85d0ddc3 Iustin Pop
                                       -- allocation/relocation mode
105 859fc11d Iustin Pop
  , asLog       :: [String]            -- ^ A list of informational messages
106 85d0ddc3 Iustin Pop
  }
107 85d0ddc3 Iustin Pop
108 47eed3f4 Iustin Pop
-- | Node evacuation/group change iallocator result type. This result
109 47eed3f4 Iustin Pop
-- type consists of actual opcodes (a restricted subset) that are
110 47eed3f4 Iustin Pop
-- transmitted back to Ganeti.
111 47eed3f4 Iustin Pop
data EvacSolution = EvacSolution
112 47eed3f4 Iustin Pop
    { esMoved   :: [String]             -- ^ Instance moved successfully
113 47eed3f4 Iustin Pop
    , esFailed  :: [String]             -- ^ Instance which were not
114 47eed3f4 Iustin Pop
                                        -- relocated
115 47eed3f4 Iustin Pop
    , esOpCodes :: [[[OpCodes.OpCode]]] -- ^ List of lists of jobs
116 47eed3f4 Iustin Pop
    }
117 47eed3f4 Iustin Pop
118 40ee14bc Iustin Pop
-- | Allocation results, as used in 'iterateAlloc' and 'tieredAlloc'.
119 40ee14bc Iustin Pop
type AllocResult = (FailStats, Node.List, Instance.List,
120 40ee14bc Iustin Pop
                    [Instance.Instance], [CStats])
121 40ee14bc Iustin Pop
122 6cb1649f Iustin Pop
-- | A type denoting the valid allocation mode/pairs.
123 525bfb36 Iustin Pop
--
124 6cb1649f Iustin Pop
-- For a one-node allocation, this will be a @Left ['Node.Node']@,
125 6cb1649f Iustin Pop
-- whereas for a two-node allocation, this will be a @Right
126 6cb1649f Iustin Pop
-- [('Node.Node', 'Node.Node')]@.
127 0d66ea67 Iustin Pop
type AllocNodes = Either [Ndx] [(Ndx, Ndx)]
128 6cb1649f Iustin Pop
129 525bfb36 Iustin Pop
-- | The empty solution we start with when computing allocations.
130 97936d51 Iustin Pop
emptyAllocSolution :: AllocSolution
131 97936d51 Iustin Pop
emptyAllocSolution = AllocSolution { asFailures = [], asAllocs = 0
132 97936d51 Iustin Pop
                                   , asSolutions = [], asLog = [] }
133 78694255 Iustin Pop
134 47eed3f4 Iustin Pop
-- | The empty evac solution.
135 47eed3f4 Iustin Pop
emptyEvacSolution :: EvacSolution
136 47eed3f4 Iustin Pop
emptyEvacSolution = EvacSolution { esMoved = []
137 47eed3f4 Iustin Pop
                                 , esFailed = []
138 47eed3f4 Iustin Pop
                                 , esOpCodes = []
139 47eed3f4 Iustin Pop
                                 }
140 47eed3f4 Iustin Pop
141 525bfb36 Iustin Pop
-- | The complete state for the balancing solution.
142 262a08a2 Iustin Pop
data Table = Table Node.List Instance.List Score [Placement]
143 6bc39970 Iustin Pop
             deriving (Show, Read)
144 e4f08c46 Iustin Pop
145 7034694d Iustin Pop
data CStats = CStats { csFmem :: Integer -- ^ Cluster free mem
146 7034694d Iustin Pop
                     , csFdsk :: Integer -- ^ Cluster free disk
147 7034694d Iustin Pop
                     , csAmem :: Integer -- ^ Cluster allocatable mem
148 7034694d Iustin Pop
                     , csAdsk :: Integer -- ^ Cluster allocatable disk
149 7034694d Iustin Pop
                     , csAcpu :: Integer -- ^ Cluster allocatable cpus
150 7034694d Iustin Pop
                     , csMmem :: Integer -- ^ Max node allocatable mem
151 7034694d Iustin Pop
                     , csMdsk :: Integer -- ^ Max node allocatable disk
152 7034694d Iustin Pop
                     , csMcpu :: Integer -- ^ Max node allocatable cpu
153 7034694d Iustin Pop
                     , csImem :: Integer -- ^ Instance used mem
154 7034694d Iustin Pop
                     , csIdsk :: Integer -- ^ Instance used disk
155 7034694d Iustin Pop
                     , csIcpu :: Integer -- ^ Instance used cpu
156 7034694d Iustin Pop
                     , csTmem :: Double  -- ^ Cluster total mem
157 7034694d Iustin Pop
                     , csTdsk :: Double  -- ^ Cluster total disk
158 7034694d Iustin Pop
                     , csTcpu :: Double  -- ^ Cluster total cpus
159 7034694d Iustin Pop
                     , csVcpu :: Integer -- ^ Cluster virtual cpus (if
160 7034694d Iustin Pop
                                         -- node pCpu has been set,
161 7034694d Iustin Pop
                                         -- otherwise -1)
162 7034694d Iustin Pop
                     , csXmem :: Integer -- ^ Unnacounted for mem
163 7034694d Iustin Pop
                     , csNmem :: Integer -- ^ Node own memory
164 7034694d Iustin Pop
                     , csScore :: Score  -- ^ The cluster score
165 7034694d Iustin Pop
                     , csNinst :: Int    -- ^ The total number of instances
166 1a7eff0e Iustin Pop
                     }
167 6bc39970 Iustin Pop
            deriving (Show, Read)
168 1a7eff0e Iustin Pop
169 525bfb36 Iustin Pop
-- | Currently used, possibly to allocate, unallocable.
170 9b8fac3d Iustin Pop
type AllocStats = (RSpec, RSpec, RSpec)
171 9b8fac3d Iustin Pop
172 9188aeef Iustin Pop
-- * Utility functions
173 9188aeef Iustin Pop
174 e4f08c46 Iustin Pop
-- | Verifies the N+1 status and return the affected nodes.
175 e4f08c46 Iustin Pop
verifyN1 :: [Node.Node] -> [Node.Node]
176 9f6dcdea Iustin Pop
verifyN1 = filter Node.failN1
177 e4f08c46 Iustin Pop
178 9188aeef Iustin Pop
{-| Computes the pair of bad nodes and instances.
179 9188aeef Iustin Pop
180 9188aeef Iustin Pop
The bad node list is computed via a simple 'verifyN1' check, and the
181 9188aeef Iustin Pop
bad instance list is the list of primary and secondary instances of
182 9188aeef Iustin Pop
those nodes.
183 9188aeef Iustin Pop
184 9188aeef Iustin Pop
-}
185 9188aeef Iustin Pop
computeBadItems :: Node.List -> Instance.List ->
186 9188aeef Iustin Pop
                   ([Node.Node], [Instance.Instance])
187 9188aeef Iustin Pop
computeBadItems nl il =
188 dbba5246 Iustin Pop
  let bad_nodes = verifyN1 $ getOnline nl
189 5182e970 Iustin Pop
      bad_instances = map (`Container.find` il) .
190 9f6dcdea Iustin Pop
                      sort . nub $
191 2060348b Iustin Pop
                      concatMap (\ n -> Node.sList n ++ Node.pList n) bad_nodes
192 9188aeef Iustin Pop
  in
193 9188aeef Iustin Pop
    (bad_nodes, bad_instances)
194 9188aeef Iustin Pop
195 525bfb36 Iustin Pop
-- | Zero-initializer for the CStats type.
196 1a7eff0e Iustin Pop
emptyCStats :: CStats
197 86ecce4a Iustin Pop
emptyCStats = CStats 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
198 1a7eff0e Iustin Pop
199 525bfb36 Iustin Pop
-- | Update stats with data from a new node.
200 1a7eff0e Iustin Pop
updateCStats :: CStats -> Node.Node -> CStats
201 1a7eff0e Iustin Pop
updateCStats cs node =
202 f5b553da Iustin Pop
    let CStats { csFmem = x_fmem, csFdsk = x_fdsk,
203 f5b553da Iustin Pop
                 csAmem = x_amem, csAcpu = x_acpu, csAdsk = x_adsk,
204 f5b553da Iustin Pop
                 csMmem = x_mmem, csMdsk = x_mdsk, csMcpu = x_mcpu,
205 f5b553da Iustin Pop
                 csImem = x_imem, csIdsk = x_idsk, csIcpu = x_icpu,
206 f5b553da Iustin Pop
                 csTmem = x_tmem, csTdsk = x_tdsk, csTcpu = x_tcpu,
207 86ecce4a Iustin Pop
                 csVcpu = x_vcpu,
208 f5b553da Iustin Pop
                 csXmem = x_xmem, csNmem = x_nmem, csNinst = x_ninst
209 8c4c6a8a Iustin Pop
               }
210 1a7eff0e Iustin Pop
            = cs
211 2060348b Iustin Pop
        inc_amem = Node.fMem node - Node.rMem node
212 1a7eff0e Iustin Pop
        inc_amem' = if inc_amem > 0 then inc_amem else 0
213 301789f4 Iustin Pop
        inc_adsk = Node.availDisk node
214 2060348b Iustin Pop
        inc_imem = truncate (Node.tMem node) - Node.nMem node
215 2060348b Iustin Pop
                   - Node.xMem node - Node.fMem node
216 2060348b Iustin Pop
        inc_icpu = Node.uCpu node
217 2060348b Iustin Pop
        inc_idsk = truncate (Node.tDsk node) - Node.fDsk node
218 86ecce4a Iustin Pop
        inc_vcpu = Node.hiCpu node
219 f52dadb2 Iustin Pop
        inc_acpu = Node.availCpu node
220 8c4c6a8a Iustin Pop
221 7034694d Iustin Pop
    in cs { csFmem = x_fmem + fromIntegral (Node.fMem node)
222 7034694d Iustin Pop
          , csFdsk = x_fdsk + fromIntegral (Node.fDsk node)
223 7034694d Iustin Pop
          , csAmem = x_amem + fromIntegral inc_amem'
224 7034694d Iustin Pop
          , csAdsk = x_adsk + fromIntegral inc_adsk
225 7034694d Iustin Pop
          , csAcpu = x_acpu + fromIntegral inc_acpu
226 7034694d Iustin Pop
          , csMmem = max x_mmem (fromIntegral inc_amem')
227 7034694d Iustin Pop
          , csMdsk = max x_mdsk (fromIntegral inc_adsk)
228 7034694d Iustin Pop
          , csMcpu = max x_mcpu (fromIntegral inc_acpu)
229 7034694d Iustin Pop
          , csImem = x_imem + fromIntegral inc_imem
230 7034694d Iustin Pop
          , csIdsk = x_idsk + fromIntegral inc_idsk
231 7034694d Iustin Pop
          , csIcpu = x_icpu + fromIntegral inc_icpu
232 f5b553da Iustin Pop
          , csTmem = x_tmem + Node.tMem node
233 f5b553da Iustin Pop
          , csTdsk = x_tdsk + Node.tDsk node
234 f5b553da Iustin Pop
          , csTcpu = x_tcpu + Node.tCpu node
235 7034694d Iustin Pop
          , csVcpu = x_vcpu + fromIntegral inc_vcpu
236 7034694d Iustin Pop
          , csXmem = x_xmem + fromIntegral (Node.xMem node)
237 7034694d Iustin Pop
          , csNmem = x_nmem + fromIntegral (Node.nMem node)
238 f5b553da Iustin Pop
          , csNinst = x_ninst + length (Node.pList node)
239 de4ac2c2 Iustin Pop
          }
240 1a7eff0e Iustin Pop
241 9188aeef Iustin Pop
-- | Compute the total free disk and memory in the cluster.
242 1a7eff0e Iustin Pop
totalResources :: Node.List -> CStats
243 de4ac2c2 Iustin Pop
totalResources nl =
244 de4ac2c2 Iustin Pop
    let cs = foldl' updateCStats emptyCStats . Container.elems $ nl
245 f5b553da Iustin Pop
    in cs { csScore = compCV nl }
246 9188aeef Iustin Pop
247 9b8fac3d Iustin Pop
-- | Compute the delta between two cluster state.
248 9b8fac3d Iustin Pop
--
249 9b8fac3d Iustin Pop
-- This is used when doing allocations, to understand better the
250 e2436511 Iustin Pop
-- available cluster resources. The return value is a triple of the
251 e2436511 Iustin Pop
-- current used values, the delta that was still allocated, and what
252 e2436511 Iustin Pop
-- was left unallocated.
253 9b8fac3d Iustin Pop
computeAllocationDelta :: CStats -> CStats -> AllocStats
254 9b8fac3d Iustin Pop
computeAllocationDelta cini cfin =
255 9b8fac3d Iustin Pop
    let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu} = cini
256 9b8fac3d Iustin Pop
        CStats {csImem = f_imem, csIdsk = f_idsk, csIcpu = f_icpu,
257 9b8fac3d Iustin Pop
                csTmem = t_mem, csTdsk = t_dsk, csVcpu = v_cpu } = cfin
258 7034694d Iustin Pop
        rini = RSpec (fromIntegral i_icpu) (fromIntegral i_imem)
259 7034694d Iustin Pop
               (fromIntegral i_idsk)
260 7034694d Iustin Pop
        rfin = RSpec (fromIntegral (f_icpu - i_icpu))
261 7034694d Iustin Pop
               (fromIntegral (f_imem - i_imem))
262 7034694d Iustin Pop
               (fromIntegral (f_idsk - i_idsk))
263 7034694d Iustin Pop
        un_cpu = fromIntegral (v_cpu - f_icpu)::Int
264 7034694d Iustin Pop
        runa = RSpec un_cpu (truncate t_mem - fromIntegral f_imem)
265 7034694d Iustin Pop
               (truncate t_dsk - fromIntegral f_idsk)
266 9b8fac3d Iustin Pop
    in (rini, rfin, runa)
267 9b8fac3d Iustin Pop
268 525bfb36 Iustin Pop
-- | The names and weights of the individual elements in the CV list.
269 8a3b30ca Iustin Pop
detailedCVInfo :: [(Double, String)]
270 8a3b30ca Iustin Pop
detailedCVInfo = [ (1,  "free_mem_cv")
271 8a3b30ca Iustin Pop
                 , (1,  "free_disk_cv")
272 8a3b30ca Iustin Pop
                 , (1,  "n1_cnt")
273 8a3b30ca Iustin Pop
                 , (1,  "reserved_mem_cv")
274 8a3b30ca Iustin Pop
                 , (4,  "offline_all_cnt")
275 8a3b30ca Iustin Pop
                 , (16, "offline_pri_cnt")
276 8a3b30ca Iustin Pop
                 , (1,  "vcpu_ratio_cv")
277 8a3b30ca Iustin Pop
                 , (1,  "cpu_load_cv")
278 8a3b30ca Iustin Pop
                 , (1,  "mem_load_cv")
279 8a3b30ca Iustin Pop
                 , (1,  "disk_load_cv")
280 8a3b30ca Iustin Pop
                 , (1,  "net_load_cv")
281 306cccd5 Iustin Pop
                 , (2,  "pri_tags_score")
282 8a3b30ca Iustin Pop
                 ]
283 8a3b30ca Iustin Pop
284 8a3b30ca Iustin Pop
detailedCVWeights :: [Double]
285 8a3b30ca Iustin Pop
detailedCVWeights = map fst detailedCVInfo
286 fca250e9 Iustin Pop
287 9188aeef Iustin Pop
-- | Compute the mem and disk covariance.
288 9bb5721c Iustin Pop
compDetailedCV :: [Node.Node] -> [Double]
289 9bb5721c Iustin Pop
compDetailedCV all_nodes =
290 9188aeef Iustin Pop
    let
291 9188aeef Iustin Pop
        (offline, nodes) = partition Node.offline all_nodes
292 2060348b Iustin Pop
        mem_l = map Node.pMem nodes
293 2060348b Iustin Pop
        dsk_l = map Node.pDsk nodes
294 daee4bed Iustin Pop
        -- metric: memory covariance
295 4715711d Iustin Pop
        mem_cv = stdDev mem_l
296 daee4bed Iustin Pop
        -- metric: disk covariance
297 4715711d Iustin Pop
        dsk_cv = stdDev dsk_l
298 c3c7a0c1 Iustin Pop
        -- metric: count of instances living on N1 failing nodes
299 c3c7a0c1 Iustin Pop
        n1_score = fromIntegral . sum . map (\n -> length (Node.sList n) +
300 c3c7a0c1 Iustin Pop
                                                   length (Node.pList n)) .
301 c3c7a0c1 Iustin Pop
                   filter Node.failN1 $ nodes :: Double
302 2060348b Iustin Pop
        res_l = map Node.pRem nodes
303 daee4bed Iustin Pop
        -- metric: reserved memory covariance
304 4715711d Iustin Pop
        res_cv = stdDev res_l
305 e4d31268 Iustin Pop
        -- offline instances metrics
306 e4d31268 Iustin Pop
        offline_ipri = sum . map (length . Node.pList) $ offline
307 e4d31268 Iustin Pop
        offline_isec = sum . map (length . Node.sList) $ offline
308 e4d31268 Iustin Pop
        -- metric: count of instances on offline nodes
309 e4d31268 Iustin Pop
        off_score = fromIntegral (offline_ipri + offline_isec)::Double
310 673f0f00 Iustin Pop
        -- metric: count of primary instances on offline nodes (this
311 673f0f00 Iustin Pop
        -- helps with evacuation/failover of primary instances on
312 673f0f00 Iustin Pop
        -- 2-node clusters with one node offline)
313 673f0f00 Iustin Pop
        off_pri_score = fromIntegral offline_ipri::Double
314 2060348b Iustin Pop
        cpu_l = map Node.pCpu nodes
315 daee4bed Iustin Pop
        -- metric: covariance of vcpu/pcpu ratio
316 4715711d Iustin Pop
        cpu_cv = stdDev cpu_l
317 daee4bed Iustin Pop
        -- metrics: covariance of cpu, memory, disk and network load
318 ee9724b9 Iustin Pop
        (c_load, m_load, d_load, n_load) = unzip4 $
319 ee9724b9 Iustin Pop
            map (\n ->
320 ee9724b9 Iustin Pop
                     let DynUtil c1 m1 d1 n1 = Node.utilLoad n
321 ee9724b9 Iustin Pop
                         DynUtil c2 m2 d2 n2 = Node.utilPool n
322 ee9724b9 Iustin Pop
                     in (c1/c2, m1/m2, d1/d2, n1/n2)
323 ee9724b9 Iustin Pop
                ) nodes
324 d844fe88 Iustin Pop
        -- metric: conflicting instance count
325 d844fe88 Iustin Pop
        pri_tags_inst = sum $ map Node.conflictingPrimaries nodes
326 d844fe88 Iustin Pop
        pri_tags_score = fromIntegral pri_tags_inst::Double
327 673f0f00 Iustin Pop
    in [ mem_cv, dsk_cv, n1_score, res_cv, off_score, off_pri_score, cpu_cv
328 4715711d Iustin Pop
       , stdDev c_load, stdDev m_load , stdDev d_load, stdDev n_load
329 d844fe88 Iustin Pop
       , pri_tags_score ]
330 9188aeef Iustin Pop
331 9188aeef Iustin Pop
-- | Compute the /total/ variance.
332 9bb5721c Iustin Pop
compCVNodes :: [Node.Node] -> Double
333 9bb5721c Iustin Pop
compCVNodes = sum . zipWith (*) detailedCVWeights . compDetailedCV
334 9bb5721c Iustin Pop
335 9bb5721c Iustin Pop
-- | Wrapper over 'compCVNodes' for callers that have a 'Node.List'.
336 9188aeef Iustin Pop
compCV :: Node.List -> Double
337 9bb5721c Iustin Pop
compCV = compCVNodes . Container.elems
338 9bb5721c Iustin Pop
339 9188aeef Iustin Pop
340 525bfb36 Iustin Pop
-- | Compute online nodes from a 'Node.List'.
341 dbba5246 Iustin Pop
getOnline :: Node.List -> [Node.Node]
342 dbba5246 Iustin Pop
getOnline = filter (not . Node.offline) . Container.elems
343 dbba5246 Iustin Pop
344 525bfb36 Iustin Pop
-- * Balancing functions
345 9188aeef Iustin Pop
346 9188aeef Iustin Pop
-- | Compute best table. Note that the ordering of the arguments is important.
347 9188aeef Iustin Pop
compareTables :: Table -> Table -> Table
348 9188aeef Iustin Pop
compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
349 9188aeef Iustin Pop
    if a_cv > b_cv then b else a
350 9188aeef Iustin Pop
351 9188aeef Iustin Pop
-- | Applies an instance move to a given node list and instance.
352 262a08a2 Iustin Pop
applyMove :: Node.List -> Instance.Instance
353 8880d889 Iustin Pop
          -> IMove -> OpResult (Node.List, Instance.Instance, Ndx, Ndx)
354 00b51a14 Iustin Pop
-- Failover (f)
355 e4f08c46 Iustin Pop
applyMove nl inst Failover =
356 2060348b Iustin Pop
    let old_pdx = Instance.pNode inst
357 2060348b Iustin Pop
        old_sdx = Instance.sNode inst
358 e4f08c46 Iustin Pop
        old_p = Container.find old_pdx nl
359 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
360 e4f08c46 Iustin Pop
        int_p = Node.removePri old_p inst
361 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
362 2cae47e9 Iustin Pop
        force_p = Node.offline old_p
363 b161386d Iustin Pop
        new_nl = do -- Maybe monad
364 2cae47e9 Iustin Pop
          new_p <- Node.addPriEx force_p int_s inst
365 b161386d Iustin Pop
          new_s <- Node.addSec int_p inst old_sdx
366 8880d889 Iustin Pop
          let new_inst = Instance.setBoth inst old_sdx old_pdx
367 8880d889 Iustin Pop
          return (Container.addTwo old_pdx new_s old_sdx new_p nl,
368 8880d889 Iustin Pop
                  new_inst, old_sdx, old_pdx)
369 8880d889 Iustin Pop
    in new_nl
370 e4f08c46 Iustin Pop
371 00b51a14 Iustin Pop
-- Replace the primary (f:, r:np, f)
372 e4f08c46 Iustin Pop
applyMove nl inst (ReplacePrimary new_pdx) =
373 2060348b Iustin Pop
    let old_pdx = Instance.pNode inst
374 2060348b Iustin Pop
        old_sdx = Instance.sNode inst
375 e4f08c46 Iustin Pop
        old_p = Container.find old_pdx nl
376 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
377 e4f08c46 Iustin Pop
        tgt_n = Container.find new_pdx nl
378 e4f08c46 Iustin Pop
        int_p = Node.removePri old_p inst
379 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
380 2cae47e9 Iustin Pop
        force_p = Node.offline old_p
381 b161386d Iustin Pop
        new_nl = do -- Maybe monad
382 70db354e Iustin Pop
          -- check that the current secondary can host the instance
383 70db354e Iustin Pop
          -- during the migration
384 2cae47e9 Iustin Pop
          tmp_s <- Node.addPriEx force_p int_s inst
385 70db354e Iustin Pop
          let tmp_s' = Node.removePri tmp_s inst
386 2cae47e9 Iustin Pop
          new_p <- Node.addPriEx force_p tgt_n inst
387 2cae47e9 Iustin Pop
          new_s <- Node.addSecEx force_p tmp_s' inst new_pdx
388 8880d889 Iustin Pop
          let new_inst = Instance.setPri inst new_pdx
389 8880d889 Iustin Pop
          return (Container.add new_pdx new_p $
390 8880d889 Iustin Pop
                  Container.addTwo old_pdx int_p old_sdx new_s nl,
391 8880d889 Iustin Pop
                  new_inst, new_pdx, old_sdx)
392 8880d889 Iustin Pop
    in new_nl
393 e4f08c46 Iustin Pop
394 00b51a14 Iustin Pop
-- Replace the secondary (r:ns)
395 e4f08c46 Iustin Pop
applyMove nl inst (ReplaceSecondary new_sdx) =
396 2060348b Iustin Pop
    let old_pdx = Instance.pNode inst
397 2060348b Iustin Pop
        old_sdx = Instance.sNode inst
398 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
399 e4f08c46 Iustin Pop
        tgt_n = Container.find new_sdx nl
400 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
401 2cae47e9 Iustin Pop
        force_s = Node.offline old_s
402 8880d889 Iustin Pop
        new_inst = Instance.setSec inst new_sdx
403 2cae47e9 Iustin Pop
        new_nl = Node.addSecEx force_s tgt_n inst old_pdx >>=
404 8880d889 Iustin Pop
                 \new_s -> return (Container.addTwo new_sdx
405 8880d889 Iustin Pop
                                   new_s old_sdx int_s nl,
406 8880d889 Iustin Pop
                                   new_inst, old_pdx, new_sdx)
407 8880d889 Iustin Pop
    in new_nl
408 e4f08c46 Iustin Pop
409 00b51a14 Iustin Pop
-- Replace the secondary and failover (r:np, f)
410 79ac6b6f Iustin Pop
applyMove nl inst (ReplaceAndFailover new_pdx) =
411 2060348b Iustin Pop
    let old_pdx = Instance.pNode inst
412 2060348b Iustin Pop
        old_sdx = Instance.sNode inst
413 79ac6b6f Iustin Pop
        old_p = Container.find old_pdx nl
414 79ac6b6f Iustin Pop
        old_s = Container.find old_sdx nl
415 79ac6b6f Iustin Pop
        tgt_n = Container.find new_pdx nl
416 79ac6b6f Iustin Pop
        int_p = Node.removePri old_p inst
417 79ac6b6f Iustin Pop
        int_s = Node.removeSec old_s inst
418 2cae47e9 Iustin Pop
        force_s = Node.offline old_s
419 b161386d Iustin Pop
        new_nl = do -- Maybe monad
420 b161386d Iustin Pop
          new_p <- Node.addPri tgt_n inst
421 2cae47e9 Iustin Pop
          new_s <- Node.addSecEx force_s int_p inst new_pdx
422 8880d889 Iustin Pop
          let new_inst = Instance.setBoth inst new_pdx old_pdx
423 8880d889 Iustin Pop
          return (Container.add new_pdx new_p $
424 8880d889 Iustin Pop
                  Container.addTwo old_pdx new_s old_sdx int_s nl,
425 8880d889 Iustin Pop
                  new_inst, new_pdx, old_pdx)
426 8880d889 Iustin Pop
    in new_nl
427 79ac6b6f Iustin Pop
428 19493d33 Iustin Pop
-- Failver and replace the secondary (f, r:ns)
429 19493d33 Iustin Pop
applyMove nl inst (FailoverAndReplace new_sdx) =
430 2060348b Iustin Pop
    let old_pdx = Instance.pNode inst
431 2060348b Iustin Pop
        old_sdx = Instance.sNode inst
432 19493d33 Iustin Pop
        old_p = Container.find old_pdx nl
433 19493d33 Iustin Pop
        old_s = Container.find old_sdx nl
434 19493d33 Iustin Pop
        tgt_n = Container.find new_sdx nl
435 19493d33 Iustin Pop
        int_p = Node.removePri old_p inst
436 19493d33 Iustin Pop
        int_s = Node.removeSec old_s inst
437 2cae47e9 Iustin Pop
        force_p = Node.offline old_p
438 b161386d Iustin Pop
        new_nl = do -- Maybe monad
439 2cae47e9 Iustin Pop
          new_p <- Node.addPriEx force_p int_s inst
440 2cae47e9 Iustin Pop
          new_s <- Node.addSecEx force_p tgt_n inst old_sdx
441 8880d889 Iustin Pop
          let new_inst = Instance.setBoth inst old_sdx new_sdx
442 8880d889 Iustin Pop
          return (Container.add new_sdx new_s $
443 8880d889 Iustin Pop
                  Container.addTwo old_sdx new_p old_pdx int_p nl,
444 8880d889 Iustin Pop
                  new_inst, old_sdx, new_sdx)
445 8880d889 Iustin Pop
    in new_nl
446 19493d33 Iustin Pop
447 9188aeef Iustin Pop
-- | Tries to allocate an instance on one given node.
448 0d66ea67 Iustin Pop
allocateOnSingle :: Node.List -> Instance.Instance -> Ndx
449 1fe81531 Iustin Pop
                 -> OpResult Node.AllocElement
450 0d66ea67 Iustin Pop
allocateOnSingle nl inst new_pdx =
451 0d66ea67 Iustin Pop
    let p = Container.find new_pdx nl
452 8880d889 Iustin Pop
        new_inst = Instance.setBoth inst new_pdx Node.noSecondary
453 7d3f4253 Iustin Pop
    in  Node.addPri p inst >>= \new_p -> do
454 7d3f4253 Iustin Pop
      let new_nl = Container.add new_pdx new_p nl
455 7d3f4253 Iustin Pop
          new_score = compCV nl
456 7d3f4253 Iustin Pop
      return (new_nl, new_inst, [new_p], new_score)
457 5e15f460 Iustin Pop
458 9188aeef Iustin Pop
-- | Tries to allocate an instance on a given pair of nodes.
459 0d66ea67 Iustin Pop
allocateOnPair :: Node.List -> Instance.Instance -> Ndx -> Ndx
460 1fe81531 Iustin Pop
               -> OpResult Node.AllocElement
461 0d66ea67 Iustin Pop
allocateOnPair nl inst new_pdx new_sdx =
462 0d66ea67 Iustin Pop
    let tgt_p = Container.find new_pdx nl
463 0d66ea67 Iustin Pop
        tgt_s = Container.find new_sdx nl
464 7d3f4253 Iustin Pop
    in do
465 7d3f4253 Iustin Pop
      new_p <- Node.addPri tgt_p inst
466 7d3f4253 Iustin Pop
      new_s <- Node.addSec tgt_s inst new_pdx
467 7d3f4253 Iustin Pop
      let new_inst = Instance.setBoth inst new_pdx new_sdx
468 7d3f4253 Iustin Pop
          new_nl = Container.addTwo new_pdx new_p new_sdx new_s nl
469 7d3f4253 Iustin Pop
      return (new_nl, new_inst, [new_p, new_s], compCV new_nl)
470 4a340313 Iustin Pop
471 9188aeef Iustin Pop
-- | Tries to perform an instance move and returns the best table
472 9188aeef Iustin Pop
-- between the original one and the new one.
473 e4f08c46 Iustin Pop
checkSingleStep :: Table -- ^ The original table
474 e4f08c46 Iustin Pop
                -> Instance.Instance -- ^ The instance to move
475 e4f08c46 Iustin Pop
                -> Table -- ^ The current best table
476 e4f08c46 Iustin Pop
                -> IMove -- ^ The move to apply
477 e4f08c46 Iustin Pop
                -> Table -- ^ The final best table
478 e4f08c46 Iustin Pop
checkSingleStep ini_tbl target cur_tbl move =
479 e4f08c46 Iustin Pop
    let
480 e4f08c46 Iustin Pop
        Table ini_nl ini_il _ ini_plc = ini_tbl
481 8880d889 Iustin Pop
        tmp_resu = applyMove ini_nl target move
482 e4f08c46 Iustin Pop
    in
483 8880d889 Iustin Pop
      case tmp_resu of
484 f2280553 Iustin Pop
        OpFail _ -> cur_tbl
485 3173c987 Iustin Pop
        OpGood (upd_nl, new_inst, pri_idx, sec_idx) ->
486 f2280553 Iustin Pop
            let tgt_idx = Instance.idx target
487 f2280553 Iustin Pop
                upd_cvar = compCV upd_nl
488 f2280553 Iustin Pop
                upd_il = Container.add tgt_idx new_inst ini_il
489 3173c987 Iustin Pop
                upd_plc = (tgt_idx, pri_idx, sec_idx, move, upd_cvar):ini_plc
490 f2280553 Iustin Pop
                upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
491 f2280553 Iustin Pop
            in
492 f2280553 Iustin Pop
              compareTables cur_tbl upd_tbl
493 e4f08c46 Iustin Pop
494 c0501c69 Iustin Pop
-- | Given the status of the current secondary as a valid new node and
495 c0501c69 Iustin Pop
-- the current candidate target node, generate the possible moves for
496 c0501c69 Iustin Pop
-- a instance.
497 c0501c69 Iustin Pop
possibleMoves :: Bool      -- ^ Whether the secondary node is a valid new node
498 e08424a8 Guido Trotter
              -> Bool      -- ^ Whether we can change the primary node
499 c0501c69 Iustin Pop
              -> Ndx       -- ^ Target node candidate
500 c0501c69 Iustin Pop
              -> [IMove]   -- ^ List of valid result moves
501 e08424a8 Guido Trotter
502 e08424a8 Guido Trotter
possibleMoves _ False tdx =
503 e08424a8 Guido Trotter
    [ReplaceSecondary tdx]
504 e08424a8 Guido Trotter
505 e08424a8 Guido Trotter
possibleMoves True True tdx =
506 40d4eba0 Iustin Pop
    [ReplaceSecondary tdx,
507 40d4eba0 Iustin Pop
     ReplaceAndFailover tdx,
508 40d4eba0 Iustin Pop
     ReplacePrimary tdx,
509 40d4eba0 Iustin Pop
     FailoverAndReplace tdx]
510 40d4eba0 Iustin Pop
511 e08424a8 Guido Trotter
possibleMoves False True tdx =
512 40d4eba0 Iustin Pop
    [ReplaceSecondary tdx,
513 40d4eba0 Iustin Pop
     ReplaceAndFailover tdx]
514 40d4eba0 Iustin Pop
515 40d4eba0 Iustin Pop
-- | Compute the best move for a given instance.
516 c0501c69 Iustin Pop
checkInstanceMove :: [Ndx]             -- ^ Allowed target node indices
517 c0501c69 Iustin Pop
                  -> Bool              -- ^ Whether disk moves are allowed
518 e08424a8 Guido Trotter
                  -> Bool              -- ^ Whether instance moves are allowed
519 c0501c69 Iustin Pop
                  -> Table             -- ^ Original table
520 c0501c69 Iustin Pop
                  -> Instance.Instance -- ^ Instance to move
521 c0501c69 Iustin Pop
                  -> Table             -- ^ Best new table for this instance
522 e08424a8 Guido Trotter
checkInstanceMove nodes_idx disk_moves inst_moves ini_tbl target =
523 4e25d1c2 Iustin Pop
    let
524 2060348b Iustin Pop
        opdx = Instance.pNode target
525 2060348b Iustin Pop
        osdx = Instance.sNode target
526 9dc6023f Iustin Pop
        nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
527 e08424a8 Guido Trotter
        use_secondary = elem osdx nodes_idx && inst_moves
528 40d4eba0 Iustin Pop
        aft_failover = if use_secondary -- if allowed to failover
529 40d4eba0 Iustin Pop
                       then checkSingleStep ini_tbl target ini_tbl Failover
530 40d4eba0 Iustin Pop
                       else ini_tbl
531 c0501c69 Iustin Pop
        all_moves = if disk_moves
532 e08424a8 Guido Trotter
                    then concatMap
533 e08424a8 Guido Trotter
                         (possibleMoves use_secondary inst_moves) nodes
534 c0501c69 Iustin Pop
                    else []
535 4e25d1c2 Iustin Pop
    in
536 4e25d1c2 Iustin Pop
      -- iterate over the possible nodes for this instance
537 9dc6023f Iustin Pop
      foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
538 4e25d1c2 Iustin Pop
539 e4f08c46 Iustin Pop
-- | Compute the best next move.
540 608efcce Iustin Pop
checkMove :: [Ndx]               -- ^ Allowed target node indices
541 c0501c69 Iustin Pop
          -> Bool                -- ^ Whether disk moves are allowed
542 e08424a8 Guido Trotter
          -> Bool                -- ^ Whether instance moves are allowed
543 256810de Iustin Pop
          -> Table               -- ^ The current solution
544 e4f08c46 Iustin Pop
          -> [Instance.Instance] -- ^ List of instances still to move
545 256810de Iustin Pop
          -> Table               -- ^ The new solution
546 e08424a8 Guido Trotter
checkMove nodes_idx disk_moves inst_moves ini_tbl victims =
547 4e25d1c2 Iustin Pop
    let Table _ _ _ ini_plc = ini_tbl
548 a3eee4ad Iustin Pop
        -- we're using rwhnf from the Control.Parallel.Strategies
549 a3eee4ad Iustin Pop
        -- package; we don't need to use rnf as that would force too
550 a3eee4ad Iustin Pop
        -- much evaluation in single-threaded cases, and in
551 a3eee4ad Iustin Pop
        -- multi-threaded case the weak head normal form is enough to
552 a3eee4ad Iustin Pop
        -- spark the evaluation
553 e08424a8 Guido Trotter
        tables = parMap rwhnf (checkInstanceMove nodes_idx disk_moves
554 e08424a8 Guido Trotter
                               inst_moves ini_tbl)
555 a3eee4ad Iustin Pop
                 victims
556 4e25d1c2 Iustin Pop
        -- iterate over all instances, computing the best move
557 2a8e2dc9 Iustin Pop
        best_tbl = foldl' compareTables ini_tbl tables
558 aaaa0e43 Iustin Pop
        Table _ _ _ best_plc = best_tbl
559 a804261a Iustin Pop
    in if length best_plc == length ini_plc
560 a804261a Iustin Pop
       then ini_tbl -- no advancement
561 a804261a Iustin Pop
       else best_tbl
562 e4f08c46 Iustin Pop
563 525bfb36 Iustin Pop
-- | Check if we are allowed to go deeper in the balancing.
564 3fea6959 Iustin Pop
doNextBalance :: Table     -- ^ The starting table
565 3fea6959 Iustin Pop
              -> Int       -- ^ Remaining length
566 3fea6959 Iustin Pop
              -> Score     -- ^ Score at which to stop
567 3fea6959 Iustin Pop
              -> Bool      -- ^ The resulting table and commands
568 5ad86777 Iustin Pop
doNextBalance ini_tbl max_rounds min_score =
569 5ad86777 Iustin Pop
    let Table _ _ ini_cv ini_plc = ini_tbl
570 5ad86777 Iustin Pop
        ini_plc_len = length ini_plc
571 5ad86777 Iustin Pop
    in (max_rounds < 0 || ini_plc_len < max_rounds) && ini_cv > min_score
572 5ad86777 Iustin Pop
573 525bfb36 Iustin Pop
-- | Run a balance move.
574 f25e5aac Iustin Pop
tryBalance :: Table       -- ^ The starting table
575 f25e5aac Iustin Pop
           -> Bool        -- ^ Allow disk moves
576 e08424a8 Guido Trotter
           -> Bool        -- ^ Allow instance moves
577 2e28ac32 Iustin Pop
           -> Bool        -- ^ Only evacuate moves
578 848b65c9 Iustin Pop
           -> Score       -- ^ Min gain threshold
579 848b65c9 Iustin Pop
           -> Score       -- ^ Min gain
580 f25e5aac Iustin Pop
           -> Maybe Table -- ^ The resulting table and commands
581 e08424a8 Guido Trotter
tryBalance ini_tbl disk_moves inst_moves evac_mode mg_limit min_gain =
582 5ad86777 Iustin Pop
    let Table ini_nl ini_il ini_cv _ = ini_tbl
583 5ad86777 Iustin Pop
        all_inst = Container.elems ini_il
584 2e28ac32 Iustin Pop
        all_inst' = if evac_mode
585 2e28ac32 Iustin Pop
                    then let bad_nodes = map Node.idx . filter Node.offline $
586 2e28ac32 Iustin Pop
                                         Container.elems ini_nl
587 2e28ac32 Iustin Pop
                         in filter (\e -> Instance.sNode e `elem` bad_nodes ||
588 2e28ac32 Iustin Pop
                                          Instance.pNode e `elem` bad_nodes)
589 2e28ac32 Iustin Pop
                            all_inst
590 2e28ac32 Iustin Pop
                    else all_inst
591 c424cdc8 Iustin Pop
        reloc_inst = filter Instance.movable all_inst'
592 5ad86777 Iustin Pop
        node_idx = map Node.idx . filter (not . Node.offline) $
593 5ad86777 Iustin Pop
                   Container.elems ini_nl
594 e08424a8 Guido Trotter
        fin_tbl = checkMove node_idx disk_moves inst_moves ini_tbl reloc_inst
595 5ad86777 Iustin Pop
        (Table _ _ fin_cv _) = fin_tbl
596 f25e5aac Iustin Pop
    in
597 848b65c9 Iustin Pop
      if fin_cv < ini_cv && (ini_cv > mg_limit || ini_cv - fin_cv >= min_gain)
598 5ad86777 Iustin Pop
      then Just fin_tbl -- this round made success, return the new table
599 f25e5aac Iustin Pop
      else Nothing
600 f25e5aac Iustin Pop
601 478df686 Iustin Pop
-- * Allocation functions
602 478df686 Iustin Pop
603 525bfb36 Iustin Pop
-- | Build failure stats out of a list of failures.
604 478df686 Iustin Pop
collapseFailures :: [FailMode] -> FailStats
605 478df686 Iustin Pop
collapseFailures flst =
606 b4bae394 Iustin Pop
    map (\k -> (k, foldl' (\a e -> if e == k then a + 1 else a) 0 flst))
607 b4bae394 Iustin Pop
            [minBound..maxBound]
608 478df686 Iustin Pop
609 478df686 Iustin Pop
-- | Update current Allocation solution and failure stats with new
610 525bfb36 Iustin Pop
-- elements.
611 1fe81531 Iustin Pop
concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution
612 85d0ddc3 Iustin Pop
concatAllocs as (OpFail reason) = as { asFailures = reason : asFailures as }
613 478df686 Iustin Pop
614 85d0ddc3 Iustin Pop
concatAllocs as (OpGood ns@(_, _, _, nscore)) =
615 7d3f4253 Iustin Pop
    let -- Choose the old or new solution, based on the cluster score
616 85d0ddc3 Iustin Pop
        cntok = asAllocs as
617 85d0ddc3 Iustin Pop
        osols = asSolutions as
618 478df686 Iustin Pop
        nsols = case osols of
619 a334d536 Iustin Pop
                  [] -> [ns]
620 a334d536 Iustin Pop
                  (_, _, _, oscore):[] ->
621 478df686 Iustin Pop
                      if oscore < nscore
622 478df686 Iustin Pop
                      then osols
623 a334d536 Iustin Pop
                      else [ns]
624 23f9ab76 Iustin Pop
                  -- FIXME: here we simply concat to lists with more
625 23f9ab76 Iustin Pop
                  -- than one element; we should instead abort, since
626 23f9ab76 Iustin Pop
                  -- this is not a valid usage of this function
627 a334d536 Iustin Pop
                  xs -> ns:xs
628 fbb95f28 Iustin Pop
        nsuc = cntok + 1
629 478df686 Iustin Pop
    -- Note: we force evaluation of nsols here in order to keep the
630 478df686 Iustin Pop
    -- memory profile low - we know that we will need nsols for sure
631 478df686 Iustin Pop
    -- in the next cycle, so we force evaluation of nsols, since the
632 478df686 Iustin Pop
    -- foldl' in the caller will only evaluate the tuple, but not the
633 7d11799b Iustin Pop
    -- elements of the tuple
634 85d0ddc3 Iustin Pop
    in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolutions = nsols }
635 dbba5246 Iustin Pop
636 1bc47d38 Iustin Pop
-- | Sums two allocation solutions (e.g. for two separate node groups).
637 1bc47d38 Iustin Pop
sumAllocs :: AllocSolution -> AllocSolution -> AllocSolution
638 1bc47d38 Iustin Pop
sumAllocs (AllocSolution af aa as al) (AllocSolution bf ba bs bl) =
639 1bc47d38 Iustin Pop
    AllocSolution (af ++ bf) (aa + ba) (as ++ bs) (al ++ bl)
640 1bc47d38 Iustin Pop
641 525bfb36 Iustin Pop
-- | Given a solution, generates a reasonable description for it.
642 859fc11d Iustin Pop
describeSolution :: AllocSolution -> String
643 859fc11d Iustin Pop
describeSolution as =
644 859fc11d Iustin Pop
  let fcnt = asFailures as
645 859fc11d Iustin Pop
      sols = asSolutions as
646 859fc11d Iustin Pop
      freasons =
647 859fc11d Iustin Pop
        intercalate ", " . map (\(a, b) -> printf "%s: %d" (show a) b) .
648 859fc11d Iustin Pop
        filter ((> 0) . snd) . collapseFailures $ fcnt
649 859fc11d Iustin Pop
  in if null sols
650 859fc11d Iustin Pop
     then "No valid allocation solutions, failure reasons: " ++
651 859fc11d Iustin Pop
          (if null fcnt
652 859fc11d Iustin Pop
           then "unknown reasons"
653 859fc11d Iustin Pop
           else freasons)
654 859fc11d Iustin Pop
     else let (_, _, nodes, cv) = head sols
655 859fc11d Iustin Pop
          in printf ("score: %.8f, successes %d, failures %d (%s)" ++
656 859fc11d Iustin Pop
                     " for node(s) %s") cv (asAllocs as) (length fcnt) freasons
657 859fc11d Iustin Pop
             (intercalate "/" . map Node.name $ nodes)
658 859fc11d Iustin Pop
659 525bfb36 Iustin Pop
-- | Annotates a solution with the appropriate string.
660 859fc11d Iustin Pop
annotateSolution :: AllocSolution -> AllocSolution
661 859fc11d Iustin Pop
annotateSolution as = as { asLog = describeSolution as : asLog as }
662 859fc11d Iustin Pop
663 47eed3f4 Iustin Pop
-- | Reverses an evacuation solution.
664 47eed3f4 Iustin Pop
--
665 47eed3f4 Iustin Pop
-- Rationale: we always concat the results to the top of the lists, so
666 47eed3f4 Iustin Pop
-- for proper jobset execution, we should reverse all lists.
667 47eed3f4 Iustin Pop
reverseEvacSolution :: EvacSolution -> EvacSolution
668 47eed3f4 Iustin Pop
reverseEvacSolution (EvacSolution f m o) =
669 47eed3f4 Iustin Pop
    EvacSolution (reverse f) (reverse m) (reverse o)
670 47eed3f4 Iustin Pop
671 6cb1649f Iustin Pop
-- | Generate the valid node allocation singles or pairs for a new instance.
672 6d0bc5ca Iustin Pop
genAllocNodes :: Group.List        -- ^ Group list
673 6d0bc5ca Iustin Pop
              -> Node.List         -- ^ The node map
674 6cb1649f Iustin Pop
              -> Int               -- ^ The number of nodes required
675 6d0bc5ca Iustin Pop
              -> Bool              -- ^ Whether to drop or not
676 6d0bc5ca Iustin Pop
                                   -- unallocable nodes
677 6cb1649f Iustin Pop
              -> Result AllocNodes -- ^ The (monadic) result
678 6d0bc5ca Iustin Pop
genAllocNodes gl nl count drop_unalloc =
679 6d0bc5ca Iustin Pop
    let filter_fn = if drop_unalloc
680 e4491427 Iustin Pop
                    then filter (Group.isAllocable .
681 e4491427 Iustin Pop
                                 flip Container.find gl . Node.group)
682 6d0bc5ca Iustin Pop
                    else id
683 6d0bc5ca Iustin Pop
        all_nodes = filter_fn $ getOnline nl
684 6cb1649f Iustin Pop
        all_pairs = liftM2 (,) all_nodes all_nodes
685 6cb1649f Iustin Pop
        ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y &&
686 6cb1649f Iustin Pop
                                      Node.group x == Node.group y) all_pairs
687 6cb1649f Iustin Pop
    in case count of
688 0d66ea67 Iustin Pop
         1 -> Ok (Left (map Node.idx all_nodes))
689 0d66ea67 Iustin Pop
         2 -> Ok (Right (map (\(p, s) -> (Node.idx p, Node.idx s)) ok_pairs))
690 6cb1649f Iustin Pop
         _ -> Bad "Unsupported number of nodes, only one or two  supported"
691 6cb1649f Iustin Pop
692 dbba5246 Iustin Pop
-- | Try to allocate an instance on the cluster.
693 dbba5246 Iustin Pop
tryAlloc :: (Monad m) =>
694 dbba5246 Iustin Pop
            Node.List         -- ^ The node list
695 dbba5246 Iustin Pop
         -> Instance.List     -- ^ The instance list
696 dbba5246 Iustin Pop
         -> Instance.Instance -- ^ The instance to allocate
697 6cb1649f Iustin Pop
         -> AllocNodes        -- ^ The allocation targets
698 78694255 Iustin Pop
         -> m AllocSolution   -- ^ Possible solution list
699 6cb1649f Iustin Pop
tryAlloc nl _ inst (Right ok_pairs) =
700 6cb1649f Iustin Pop
    let sols = foldl' (\cstate (p, s) ->
701 478df686 Iustin Pop
                           concatAllocs cstate $ allocateOnPair nl inst p s
702 97936d51 Iustin Pop
                      ) emptyAllocSolution ok_pairs
703 859fc11d Iustin Pop
704 dec88196 Iustin Pop
    in if null ok_pairs -- means we have just one node
705 dec88196 Iustin Pop
       then fail "Not enough online nodes"
706 dec88196 Iustin Pop
       else return $ annotateSolution sols
707 dbba5246 Iustin Pop
708 6cb1649f Iustin Pop
tryAlloc nl _ inst (Left all_nodes) =
709 6cb1649f Iustin Pop
    let sols = foldl' (\cstate ->
710 2485487d Iustin Pop
                           concatAllocs cstate . allocateOnSingle nl inst
711 97936d51 Iustin Pop
                      ) emptyAllocSolution all_nodes
712 dec88196 Iustin Pop
    in if null all_nodes
713 dec88196 Iustin Pop
       then fail "No online nodes"
714 dec88196 Iustin Pop
       else return $ annotateSolution sols
715 dbba5246 Iustin Pop
716 525bfb36 Iustin Pop
-- | Given a group/result, describe it as a nice (list of) messages.
717 aec636b9 Iustin Pop
solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
718 aec636b9 Iustin Pop
solutionDescription gl (groupId, result) =
719 9b1584fc Iustin Pop
  case result of
720 73206d0a Iustin Pop
    Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution)
721 aec636b9 Iustin Pop
    Bad message -> [printf "Group %s: error %s" gname message]
722 73206d0a Iustin Pop
  where grp = Container.find groupId gl
723 73206d0a Iustin Pop
        gname = Group.name grp
724 73206d0a Iustin Pop
        pol = apolToString (Group.allocPolicy grp)
725 9b1584fc Iustin Pop
726 9b1584fc Iustin Pop
-- | From a list of possibly bad and possibly empty solutions, filter
727 88253d03 Iustin Pop
-- only the groups with a valid result. Note that the result will be
728 525bfb36 Iustin Pop
-- reversed compared to the original list.
729 73206d0a Iustin Pop
filterMGResults :: Group.List
730 73206d0a Iustin Pop
                -> [(Gdx, Result AllocSolution)]
731 73206d0a Iustin Pop
                -> [(Gdx, AllocSolution)]
732 88253d03 Iustin Pop
filterMGResults gl = foldl' fn []
733 88253d03 Iustin Pop
    where unallocable = not . Group.isAllocable . flip Container.find gl
734 88253d03 Iustin Pop
          fn accu (gdx, rasol) =
735 88253d03 Iustin Pop
              case rasol of
736 88253d03 Iustin Pop
                Bad _ -> accu
737 88253d03 Iustin Pop
                Ok sol | null (asSolutions sol) -> accu
738 88253d03 Iustin Pop
                       | unallocable gdx -> accu
739 88253d03 Iustin Pop
                       | otherwise -> (gdx, sol):accu
740 9b1584fc Iustin Pop
741 525bfb36 Iustin Pop
-- | Sort multigroup results based on policy and score.
742 73206d0a Iustin Pop
sortMGResults :: Group.List
743 73206d0a Iustin Pop
             -> [(Gdx, AllocSolution)]
744 73206d0a Iustin Pop
             -> [(Gdx, AllocSolution)]
745 73206d0a Iustin Pop
sortMGResults gl sols =
746 2a8e2dc9 Iustin Pop
    let extractScore (_, _, _, x) = x
747 73206d0a Iustin Pop
        solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
748 73206d0a Iustin Pop
                               (extractScore . head . asSolutions) sol)
749 73206d0a Iustin Pop
    in sortBy (comparing solScore) sols
750 73206d0a Iustin Pop
751 9b1584fc Iustin Pop
-- | Try to allocate an instance on a multi-group cluster.
752 aec636b9 Iustin Pop
tryMGAlloc :: Group.List           -- ^ The group list
753 aec636b9 Iustin Pop
           -> Node.List            -- ^ The node list
754 aec636b9 Iustin Pop
           -> Instance.List        -- ^ The instance list
755 aec636b9 Iustin Pop
           -> Instance.Instance    -- ^ The instance to allocate
756 aec636b9 Iustin Pop
           -> Int                  -- ^ Required number of nodes
757 aec636b9 Iustin Pop
           -> Result AllocSolution -- ^ Possible solution list
758 aec636b9 Iustin Pop
tryMGAlloc mggl mgnl mgil inst cnt =
759 9b1584fc Iustin Pop
  let groups = splitCluster mgnl mgil
760 9b1584fc Iustin Pop
      sols = map (\(gid, (nl, il)) ->
761 6d0bc5ca Iustin Pop
                   (gid, genAllocNodes mggl nl cnt False >>=
762 6d0bc5ca Iustin Pop
                       tryAlloc nl il inst))
763 6cb1649f Iustin Pop
             groups::[(Gdx, Result AllocSolution)]
764 aec636b9 Iustin Pop
      all_msgs = concatMap (solutionDescription mggl) sols
765 73206d0a Iustin Pop
      goodSols = filterMGResults mggl sols
766 73206d0a Iustin Pop
      sortedSols = sortMGResults mggl goodSols
767 9b1584fc Iustin Pop
  in if null sortedSols
768 9b1584fc Iustin Pop
     then Bad $ intercalate ", " all_msgs
769 9b1584fc Iustin Pop
     else let (final_group, final_sol) = head sortedSols
770 aec636b9 Iustin Pop
              final_name = Group.name $ Container.find final_group mggl
771 aec636b9 Iustin Pop
              selmsg = "Selected group: " ++  final_name
772 9b1584fc Iustin Pop
          in Ok $ final_sol { asLog = selmsg:all_msgs }
773 9b1584fc Iustin Pop
774 9b1584fc Iustin Pop
-- | Try to relocate an instance on the cluster.
775 dbba5246 Iustin Pop
tryReloc :: (Monad m) =>
776 78694255 Iustin Pop
            Node.List       -- ^ The node list
777 78694255 Iustin Pop
         -> Instance.List   -- ^ The instance list
778 78694255 Iustin Pop
         -> Idx             -- ^ The index of the instance to move
779 478df686 Iustin Pop
         -> Int             -- ^ The number of nodes required
780 78694255 Iustin Pop
         -> [Ndx]           -- ^ Nodes which should not be used
781 78694255 Iustin Pop
         -> m AllocSolution -- ^ Solution list
782 dbba5246 Iustin Pop
tryReloc nl il xid 1 ex_idx =
783 dbba5246 Iustin Pop
    let all_nodes = getOnline nl
784 dbba5246 Iustin Pop
        inst = Container.find xid il
785 2060348b Iustin Pop
        ex_idx' = Instance.pNode inst:ex_idx
786 dbba5246 Iustin Pop
        valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
787 dbba5246 Iustin Pop
        valid_idxes = map Node.idx valid_nodes
788 478df686 Iustin Pop
        sols1 = foldl' (\cstate x ->
789 fbb95f28 Iustin Pop
                            let em = do
790 478df686 Iustin Pop
                                  (mnl, i, _, _) <-
791 478df686 Iustin Pop
                                      applyMove nl inst (ReplaceSecondary x)
792 7d3f4253 Iustin Pop
                                  return (mnl, i, [Container.find x mnl],
793 7d3f4253 Iustin Pop
                                          compCV mnl)
794 fbb95f28 Iustin Pop
                            in concatAllocs cstate em
795 97936d51 Iustin Pop
                       ) emptyAllocSolution valid_idxes
796 dbba5246 Iustin Pop
    in return sols1
797 dbba5246 Iustin Pop
798 dbba5246 Iustin Pop
tryReloc _ _ _ reqn _  = fail $ "Unsupported number of relocation \
799 9f6dcdea Iustin Pop
                                \destinations required (" ++ show reqn ++
800 dbba5246 Iustin Pop
                                                  "), only one supported"
801 e4f08c46 Iustin Pop
802 4bc33d60 Iustin Pop
tryMGReloc :: (Monad m) =>
803 4bc33d60 Iustin Pop
              Group.List      -- ^ The group list
804 4bc33d60 Iustin Pop
           -> Node.List       -- ^ The node list
805 4bc33d60 Iustin Pop
           -> Instance.List   -- ^ The instance list
806 4bc33d60 Iustin Pop
           -> Idx             -- ^ The index of the instance to move
807 4bc33d60 Iustin Pop
           -> Int             -- ^ The number of nodes required
808 4bc33d60 Iustin Pop
           -> [Ndx]           -- ^ Nodes which should not be used
809 4bc33d60 Iustin Pop
           -> m AllocSolution -- ^ Solution list
810 4bc33d60 Iustin Pop
tryMGReloc _ mgnl mgil xid ncount ex_ndx = do
811 4bc33d60 Iustin Pop
  let groups = splitCluster mgnl mgil
812 4bc33d60 Iustin Pop
      -- TODO: we only relocate inside the group for now
813 4bc33d60 Iustin Pop
      inst = Container.find xid mgil
814 4bc33d60 Iustin Pop
  (nl, il) <- case lookup (instancePriGroup mgnl inst) groups of
815 4bc33d60 Iustin Pop
                Nothing -> fail $ "Cannot find group for instance " ++
816 4bc33d60 Iustin Pop
                           Instance.name inst
817 4bc33d60 Iustin Pop
                Just v -> return v
818 4bc33d60 Iustin Pop
  tryReloc nl il xid ncount ex_ndx
819 4bc33d60 Iustin Pop
820 525bfb36 Iustin Pop
-- | Change an instance's secondary node.
821 2ca68e2b Iustin Pop
evacInstance :: (Monad m) =>
822 2ca68e2b Iustin Pop
                [Ndx]                      -- ^ Excluded nodes
823 2ca68e2b Iustin Pop
             -> Instance.List              -- ^ The current instance list
824 2ca68e2b Iustin Pop
             -> (Node.List, AllocSolution) -- ^ The current state
825 2ca68e2b Iustin Pop
             -> Idx                        -- ^ The instance to evacuate
826 2ca68e2b Iustin Pop
             -> m (Node.List, AllocSolution)
827 2ca68e2b Iustin Pop
evacInstance ex_ndx il (nl, old_as) idx = do
828 2ca68e2b Iustin Pop
  -- FIXME: hardcoded one node here
829 2ca68e2b Iustin Pop
830 2ca68e2b Iustin Pop
  -- Longer explanation: evacuation is currently hardcoded to DRBD
831 2ca68e2b Iustin Pop
  -- instances (which have one secondary); hence, even if the
832 2ca68e2b Iustin Pop
  -- IAllocator protocol can request N nodes for an instance, and all
833 2ca68e2b Iustin Pop
  -- the message parsing/loading pass this, this implementation only
834 2ca68e2b Iustin Pop
  -- supports one; this situation needs to be revisited if we ever
835 2ca68e2b Iustin Pop
  -- support more than one secondary, or if we change the storage
836 2ca68e2b Iustin Pop
  -- model
837 2ca68e2b Iustin Pop
  new_as <- tryReloc nl il idx 1 ex_ndx
838 2ca68e2b Iustin Pop
  case asSolutions new_as of
839 2ca68e2b Iustin Pop
    -- an individual relocation succeeded, we kind of compose the data
840 2ca68e2b Iustin Pop
    -- from the two solutions
841 2ca68e2b Iustin Pop
    csol@(nl', _, _, _):_ ->
842 2ca68e2b Iustin Pop
        return (nl', new_as { asSolutions = csol:asSolutions old_as })
843 2ca68e2b Iustin Pop
    -- this relocation failed, so we fail the entire evac
844 2ca68e2b Iustin Pop
    _ -> fail $ "Can't evacuate instance " ++
845 2ca68e2b Iustin Pop
         Instance.name (Container.find idx il) ++
846 2ca68e2b Iustin Pop
             ": " ++ describeSolution new_as
847 2ca68e2b Iustin Pop
848 3fea6959 Iustin Pop
-- | Try to evacuate a list of nodes.
849 12b0511d Iustin Pop
tryEvac :: (Monad m) =>
850 12b0511d Iustin Pop
            Node.List       -- ^ The node list
851 12b0511d Iustin Pop
         -> Instance.List   -- ^ The instance list
852 1bc47d38 Iustin Pop
         -> [Idx]           -- ^ Instances to be evacuated
853 1bc47d38 Iustin Pop
         -> [Ndx]           -- ^ Restricted nodes (the ones being evacuated)
854 12b0511d Iustin Pop
         -> m AllocSolution -- ^ Solution list
855 1bc47d38 Iustin Pop
tryEvac nl il idxs ex_ndx = do
856 97936d51 Iustin Pop
  (_, sol) <- foldM (evacInstance ex_ndx il) (nl, emptyAllocSolution) idxs
857 1bc47d38 Iustin Pop
  return sol
858 1bc47d38 Iustin Pop
859 1bc47d38 Iustin Pop
-- | Multi-group evacuation of a list of nodes.
860 1bc47d38 Iustin Pop
tryMGEvac :: (Monad m) =>
861 1bc47d38 Iustin Pop
             Group.List -- ^ The group list
862 1bc47d38 Iustin Pop
          -> Node.List       -- ^ The node list
863 1bc47d38 Iustin Pop
          -> Instance.List   -- ^ The instance list
864 1bc47d38 Iustin Pop
          -> [Ndx]           -- ^ Nodes to be evacuated
865 1bc47d38 Iustin Pop
          -> m AllocSolution -- ^ Solution list
866 1bc47d38 Iustin Pop
tryMGEvac _ nl il ex_ndx =
867 5182e970 Iustin Pop
    let ex_nodes = map (`Container.find` nl) ex_ndx
868 5182e970 Iustin Pop
        all_insts = nub . concatMap Node.sList $ ex_nodes
869 1f4ae205 Iustin Pop
        all_insts' = associateIdxs all_insts $ splitCluster nl il
870 12b0511d Iustin Pop
    in do
871 1f4ae205 Iustin Pop
      results <- mapM (\(_, (gnl, gil, idxs)) -> tryEvac gnl gil idxs ex_ndx)
872 1f4ae205 Iustin Pop
                 all_insts'
873 97936d51 Iustin Pop
      let sol = foldl' sumAllocs emptyAllocSolution results
874 859fc11d Iustin Pop
      return $ annotateSolution sol
875 12b0511d Iustin Pop
876 47eed3f4 Iustin Pop
-- | Function which fails if the requested mode is change secondary.
877 47eed3f4 Iustin Pop
--
878 47eed3f4 Iustin Pop
-- This is useful since except DRBD, no other disk template can
879 47eed3f4 Iustin Pop
-- execute change secondary; thus, we can just call this function
880 47eed3f4 Iustin Pop
-- instead of always checking for secondary mode. After the call to
881 47eed3f4 Iustin Pop
-- this function, whatever mode we have is just a primary change.
882 47eed3f4 Iustin Pop
failOnSecondaryChange :: (Monad m) => EvacMode -> DiskTemplate -> m ()
883 47eed3f4 Iustin Pop
failOnSecondaryChange ChangeSecondary dt =
884 47eed3f4 Iustin Pop
    fail $ "Instances with disk template '" ++ dtToString dt ++
885 47eed3f4 Iustin Pop
         "' can't execute change secondary"
886 47eed3f4 Iustin Pop
failOnSecondaryChange _ _ = return ()
887 47eed3f4 Iustin Pop
888 47eed3f4 Iustin Pop
-- | Run evacuation for a single instance.
889 47eed3f4 Iustin Pop
nodeEvacInstance :: Node.List         -- ^ The node list (cluster-wide)
890 47eed3f4 Iustin Pop
                 -> Instance.List     -- ^ Instance list (cluster-wide)
891 47eed3f4 Iustin Pop
                 -> EvacMode          -- ^ The evacuation mode
892 47eed3f4 Iustin Pop
                 -> Instance.Instance -- ^ The instance to be evacuated
893 47eed3f4 Iustin Pop
                 -> [Ndx]             -- ^ The list of available nodes
894 47eed3f4 Iustin Pop
                                      -- for allocation
895 47eed3f4 Iustin Pop
                 -> Result (Node.List, Instance.List, [OpCodes.OpCode])
896 47eed3f4 Iustin Pop
nodeEvacInstance _ _ mode (Instance.Instance
897 47eed3f4 Iustin Pop
                           {Instance.diskTemplate = dt@DTDiskless}) _ =
898 47eed3f4 Iustin Pop
                  failOnSecondaryChange mode dt >>
899 47eed3f4 Iustin Pop
                  fail "Diskless relocations not implemented yet"
900 47eed3f4 Iustin Pop
901 47eed3f4 Iustin Pop
nodeEvacInstance _ _ _ (Instance.Instance
902 47eed3f4 Iustin Pop
                        {Instance.diskTemplate = DTPlain}) _ =
903 47eed3f4 Iustin Pop
                  fail "Instances of type plain cannot be relocated"
904 47eed3f4 Iustin Pop
905 47eed3f4 Iustin Pop
nodeEvacInstance _ _ _ (Instance.Instance
906 47eed3f4 Iustin Pop
                        {Instance.diskTemplate = DTFile}) _ =
907 47eed3f4 Iustin Pop
                  fail "Instances of type file cannot be relocated"
908 47eed3f4 Iustin Pop
909 47eed3f4 Iustin Pop
nodeEvacInstance _ _ mode  (Instance.Instance
910 47eed3f4 Iustin Pop
                            {Instance.diskTemplate = dt@DTSharedFile}) _ =
911 47eed3f4 Iustin Pop
                  failOnSecondaryChange mode dt >>
912 47eed3f4 Iustin Pop
                  fail "Shared file relocations not implemented yet"
913 47eed3f4 Iustin Pop
914 47eed3f4 Iustin Pop
nodeEvacInstance _ _ mode (Instance.Instance
915 47eed3f4 Iustin Pop
                           {Instance.diskTemplate = dt@DTBlock}) _ =
916 47eed3f4 Iustin Pop
                  failOnSecondaryChange mode dt >>
917 47eed3f4 Iustin Pop
                  fail "Block device relocations not implemented yet"
918 47eed3f4 Iustin Pop
919 bef83fd1 Iustin Pop
nodeEvacInstance nl il ChangePrimary
920 bef83fd1 Iustin Pop
                 inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8}) _ =
921 bef83fd1 Iustin Pop
  do
922 bef83fd1 Iustin Pop
    (nl', inst', _, _) <- opToResult $ applyMove nl inst Failover
923 bef83fd1 Iustin Pop
    let idx = Instance.idx inst
924 bef83fd1 Iustin Pop
        il' = Container.add idx inst' il
925 bef83fd1 Iustin Pop
        ops = iMoveToJob nl' il' idx Failover
926 bef83fd1 Iustin Pop
    return (nl', il', ops)
927 bef83fd1 Iustin Pop
928 db56cfc4 Iustin Pop
nodeEvacInstance nl il ChangeSecondary
929 db56cfc4 Iustin Pop
                 inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
930 db56cfc4 Iustin Pop
                 avail_nodes =
931 db56cfc4 Iustin Pop
  do
932 db56cfc4 Iustin Pop
    let gdx = instancePriGroup nl inst
933 db56cfc4 Iustin Pop
    (nl', inst', _, ndx) <- annotateResult "Can't find any good node" $
934 db56cfc4 Iustin Pop
                            eitherToResult $
935 db56cfc4 Iustin Pop
                            foldl' (evacDrbdSecondaryInner nl inst gdx)
936 db56cfc4 Iustin Pop
                            (Left "no nodes available") avail_nodes
937 db56cfc4 Iustin Pop
    let idx = Instance.idx inst
938 db56cfc4 Iustin Pop
        il' = Container.add idx inst' il
939 db56cfc4 Iustin Pop
        ops = iMoveToJob nl' il' idx (ReplaceSecondary ndx)
940 db56cfc4 Iustin Pop
    return (nl', il', ops)
941 db56cfc4 Iustin Pop
942 d52d41de Iustin Pop
nodeEvacInstance nl il ChangeAll
943 d52d41de Iustin Pop
                 inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
944 d52d41de Iustin Pop
                 avail_nodes =
945 d52d41de Iustin Pop
  do
946 d52d41de Iustin Pop
    let primary = Container.find (Instance.pNode inst) nl
947 d52d41de Iustin Pop
        idx = Instance.idx inst
948 d52d41de Iustin Pop
        gdx = instancePriGroup nl inst
949 d52d41de Iustin Pop
        no_nodes = Left "no nodes available"
950 d52d41de Iustin Pop
    -- if the primary is offline, then we first failover
951 d52d41de Iustin Pop
    (nl1, inst1, ops1) <-
952 d52d41de Iustin Pop
        if Node.offline primary
953 d52d41de Iustin Pop
        then do
954 d52d41de Iustin Pop
          (nl', inst', _, _) <-
955 d52d41de Iustin Pop
              annotateResult "Failing over to the secondary" $
956 d52d41de Iustin Pop
              opToResult $ applyMove nl inst Failover
957 d52d41de Iustin Pop
          return (nl', inst', [Failover])
958 d52d41de Iustin Pop
        else return (nl, inst, [])
959 d52d41de Iustin Pop
    -- we now need to execute a replace secondary to the future
960 d52d41de Iustin Pop
    -- primary node
961 d52d41de Iustin Pop
    (nl2, inst2, _, new_pdx) <- annotateResult "Searching for a new primary" $
962 d52d41de Iustin Pop
                                eitherToResult $
963 d52d41de Iustin Pop
                                foldl' (evacDrbdSecondaryInner nl1 inst1 gdx)
964 d52d41de Iustin Pop
                                no_nodes avail_nodes
965 d52d41de Iustin Pop
    let ops2 = ReplaceSecondary new_pdx:ops1
966 d52d41de Iustin Pop
    -- since we chose the new primary, we remove it from the list of
967 d52d41de Iustin Pop
    -- available nodes
968 d52d41de Iustin Pop
    let avail_nodes_sec = new_pdx `delete` avail_nodes
969 d52d41de Iustin Pop
    -- we now execute another failover, the primary stays fixed now
970 d52d41de Iustin Pop
    (nl3, inst3, _, _) <- annotateResult "Failing over to new primary" $
971 d52d41de Iustin Pop
                          opToResult $ applyMove nl2 inst2 Failover
972 d52d41de Iustin Pop
    let ops3 = Failover:ops2
973 d52d41de Iustin Pop
    -- and finally another replace secondary, to the final secondary
974 d52d41de Iustin Pop
    (nl4, inst4, _, new_sdx) <-
975 d52d41de Iustin Pop
        annotateResult "Searching for a new secondary" $
976 d52d41de Iustin Pop
        eitherToResult $
977 d52d41de Iustin Pop
        foldl' (evacDrbdSecondaryInner nl3 inst3 gdx) no_nodes avail_nodes_sec
978 d52d41de Iustin Pop
    let ops4 = ReplaceSecondary new_sdx:ops3
979 d52d41de Iustin Pop
        il' = Container.add idx inst4 il
980 d52d41de Iustin Pop
        ops = concatMap (iMoveToJob nl4 il' idx) $ reverse ops4
981 d52d41de Iustin Pop
    return (nl4, il', ops)
982 47eed3f4 Iustin Pop
983 db56cfc4 Iustin Pop
-- | Inner fold function for changing secondary of a DRBD instance.
984 db56cfc4 Iustin Pop
--
985 db56cfc4 Iustin Pop
-- The "running" solution is either a @Left String@, which means we
986 db56cfc4 Iustin Pop
-- don't have yet a working solution, or a @Right (...)@, which
987 db56cfc4 Iustin Pop
-- represents a valid solution; it holds the modified node list, the
988 db56cfc4 Iustin Pop
-- modified instance (after evacuation), the score of that solution,
989 db56cfc4 Iustin Pop
-- and the new secondary node index.
990 db56cfc4 Iustin Pop
evacDrbdSecondaryInner :: Node.List -- ^ Cluster node list
991 db56cfc4 Iustin Pop
                       -> Instance.Instance -- ^ Instance being evacuated
992 db56cfc4 Iustin Pop
                       -> Gdx -- ^ The group index of the instance
993 db56cfc4 Iustin Pop
                       -> Either String ( Node.List
994 db56cfc4 Iustin Pop
                                        , Instance.Instance
995 db56cfc4 Iustin Pop
                                        , Score
996 db56cfc4 Iustin Pop
                                        , Ndx)  -- ^ Current best solution
997 db56cfc4 Iustin Pop
                       -> Ndx  -- ^ Node we're evaluating as new secondary
998 db56cfc4 Iustin Pop
                       -> Either String ( Node.List
999 db56cfc4 Iustin Pop
                                        , Instance.Instance
1000 db56cfc4 Iustin Pop
                                        , Score
1001 db56cfc4 Iustin Pop
                                        , Ndx) -- ^ New best solution
1002 db56cfc4 Iustin Pop
evacDrbdSecondaryInner nl inst gdx accu ndx =
1003 db56cfc4 Iustin Pop
    case applyMove nl inst (ReplaceSecondary ndx) of
1004 db56cfc4 Iustin Pop
      OpFail fm ->
1005 db56cfc4 Iustin Pop
          case accu of
1006 db56cfc4 Iustin Pop
            Right _ -> accu
1007 db56cfc4 Iustin Pop
            Left _ -> Left $ "Node " ++ Container.nameOf nl ndx ++
1008 db56cfc4 Iustin Pop
                      " failed: " ++ show fm
1009 db56cfc4 Iustin Pop
      OpGood (nl', inst', _, _) ->
1010 db56cfc4 Iustin Pop
          let nodes = Container.elems nl'
1011 db56cfc4 Iustin Pop
              -- The fromJust below is ugly (it can fail nastily), but
1012 db56cfc4 Iustin Pop
              -- at this point we should have any internal mismatches,
1013 db56cfc4 Iustin Pop
              -- and adding a monad here would be quite involved
1014 db56cfc4 Iustin Pop
              grpnodes = fromJust (gdx `lookup` (Node.computeGroups nodes))
1015 db56cfc4 Iustin Pop
              new_cv = compCVNodes grpnodes
1016 db56cfc4 Iustin Pop
              new_accu = Right (nl', inst', new_cv, ndx)
1017 db56cfc4 Iustin Pop
          in case accu of
1018 db56cfc4 Iustin Pop
               Left _ -> new_accu
1019 db56cfc4 Iustin Pop
               Right (_, _, old_cv, _) ->
1020 db56cfc4 Iustin Pop
                   if old_cv < new_cv
1021 db56cfc4 Iustin Pop
                   then accu
1022 db56cfc4 Iustin Pop
                   else new_accu
1023 db56cfc4 Iustin Pop
1024 47eed3f4 Iustin Pop
-- | Computes the local nodes of a given instance which are available
1025 47eed3f4 Iustin Pop
-- for allocation.
1026 47eed3f4 Iustin Pop
availableLocalNodes :: Node.List
1027 47eed3f4 Iustin Pop
                    -> [(Gdx, [Ndx])]
1028 47eed3f4 Iustin Pop
                    -> IntSet.IntSet
1029 47eed3f4 Iustin Pop
                    -> Instance.Instance
1030 47eed3f4 Iustin Pop
                    -> Result [Ndx]
1031 47eed3f4 Iustin Pop
availableLocalNodes nl group_nodes excl_ndx inst = do
1032 47eed3f4 Iustin Pop
  let gdx = instancePriGroup nl inst
1033 47eed3f4 Iustin Pop
  local_nodes <- maybe (Bad $ "Can't find group with index " ++ show gdx)
1034 47eed3f4 Iustin Pop
                 Ok (lookup gdx group_nodes)
1035 47eed3f4 Iustin Pop
  let avail_nodes = filter (not . flip IntSet.member excl_ndx) local_nodes
1036 47eed3f4 Iustin Pop
  return avail_nodes
1037 47eed3f4 Iustin Pop
1038 47eed3f4 Iustin Pop
-- | Updates the evac solution with the results of an instance
1039 47eed3f4 Iustin Pop
-- evacuation.
1040 47eed3f4 Iustin Pop
updateEvacSolution :: (Node.List, Instance.List, EvacSolution)
1041 47eed3f4 Iustin Pop
                   -> Instance.Instance
1042 47eed3f4 Iustin Pop
                   -> Result (Node.List, Instance.List, [OpCodes.OpCode])
1043 47eed3f4 Iustin Pop
                   -> (Node.List, Instance.List, EvacSolution)
1044 47eed3f4 Iustin Pop
updateEvacSolution (nl, il, es) inst (Bad msg) =
1045 47eed3f4 Iustin Pop
    (nl, il, es { esFailed = (Instance.name inst ++ ": " ++ msg):esFailed es})
1046 47eed3f4 Iustin Pop
updateEvacSolution (_, _, es) inst (Ok (nl, il, opcodes)) =
1047 47eed3f4 Iustin Pop
    (nl, il, es { esMoved = Instance.name inst:esMoved es
1048 47eed3f4 Iustin Pop
                , esOpCodes = [opcodes]:esOpCodes es })
1049 47eed3f4 Iustin Pop
1050 47eed3f4 Iustin Pop
-- | Node-evacuation IAllocator mode main function.
1051 47eed3f4 Iustin Pop
tryNodeEvac :: Group.List    -- ^ The cluster groups
1052 47eed3f4 Iustin Pop
            -> Node.List     -- ^ The node list (cluster-wide, not per group)
1053 47eed3f4 Iustin Pop
            -> Instance.List -- ^ Instance list (cluster-wide)
1054 47eed3f4 Iustin Pop
            -> EvacMode      -- ^ The evacuation mode
1055 47eed3f4 Iustin Pop
            -> [Idx]         -- ^ List of instance (indices) to be evacuated
1056 47eed3f4 Iustin Pop
            -> Result EvacSolution
1057 47eed3f4 Iustin Pop
tryNodeEvac _ ini_nl ini_il mode idxs =
1058 47eed3f4 Iustin Pop
    let evac_ndx = nodesToEvacuate ini_il mode idxs
1059 47eed3f4 Iustin Pop
        offline = map Node.idx . filter Node.offline $ Container.elems ini_nl
1060 47eed3f4 Iustin Pop
        excl_ndx = foldl' (flip IntSet.insert) evac_ndx offline
1061 47eed3f4 Iustin Pop
        group_ndx = map (\(gdx, (nl, _)) -> (gdx, map Node.idx
1062 47eed3f4 Iustin Pop
                                             (Container.elems nl))) $
1063 47eed3f4 Iustin Pop
                      splitCluster ini_nl ini_il
1064 47eed3f4 Iustin Pop
        (_, _, esol) =
1065 47eed3f4 Iustin Pop
            foldl' (\state@(nl, il, _) inst ->
1066 47eed3f4 Iustin Pop
                        updateEvacSolution state inst $
1067 47eed3f4 Iustin Pop
                        availableLocalNodes nl group_ndx excl_ndx inst >>=
1068 47eed3f4 Iustin Pop
                        nodeEvacInstance nl il mode inst
1069 47eed3f4 Iustin Pop
                   )
1070 47eed3f4 Iustin Pop
            (ini_nl, ini_il, emptyEvacSolution)
1071 47eed3f4 Iustin Pop
            (map (`Container.find` ini_il) idxs)
1072 47eed3f4 Iustin Pop
    in return $ reverseEvacSolution esol
1073 47eed3f4 Iustin Pop
1074 525bfb36 Iustin Pop
-- | Recursively place instances on the cluster until we're out of space.
1075 3ce8009a Iustin Pop
iterateAlloc :: Node.List
1076 3ce8009a Iustin Pop
             -> Instance.List
1077 8f48f67d Iustin Pop
             -> Maybe Int
1078 3ce8009a Iustin Pop
             -> Instance.Instance
1079 41b5c85a Iustin Pop
             -> AllocNodes
1080 3ce8009a Iustin Pop
             -> [Instance.Instance]
1081 d5ccec02 Iustin Pop
             -> [CStats]
1082 40ee14bc Iustin Pop
             -> Result AllocResult
1083 8f48f67d Iustin Pop
iterateAlloc nl il limit newinst allocnodes ixes cstats =
1084 3ce8009a Iustin Pop
      let depth = length ixes
1085 3ce8009a Iustin Pop
          newname = printf "new-%d" depth::String
1086 3ce8009a Iustin Pop
          newidx = length (Container.elems il) + depth
1087 3ce8009a Iustin Pop
          newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
1088 8f48f67d Iustin Pop
          newlimit = fmap (flip (-) 1) limit
1089 41b5c85a Iustin Pop
      in case tryAlloc nl il newi2 allocnodes of
1090 3ce8009a Iustin Pop
           Bad s -> Bad s
1091 85d0ddc3 Iustin Pop
           Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
1092 8f48f67d Iustin Pop
               let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in
1093 3ce8009a Iustin Pop
               case sols3 of
1094 8f48f67d Iustin Pop
                 [] -> newsol
1095 a334d536 Iustin Pop
                 (xnl, xi, _, _):[] ->
1096 8f48f67d Iustin Pop
                     if limit == Just 0
1097 8f48f67d Iustin Pop
                     then newsol
1098 8f48f67d Iustin Pop
                     else iterateAlloc xnl (Container.add newidx xi il)
1099 8f48f67d Iustin Pop
                          newlimit newinst allocnodes (xi:ixes)
1100 8f48f67d Iustin Pop
                          (totalResources xnl:cstats)
1101 3ce8009a Iustin Pop
                 _ -> Bad "Internal error: multiple solutions for single\
1102 3ce8009a Iustin Pop
                          \ allocation"
1103 3ce8009a Iustin Pop
1104 525bfb36 Iustin Pop
-- | The core of the tiered allocation mode.
1105 3ce8009a Iustin Pop
tieredAlloc :: Node.List
1106 3ce8009a Iustin Pop
            -> Instance.List
1107 8f48f67d Iustin Pop
            -> Maybe Int
1108 3ce8009a Iustin Pop
            -> Instance.Instance
1109 41b5c85a Iustin Pop
            -> AllocNodes
1110 3ce8009a Iustin Pop
            -> [Instance.Instance]
1111 d5ccec02 Iustin Pop
            -> [CStats]
1112 40ee14bc Iustin Pop
            -> Result AllocResult
1113 8f48f67d Iustin Pop
tieredAlloc nl il limit newinst allocnodes ixes cstats =
1114 8f48f67d Iustin Pop
    case iterateAlloc nl il limit newinst allocnodes ixes cstats of
1115 3ce8009a Iustin Pop
      Bad s -> Bad s
1116 d5ccec02 Iustin Pop
      Ok (errs, nl', il', ixes', cstats') ->
1117 8f48f67d Iustin Pop
          let newsol = Ok (errs, nl', il', ixes', cstats')
1118 8f48f67d Iustin Pop
              ixes_cnt = length ixes'
1119 8f48f67d Iustin Pop
              (stop, newlimit) = case limit of
1120 8f48f67d Iustin Pop
                                   Nothing -> (False, Nothing)
1121 8f48f67d Iustin Pop
                                   Just n -> (n <= ixes_cnt,
1122 8f48f67d Iustin Pop
                                              Just (n - ixes_cnt)) in
1123 8f48f67d Iustin Pop
          if stop then newsol else
1124 3ce8009a Iustin Pop
          case Instance.shrinkByType newinst . fst . last $
1125 3ce8009a Iustin Pop
               sortBy (comparing snd) errs of
1126 8f48f67d Iustin Pop
            Bad _ -> newsol
1127 8f48f67d Iustin Pop
            Ok newinst' -> tieredAlloc nl' il' newlimit
1128 8f48f67d Iustin Pop
                           newinst' allocnodes ixes' cstats'
1129 3ce8009a Iustin Pop
1130 949397c8 Iustin Pop
-- | Compute the tiered spec string description from a list of
1131 949397c8 Iustin Pop
-- allocated instances.
1132 949397c8 Iustin Pop
tieredSpecMap :: [Instance.Instance]
1133 949397c8 Iustin Pop
              -> [String]
1134 949397c8 Iustin Pop
tieredSpecMap trl_ixes =
1135 949397c8 Iustin Pop
    let fin_trl_ixes = reverse trl_ixes
1136 949397c8 Iustin Pop
        ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
1137 949397c8 Iustin Pop
        spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
1138 949397c8 Iustin Pop
                   ix_byspec
1139 949397c8 Iustin Pop
    in  map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
1140 949397c8 Iustin Pop
                             (rspecDsk spec) (rspecCpu spec) cnt) spec_map
1141 949397c8 Iustin Pop
1142 9188aeef Iustin Pop
-- * Formatting functions
1143 e4f08c46 Iustin Pop
1144 e4f08c46 Iustin Pop
-- | Given the original and final nodes, computes the relocation description.
1145 c9926b22 Iustin Pop
computeMoves :: Instance.Instance -- ^ The instance to be moved
1146 c9926b22 Iustin Pop
             -> String -- ^ The instance name
1147 668c03b3 Iustin Pop
             -> IMove  -- ^ The move being performed
1148 e4f08c46 Iustin Pop
             -> String -- ^ New primary
1149 e4f08c46 Iustin Pop
             -> String -- ^ New secondary
1150 e4f08c46 Iustin Pop
             -> (String, [String])
1151 e4f08c46 Iustin Pop
                -- ^ Tuple of moves and commands list; moves is containing
1152 e4f08c46 Iustin Pop
                -- either @/f/@ for failover or @/r:name/@ for replace
1153 e4f08c46 Iustin Pop
                -- secondary, while the command list holds gnt-instance
1154 e4f08c46 Iustin Pop
                -- commands (without that prefix), e.g \"@failover instance1@\"
1155 668c03b3 Iustin Pop
computeMoves i inam mv c d =
1156 668c03b3 Iustin Pop
    case mv of
1157 668c03b3 Iustin Pop
      Failover -> ("f", [mig])
1158 668c03b3 Iustin Pop
      FailoverAndReplace _ -> (printf "f r:%s" d, [mig, rep d])
1159 668c03b3 Iustin Pop
      ReplaceSecondary _ -> (printf "r:%s" d, [rep d])
1160 668c03b3 Iustin Pop
      ReplaceAndFailover _ -> (printf "r:%s f" c, [rep c, mig])
1161 668c03b3 Iustin Pop
      ReplacePrimary _ -> (printf "f r:%s f" c, [mig, rep c, mig])
1162 c9926b22 Iustin Pop
    where morf = if Instance.running i then "migrate" else "failover"
1163 c9926b22 Iustin Pop
          mig = printf "%s -f %s" morf inam::String
1164 c9926b22 Iustin Pop
          rep n = printf "replace-disks -n %s %s" n inam
1165 e4f08c46 Iustin Pop
1166 9188aeef Iustin Pop
-- | Converts a placement to string format.
1167 9188aeef Iustin Pop
printSolutionLine :: Node.List     -- ^ The node list
1168 9188aeef Iustin Pop
                  -> Instance.List -- ^ The instance list
1169 9188aeef Iustin Pop
                  -> Int           -- ^ Maximum node name length
1170 9188aeef Iustin Pop
                  -> Int           -- ^ Maximum instance name length
1171 9188aeef Iustin Pop
                  -> Placement     -- ^ The current placement
1172 9188aeef Iustin Pop
                  -> Int           -- ^ The index of the placement in
1173 9188aeef Iustin Pop
                                   -- the solution
1174 db1bcfe8 Iustin Pop
                  -> (String, [String])
1175 db1bcfe8 Iustin Pop
printSolutionLine nl il nmlen imlen plc pos =
1176 ca8258d9 Iustin Pop
    let
1177 ca8258d9 Iustin Pop
        pmlen = (2*nmlen + 1)
1178 668c03b3 Iustin Pop
        (i, p, s, mv, c) = plc
1179 ca8258d9 Iustin Pop
        inst = Container.find i il
1180 14c972c7 Iustin Pop
        inam = Instance.alias inst
1181 14c972c7 Iustin Pop
        npri = Node.alias $ Container.find p nl
1182 14c972c7 Iustin Pop
        nsec = Node.alias $ Container.find s nl
1183 14c972c7 Iustin Pop
        opri = Node.alias $ Container.find (Instance.pNode inst) nl
1184 14c972c7 Iustin Pop
        osec = Node.alias $ Container.find (Instance.sNode inst) nl
1185 668c03b3 Iustin Pop
        (moves, cmds) =  computeMoves inst inam mv npri nsec
1186 9f6dcdea Iustin Pop
        ostr = printf "%s:%s" opri osec::String
1187 9f6dcdea Iustin Pop
        nstr = printf "%s:%s" npri nsec::String
1188 ca8258d9 Iustin Pop
    in
1189 ab271fc1 Iustin Pop
      (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
1190 ab271fc1 Iustin Pop
       pos imlen inam pmlen ostr
1191 ca8258d9 Iustin Pop
       pmlen nstr c moves,
1192 ca8258d9 Iustin Pop
       cmds)
1193 ca8258d9 Iustin Pop
1194 0e8ae201 Iustin Pop
-- | Return the instance and involved nodes in an instance move.
1195 0e8ae201 Iustin Pop
involvedNodes :: Instance.List -> Placement -> [Ndx]
1196 0e8ae201 Iustin Pop
involvedNodes il plc =
1197 3173c987 Iustin Pop
    let (i, np, ns, _, _) = plc
1198 0e8ae201 Iustin Pop
        inst = Container.find i il
1199 2060348b Iustin Pop
        op = Instance.pNode inst
1200 2060348b Iustin Pop
        os = Instance.sNode inst
1201 0e8ae201 Iustin Pop
    in nub [np, ns, op, os]
1202 0e8ae201 Iustin Pop
1203 0e8ae201 Iustin Pop
-- | Inner function for splitJobs, that either appends the next job to
1204 0e8ae201 Iustin Pop
-- the current jobset, or starts a new jobset.
1205 0e8ae201 Iustin Pop
mergeJobs :: ([JobSet], [Ndx]) -> MoveJob -> ([JobSet], [Ndx])
1206 924f9c16 Iustin Pop
mergeJobs ([], _) n@(ndx, _, _, _) = ([[n]], ndx)
1207 924f9c16 Iustin Pop
mergeJobs (cjs@(j:js), nbuf) n@(ndx, _, _, _)
1208 0e8ae201 Iustin Pop
    | null (ndx `intersect` nbuf) = ((n:j):js, ndx ++ nbuf)
1209 0e8ae201 Iustin Pop
    | otherwise = ([n]:cjs, ndx)
1210 0e8ae201 Iustin Pop
1211 0e8ae201 Iustin Pop
-- | Break a list of moves into independent groups. Note that this
1212 0e8ae201 Iustin Pop
-- will reverse the order of jobs.
1213 0e8ae201 Iustin Pop
splitJobs :: [MoveJob] -> [JobSet]
1214 0e8ae201 Iustin Pop
splitJobs = fst . foldl mergeJobs ([], [])
1215 0e8ae201 Iustin Pop
1216 0e8ae201 Iustin Pop
-- | Given a list of commands, prefix them with @gnt-instance@ and
1217 0e8ae201 Iustin Pop
-- also beautify the display a little.
1218 0e8ae201 Iustin Pop
formatJob :: Int -> Int -> (Int, MoveJob) -> [String]
1219 924f9c16 Iustin Pop
formatJob jsn jsl (sn, (_, _, _, cmds)) =
1220 0e8ae201 Iustin Pop
    let out =
1221 0e8ae201 Iustin Pop
            printf "  echo job %d/%d" jsn sn:
1222 0e8ae201 Iustin Pop
            printf "  check":
1223 0e8ae201 Iustin Pop
            map ("  gnt-instance " ++) cmds
1224 0e8ae201 Iustin Pop
    in if sn == 1
1225 0e8ae201 Iustin Pop
       then ["", printf "echo jobset %d, %d jobs" jsn jsl] ++ out
1226 0e8ae201 Iustin Pop
       else out
1227 0e8ae201 Iustin Pop
1228 9188aeef Iustin Pop
-- | Given a list of commands, prefix them with @gnt-instance@ and
1229 9188aeef Iustin Pop
-- also beautify the display a little.
1230 0e8ae201 Iustin Pop
formatCmds :: [JobSet] -> String
1231 9f6dcdea Iustin Pop
formatCmds =
1232 9f6dcdea Iustin Pop
    unlines .
1233 0e8ae201 Iustin Pop
    concatMap (\(jsn, js) -> concatMap (formatJob jsn (length js))
1234 0e8ae201 Iustin Pop
                             (zip [1..] js)) .
1235 9f6dcdea Iustin Pop
    zip [1..]
1236 142538ff Iustin Pop
1237 e4f08c46 Iustin Pop
-- | Print the node list.
1238 e98fb766 Iustin Pop
printNodes :: Node.List -> [String] -> String
1239 e98fb766 Iustin Pop
printNodes nl fs =
1240 6dfa04fd Iustin Pop
    let fields = case fs of
1241 6dfa04fd Iustin Pop
          [] -> Node.defaultFields
1242 6dfa04fd Iustin Pop
          "+":rest -> Node.defaultFields ++ rest
1243 6dfa04fd Iustin Pop
          _ -> fs
1244 5182e970 Iustin Pop
        snl = sortBy (comparing Node.idx) (Container.elems nl)
1245 e98fb766 Iustin Pop
        (header, isnum) = unzip $ map Node.showHeader fields
1246 c5f7412e Iustin Pop
    in unlines . map ((:) ' ' .  intercalate " ") $
1247 e98fb766 Iustin Pop
       formatTable (header:map (Node.list fields) snl) isnum
1248 e4f08c46 Iustin Pop
1249 507fda3f Iustin Pop
-- | Print the instance list.
1250 507fda3f Iustin Pop
printInsts :: Node.List -> Instance.List -> String
1251 507fda3f Iustin Pop
printInsts nl il =
1252 5182e970 Iustin Pop
    let sil = sortBy (comparing Instance.idx) (Container.elems il)
1253 30ff0c73 Iustin Pop
        helper inst = [ if Instance.running inst then "R" else " "
1254 30ff0c73 Iustin Pop
                      , Instance.name inst
1255 30ff0c73 Iustin Pop
                      , Container.nameOf nl (Instance.pNode inst)
1256 5182e970 Iustin Pop
                      , let sdx = Instance.sNode inst
1257 5182e970 Iustin Pop
                        in if sdx == Node.noSecondary
1258 5182e970 Iustin Pop
                           then  ""
1259 5182e970 Iustin Pop
                           else Container.nameOf nl sdx
1260 0e09422b Iustin Pop
                      , if Instance.autoBalance inst then "Y" else "N"
1261 30ff0c73 Iustin Pop
                      , printf "%3d" $ Instance.vcpus inst
1262 30ff0c73 Iustin Pop
                      , printf "%5d" $ Instance.mem inst
1263 30ff0c73 Iustin Pop
                      , printf "%5d" $ Instance.dsk inst `div` 1024
1264 30ff0c73 Iustin Pop
                      , printf "%5.3f" lC
1265 30ff0c73 Iustin Pop
                      , printf "%5.3f" lM
1266 30ff0c73 Iustin Pop
                      , printf "%5.3f" lD
1267 30ff0c73 Iustin Pop
                      , printf "%5.3f" lN
1268 30ff0c73 Iustin Pop
                      ]
1269 30ff0c73 Iustin Pop
            where DynUtil lC lM lD lN = Instance.util inst
1270 93439b1c Iustin Pop
        header = [ "F", "Name", "Pri_node", "Sec_node", "Auto_bal"
1271 93439b1c Iustin Pop
                 , "vcpu", "mem" , "dsk", "lCpu", "lMem", "lDsk", "lNet" ]
1272 93439b1c Iustin Pop
        isnum = False:False:False:False:False:repeat True
1273 c5f7412e Iustin Pop
    in unlines . map ((:) ' ' . intercalate " ") $
1274 c5f7412e Iustin Pop
       formatTable (header:map helper sil) isnum
1275 507fda3f Iustin Pop
1276 9188aeef Iustin Pop
-- | Shows statistics for a given node list.
1277 262a08a2 Iustin Pop
printStats :: Node.List -> String
1278 e4f08c46 Iustin Pop
printStats nl =
1279 9bb5721c Iustin Pop
    let dcvs = compDetailedCV $ Container.elems nl
1280 8a3b30ca Iustin Pop
        (weights, names) = unzip detailedCVInfo
1281 8a3b30ca Iustin Pop
        hd = zip3 (weights ++ repeat 1) (names ++ repeat "unknown") dcvs
1282 8a3b30ca Iustin Pop
        formatted = map (\(w, header, val) ->
1283 8a3b30ca Iustin Pop
                             printf "%s=%.8f(x%.2f)" header val w::String) hd
1284 fca250e9 Iustin Pop
    in intercalate ", " formatted
1285 6b20875c Iustin Pop
1286 6b20875c Iustin Pop
-- | Convert a placement into a list of OpCodes (basically a job).
1287 3e4480e0 Iustin Pop
iMoveToJob :: Node.List -> Instance.List
1288 6b20875c Iustin Pop
          -> Idx -> IMove -> [OpCodes.OpCode]
1289 3e4480e0 Iustin Pop
iMoveToJob nl il idx move =
1290 dfbbd43a Iustin Pop
    let inst = Container.find idx il
1291 3e4480e0 Iustin Pop
        iname = Instance.name inst
1292 3e4480e0 Iustin Pop
        lookNode  = Just . Container.nameOf nl
1293 10028866 René Nussbaumer
        opF = OpCodes.OpInstanceMigrate iname True False True
1294 10028866 René Nussbaumer
        opR n = OpCodes.OpInstanceReplaceDisks iname (lookNode n)
1295 6b20875c Iustin Pop
                OpCodes.ReplaceNewSecondary [] Nothing
1296 6b20875c Iustin Pop
    in case move of
1297 6b20875c Iustin Pop
         Failover -> [ opF ]
1298 6b20875c Iustin Pop
         ReplacePrimary np -> [ opF, opR np, opF ]
1299 6b20875c Iustin Pop
         ReplaceSecondary ns -> [ opR ns ]
1300 6b20875c Iustin Pop
         ReplaceAndFailover np -> [ opR np, opF ]
1301 6b20875c Iustin Pop
         FailoverAndReplace ns -> [ opF, opR ns ]
1302 32b8d9c0 Iustin Pop
1303 949397c8 Iustin Pop
-- * Node group functions
1304 949397c8 Iustin Pop
1305 525bfb36 Iustin Pop
-- | Computes the group of an instance.
1306 10ef6b4e Iustin Pop
instanceGroup :: Node.List -> Instance.Instance -> Result Gdx
1307 32b8d9c0 Iustin Pop
instanceGroup nl i =
1308 32b8d9c0 Iustin Pop
  let sidx = Instance.sNode i
1309 32b8d9c0 Iustin Pop
      pnode = Container.find (Instance.pNode i) nl
1310 32b8d9c0 Iustin Pop
      snode = if sidx == Node.noSecondary
1311 32b8d9c0 Iustin Pop
              then pnode
1312 32b8d9c0 Iustin Pop
              else Container.find sidx nl
1313 10ef6b4e Iustin Pop
      pgroup = Node.group pnode
1314 10ef6b4e Iustin Pop
      sgroup = Node.group snode
1315 10ef6b4e Iustin Pop
  in if pgroup /= sgroup
1316 10ef6b4e Iustin Pop
     then fail ("Instance placed accross two node groups, primary " ++
1317 10ef6b4e Iustin Pop
                show pgroup ++ ", secondary " ++ show sgroup)
1318 10ef6b4e Iustin Pop
     else return pgroup
1319 32b8d9c0 Iustin Pop
1320 525bfb36 Iustin Pop
-- | Computes the group of an instance per the primary node.
1321 4bc33d60 Iustin Pop
instancePriGroup :: Node.List -> Instance.Instance -> Gdx
1322 4bc33d60 Iustin Pop
instancePriGroup nl i =
1323 4bc33d60 Iustin Pop
  let pnode = Container.find (Instance.pNode i) nl
1324 4bc33d60 Iustin Pop
  in  Node.group pnode
1325 4bc33d60 Iustin Pop
1326 32b8d9c0 Iustin Pop
-- | Compute the list of badly allocated instances (split across node
1327 525bfb36 Iustin Pop
-- groups).
1328 32b8d9c0 Iustin Pop
findSplitInstances :: Node.List -> Instance.List -> [Instance.Instance]
1329 2a8e2dc9 Iustin Pop
findSplitInstances nl =
1330 2a8e2dc9 Iustin Pop
  filter (not . isOk . instanceGroup nl) . Container.elems
1331 f4161783 Iustin Pop
1332 525bfb36 Iustin Pop
-- | Splits a cluster into the component node groups.
1333 f4161783 Iustin Pop
splitCluster :: Node.List -> Instance.List ->
1334 10ef6b4e Iustin Pop
                [(Gdx, (Node.List, Instance.List))]
1335 f4161783 Iustin Pop
splitCluster nl il =
1336 f4161783 Iustin Pop
  let ngroups = Node.computeGroups (Container.elems nl)
1337 f4161783 Iustin Pop
  in map (\(guuid, nodes) ->
1338 f4161783 Iustin Pop
           let nidxs = map Node.idx nodes
1339 f4161783 Iustin Pop
               nodes' = zip nidxs nodes
1340 f4161783 Iustin Pop
               instances = Container.filter ((`elem` nidxs) . Instance.pNode) il
1341 cb0c77ff Iustin Pop
           in (guuid, (Container.fromList nodes', instances))) ngroups
1342 1f4ae205 Iustin Pop
1343 1f4ae205 Iustin Pop
-- | Split a global instance index map into per-group, and associate
1344 1f4ae205 Iustin Pop
-- it with the group/node/instance lists.
1345 1f4ae205 Iustin Pop
associateIdxs :: [Idx] -- ^ Instance indices to be split/associated
1346 1f4ae205 Iustin Pop
              -> [(Gdx, (Node.List, Instance.List))]        -- ^ Input groups
1347 1f4ae205 Iustin Pop
              -> [(Gdx, (Node.List, Instance.List, [Idx]))] -- ^ Result
1348 1f4ae205 Iustin Pop
associateIdxs idxs =
1349 1f4ae205 Iustin Pop
    map (\(gdx, (nl, il)) ->
1350 1f4ae205 Iustin Pop
             (gdx, (nl, il, filter (`Container.member` il) idxs)))
1351 63a78055 Iustin Pop
1352 63a78055 Iustin Pop
-- | Compute the list of nodes that are to be evacuated, given a list
1353 63a78055 Iustin Pop
-- of instances and an evacuation mode.
1354 63a78055 Iustin Pop
nodesToEvacuate :: Instance.List -- ^ The cluster-wide instance list
1355 63a78055 Iustin Pop
                -> EvacMode      -- ^ The evacuation mode we're using
1356 63a78055 Iustin Pop
                -> [Idx]         -- ^ List of instance indices being evacuated
1357 63a78055 Iustin Pop
                -> IntSet.IntSet -- ^ Set of node indices
1358 63a78055 Iustin Pop
nodesToEvacuate il mode =
1359 63a78055 Iustin Pop
    IntSet.delete Node.noSecondary .
1360 63a78055 Iustin Pop
    foldl' (\ns idx ->
1361 63a78055 Iustin Pop
                let i = Container.find idx il
1362 63a78055 Iustin Pop
                    pdx = Instance.pNode i
1363 63a78055 Iustin Pop
                    sdx = Instance.sNode i
1364 63a78055 Iustin Pop
                    dt = Instance.diskTemplate i
1365 63a78055 Iustin Pop
                    withSecondary = case dt of
1366 63a78055 Iustin Pop
                                      DTDrbd8 -> IntSet.insert sdx ns
1367 63a78055 Iustin Pop
                                      _ -> ns
1368 63a78055 Iustin Pop
                in case mode of
1369 63a78055 Iustin Pop
                     ChangePrimary   -> IntSet.insert pdx ns
1370 63a78055 Iustin Pop
                     ChangeSecondary -> withSecondary
1371 63a78055 Iustin Pop
                     ChangeAll       -> IntSet.insert pdx withSecondary
1372 63a78055 Iustin Pop
           ) IntSet.empty