Statistics
| Branch: | Tag: | Revision:

root / htools / hbal.hs @ 00152519

History | View | Annotate | Download (15.4 kB)

1 525bfb36 Iustin Pop
{-| Cluster rebalancer.
2 e4f08c46 Iustin Pop
3 e4f08c46 Iustin Pop
-}
4 e4f08c46 Iustin Pop
5 e2fa2baf Iustin Pop
{-
6 e2fa2baf Iustin Pop
7 d5072e4c Iustin Pop
Copyright (C) 2009, 2010, 2011 Google Inc.
8 e2fa2baf Iustin Pop
9 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
10 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
11 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 e2fa2baf Iustin Pop
(at your option) any later version.
13 e2fa2baf Iustin Pop
14 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
15 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 e2fa2baf Iustin Pop
General Public License for more details.
18 e2fa2baf Iustin Pop
19 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
20 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
21 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 e2fa2baf Iustin Pop
02110-1301, USA.
23 e2fa2baf Iustin Pop
24 e2fa2baf Iustin Pop
-}
25 e2fa2baf Iustin Pop
26 e4f08c46 Iustin Pop
module Main (main) where
27 e4f08c46 Iustin Pop
28 b2245847 Iustin Pop
import Control.Concurrent (threadDelay)
29 b2245847 Iustin Pop
import Control.Exception (bracket)
30 cc532bdd Iustin Pop
import Control.Monad
31 e4f08c46 Iustin Pop
import Data.List
32 646aa028 Iustin Pop
import Data.Maybe (isJust, isNothing, fromJust)
33 03cb89f0 Iustin Pop
import Data.IORef
34 0903280b Iustin Pop
import System (exitWith, ExitCode(..))
35 e4f08c46 Iustin Pop
import System.IO
36 03cb89f0 Iustin Pop
import System.Posix.Process
37 03cb89f0 Iustin Pop
import System.Posix.Signals
38 e4f08c46 Iustin Pop
import qualified System
39 e4f08c46 Iustin Pop
40 2795466b Iustin Pop
import Text.Printf (printf, hPrintf)
41 e4f08c46 Iustin Pop
42 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Container as Container
43 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Cluster as Cluster
44 10ef6b4e Iustin Pop
import qualified Ganeti.HTools.Group as Group
45 ec18dca9 Iustin Pop
import qualified Ganeti.HTools.Node as Node
46 b2245847 Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
47 040afc35 Iustin Pop
48 0427285d Iustin Pop
import Ganeti.HTools.CLI
49 e8f89bb6 Iustin Pop
import Ganeti.HTools.ExtLoader
50 669d7e3d Iustin Pop
import Ganeti.HTools.Utils
51 0e8ae201 Iustin Pop
import Ganeti.HTools.Types
52 017a0c3d Iustin Pop
import Ganeti.HTools.Loader (ClusterData(..))
53 e4f08c46 Iustin Pop
54 b2245847 Iustin Pop
import qualified Ganeti.Luxi as L
55 b2245847 Iustin Pop
import Ganeti.Jobs
56 b2245847 Iustin Pop
57 e4f08c46 Iustin Pop
-- | Options list and functions
58 0427285d Iustin Pop
options :: [OptType]
59 e4f08c46 Iustin Pop
options =
60 0427285d Iustin Pop
    [ oPrintNodes
61 507fda3f Iustin Pop
    , oPrintInsts
62 0427285d Iustin Pop
    , oPrintCommands
63 0427285d Iustin Pop
    , oOneline
64 16c2369c Iustin Pop
    , oDataFile
65 2e28ac32 Iustin Pop
    , oEvacMode
66 0427285d Iustin Pop
    , oRapiMaster
67 0427285d Iustin Pop
    , oLuxiSocket
68 b2245847 Iustin Pop
    , oExecJobs
69 646aa028 Iustin Pop
    , oGroup
70 0427285d Iustin Pop
    , oMaxSolLength
71 0427285d Iustin Pop
    , oVerbose
72 0427285d Iustin Pop
    , oQuiet
73 0427285d Iustin Pop
    , oOfflineNode
74 0427285d Iustin Pop
    , oMinScore
75 0427285d Iustin Pop
    , oMaxCpu
76 0427285d Iustin Pop
    , oMinDisk
77 848b65c9 Iustin Pop
    , oMinGain
78 848b65c9 Iustin Pop
    , oMinGainLim
79 c0501c69 Iustin Pop
    , oDiskMoves
80 ddef0585 Guido Trotter
    , oSelInst
81 e7f7c003 Guido Trotter
    , oInstMoves
82 aa8d2e71 Iustin Pop
    , oDynuFile
83 0f15cc76 Iustin Pop
    , oExTags
84 fcbf0da4 Iustin Pop
    , oExInst
85 748654f7 Iustin Pop
    , oSaveCluster
86 0427285d Iustin Pop
    , oShowVer
87 0427285d Iustin Pop
    , oShowHelp
88 7ef4d93e Iustin Pop
    ]
89 e4f08c46 Iustin Pop
90 6dc960bc Iustin Pop
{- | Start computing the solution at the given depth and recurse until
91 6dc960bc Iustin Pop
we find a valid solution or we exceed the maximum depth.
92 6dc960bc Iustin Pop
93 6dc960bc Iustin Pop
-}
94 6dc960bc Iustin Pop
iterateDepth :: Cluster.Table    -- ^ The starting table
95 6dc960bc Iustin Pop
             -> Int              -- ^ Remaining length
96 c0501c69 Iustin Pop
             -> Bool             -- ^ Allow disk moves
97 e7f7c003 Guido Trotter
             -> Bool             -- ^ Allow instance moves
98 6dc960bc Iustin Pop
             -> Int              -- ^ Max node name len
99 6dc960bc Iustin Pop
             -> Int              -- ^ Max instance name len
100 0e8ae201 Iustin Pop
             -> [MoveJob]        -- ^ Current command list
101 24acc2c6 Guido Trotter
             -> Bool             -- ^ Whether to be silent
102 92e32d76 Iustin Pop
             -> Score            -- ^ Score at which to stop
103 848b65c9 Iustin Pop
             -> Score            -- ^ Min gain limit
104 848b65c9 Iustin Pop
             -> Score            -- ^ Min score gain
105 2e28ac32 Iustin Pop
             -> Bool             -- ^ Enable evacuation mode
106 0e8ae201 Iustin Pop
             -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
107 0e8ae201 Iustin Pop
                                              -- and commands
108 e7f7c003 Guido Trotter
iterateDepth ini_tbl max_rounds disk_moves inst_moves nmlen imlen
109 848b65c9 Iustin Pop
             cmd_strs oneline min_score mg_limit min_gain evac_mode =
110 f25e5aac Iustin Pop
    let Cluster.Table ini_nl ini_il _ _ = ini_tbl
111 5ad86777 Iustin Pop
        allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
112 5ad86777 Iustin Pop
        m_fin_tbl = if allowed_next
113 e08424a8 Guido Trotter
                    then Cluster.tryBalance ini_tbl disk_moves inst_moves
114 e08424a8 Guido Trotter
                         evac_mode mg_limit min_gain
115 5ad86777 Iustin Pop
                    else Nothing
116 6dc960bc Iustin Pop
    in
117 f25e5aac Iustin Pop
      case m_fin_tbl of
118 f25e5aac Iustin Pop
        Just fin_tbl ->
119 f25e5aac Iustin Pop
            do
120 f25e5aac Iustin Pop
              let
121 f25e5aac Iustin Pop
                  (Cluster.Table _ _ _ fin_plc) = fin_tbl
122 f25e5aac Iustin Pop
                  fin_plc_len = length fin_plc
123 924f9c16 Iustin Pop
                  cur_plc@(idx, _, _, move, _) = head fin_plc
124 f25e5aac Iustin Pop
                  (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
125 0e8ae201 Iustin Pop
                                     nmlen imlen cur_plc fin_plc_len
126 0e8ae201 Iustin Pop
                  afn = Cluster.involvedNodes ini_il cur_plc
127 924f9c16 Iustin Pop
                  upd_cmd_strs = (afn, idx, move, cmds):cmd_strs
128 f25e5aac Iustin Pop
              unless oneline $ do
129 f25e5aac Iustin Pop
                       putStrLn sol_line
130 f25e5aac Iustin Pop
                       hFlush stdout
131 e7f7c003 Guido Trotter
              iterateDepth fin_tbl max_rounds disk_moves inst_moves
132 f25e5aac Iustin Pop
                           nmlen imlen upd_cmd_strs oneline min_score
133 848b65c9 Iustin Pop
                           mg_limit min_gain evac_mode
134 f25e5aac Iustin Pop
        Nothing -> return (ini_tbl, cmd_strs)
135 6dc960bc Iustin Pop
136 ba6c6006 Iustin Pop
-- | Formats the solution for the oneline display
137 ba6c6006 Iustin Pop
formatOneline :: Double -> Int -> Double -> String
138 ba6c6006 Iustin Pop
formatOneline ini_cv plc_len fin_cv =
139 ba6c6006 Iustin Pop
    printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
140 9f6dcdea Iustin Pop
               (if fin_cv == 0 then 1 else ini_cv / fin_cv)
141 ba6c6006 Iustin Pop
142 b2245847 Iustin Pop
-- | Polls a set of jobs at a fixed interval until all are finished
143 b2245847 Iustin Pop
-- one way or another
144 b2245847 Iustin Pop
waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
145 b2245847 Iustin Pop
waitForJobs client jids = do
146 b2245847 Iustin Pop
  sts <- L.queryJobsStatus client jids
147 b2245847 Iustin Pop
  case sts of
148 b2245847 Iustin Pop
    Bad x -> return $ Bad x
149 7e98f782 Iustin Pop
    Ok s -> if any (<= JOB_STATUS_RUNNING) s
150 b2245847 Iustin Pop
            then do
151 b2245847 Iustin Pop
              -- TODO: replace hardcoded value with a better thing
152 b2245847 Iustin Pop
              threadDelay (1000000 * 15)
153 b2245847 Iustin Pop
              waitForJobs client jids
154 b2245847 Iustin Pop
            else return $ Ok s
155 b2245847 Iustin Pop
156 b2245847 Iustin Pop
-- | Check that a set of job statuses is all success
157 b2245847 Iustin Pop
checkJobsStatus :: [JobStatus] -> Bool
158 7e98f782 Iustin Pop
checkJobsStatus = all (== JOB_STATUS_SUCCESS)
159 b2245847 Iustin Pop
160 23448f82 Iustin Pop
-- | Wrapper over execJobSet checking for early termination
161 23448f82 Iustin Pop
execWrapper :: String -> Node.List
162 23448f82 Iustin Pop
           -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
163 23448f82 Iustin Pop
execWrapper _      _  _  _    [] = return True
164 23448f82 Iustin Pop
execWrapper master nl il cref alljss = do
165 23448f82 Iustin Pop
  cancel <- readIORef cref
166 23448f82 Iustin Pop
  (if cancel > 0
167 23448f82 Iustin Pop
   then do
168 23448f82 Iustin Pop
     hPrintf stderr "Exiting early due to user request, %d\
169 23448f82 Iustin Pop
                    \ jobset(s) remaining." (length alljss)::IO ()
170 23448f82 Iustin Pop
     return False
171 23448f82 Iustin Pop
   else execJobSet master nl il cref alljss)
172 23448f82 Iustin Pop
173 b2245847 Iustin Pop
-- | Execute an entire jobset
174 3e4480e0 Iustin Pop
execJobSet :: String -> Node.List
175 23448f82 Iustin Pop
           -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
176 23448f82 Iustin Pop
execJobSet _      _  _  _    [] = return True
177 23448f82 Iustin Pop
execJobSet master nl il cref (js:jss) = do
178 b2245847 Iustin Pop
  -- map from jobset (htools list of positions) to [[opcodes]]
179 b2245847 Iustin Pop
  let jobs = map (\(_, idx, move, _) ->
180 3e4480e0 Iustin Pop
                      Cluster.iMoveToJob nl il idx move) js
181 b2245847 Iustin Pop
  let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
182 b2245847 Iustin Pop
  putStrLn $ "Executing jobset for instances " ++ commaJoin descr
183 b2245847 Iustin Pop
  jrs <- bracket (L.getClient master) L.closeClient
184 b2245847 Iustin Pop
         (\client -> do
185 683b1ca7 Iustin Pop
            jids <- L.submitManyJobs client jobs
186 b2245847 Iustin Pop
            case jids of
187 b2245847 Iustin Pop
              Bad x -> return $ Bad x
188 b2245847 Iustin Pop
              Ok x -> do
189 b2245847 Iustin Pop
                putStrLn $ "Got job IDs " ++ commaJoin x
190 b2245847 Iustin Pop
                waitForJobs client x
191 b2245847 Iustin Pop
         )
192 b2245847 Iustin Pop
  (case jrs of
193 b2245847 Iustin Pop
     Bad x -> do
194 b2245847 Iustin Pop
       hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
195 23448f82 Iustin Pop
       return False
196 b2245847 Iustin Pop
     Ok x -> if checkJobsStatus x
197 23448f82 Iustin Pop
             then execWrapper master nl il cref jss
198 b2245847 Iustin Pop
             else do
199 b2245847 Iustin Pop
               hPutStrLn stderr $ "Not all jobs completed successfully: " ++
200 b2245847 Iustin Pop
                         show x
201 23448f82 Iustin Pop
               hPutStrLn stderr "Aborting."
202 23448f82 Iustin Pop
               return False)
203 b2245847 Iustin Pop
204 543e859d Iustin Pop
-- | Signal handler for graceful termination
205 543e859d Iustin Pop
hangleSigInt :: IORef Int -> IO ()
206 543e859d Iustin Pop
hangleSigInt cref = do
207 543e859d Iustin Pop
  writeIORef cref 1
208 543e859d Iustin Pop
  putStrLn ("Cancel request registered, will exit at" ++
209 543e859d Iustin Pop
            " the end of the current job set...")
210 543e859d Iustin Pop
211 543e859d Iustin Pop
-- | Signal handler for immediate termination
212 543e859d Iustin Pop
hangleSigTerm :: IORef Int -> IO ()
213 543e859d Iustin Pop
hangleSigTerm cref = do
214 543e859d Iustin Pop
  -- update the cref to 2, just for consistency
215 543e859d Iustin Pop
  writeIORef cref 2
216 543e859d Iustin Pop
  putStrLn "Double cancel request, exiting now..."
217 543e859d Iustin Pop
  exitImmediately $ ExitFailure 2
218 03cb89f0 Iustin Pop
219 23448f82 Iustin Pop
runJobSet :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool
220 03cb89f0 Iustin Pop
runJobSet master fin_nl il cmd_jobs = do
221 03cb89f0 Iustin Pop
  cref <- newIORef 0
222 543e859d Iustin Pop
  mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing)
223 543e859d Iustin Pop
    [(hangleSigTerm, softwareTermination), (hangleSigInt, keyboardSignal)]
224 23448f82 Iustin Pop
  execWrapper master fin_nl il cref cmd_jobs
225 03cb89f0 Iustin Pop
226 e4f08c46 Iustin Pop
-- | Main function.
227 e4f08c46 Iustin Pop
main :: IO ()
228 e4f08c46 Iustin Pop
main = do
229 e4f08c46 Iustin Pop
  cmd_args <- System.getArgs
230 0427285d Iustin Pop
  (opts, args) <- parseOpts cmd_args "hbal" options
231 45f01962 Iustin Pop
232 45f01962 Iustin Pop
  unless (null args) $ do
233 45f01962 Iustin Pop
         hPutStrLn stderr "Error: this program doesn't take any arguments."
234 45f01962 Iustin Pop
         exitWith $ ExitFailure 1
235 a30b2f5b Iustin Pop
236 fae371cc Iustin Pop
  let oneline = optOneline opts
237 7eff5b09 Iustin Pop
      verbose = optVerbose opts
238 e98fb766 Iustin Pop
      shownodes = optShowNodes opts
239 33e44f0c Iustin Pop
      showinsts = optShowInsts opts
240 fae371cc Iustin Pop
241 4188449c Iustin Pop
  ini_cdata@(ClusterData gl fixed_nl ilf ctags) <- loadExternalData opts
242 ec18dca9 Iustin Pop
243 ec18dca9 Iustin Pop
  let offline_names = optOffline opts
244 db1bcfe8 Iustin Pop
      all_nodes = Container.elems fixed_nl
245 c854092b Iustin Pop
      all_names = concatMap allNames all_nodes
246 5182e970 Iustin Pop
      offline_wrong = filter (`notElem` all_names) offline_names
247 db1bcfe8 Iustin Pop
      offline_indices = map Node.idx $
248 f9acea10 Iustin Pop
                        filter (\n ->
249 f9acea10 Iustin Pop
                                 Node.name n `elem` offline_names ||
250 f9acea10 Iustin Pop
                                 Node.alias n `elem` offline_names)
251 db1bcfe8 Iustin Pop
                               all_nodes
252 66d67ad4 Iustin Pop
      m_cpu = optMcpu opts
253 66d67ad4 Iustin Pop
      m_dsk = optMdsk opts
254 646aa028 Iustin Pop
      csf = commonSuffix fixed_nl ilf
255 ec18dca9 Iustin Pop
256 3d7cd10b Iustin Pop
  when (length offline_wrong > 0) $ do
257 2795466b Iustin Pop
         hPrintf stderr "Wrong node name(s) set as offline: %s\n"
258 c939b58e Iustin Pop
                     (commaJoin offline_wrong) :: IO ()
259 3d7cd10b Iustin Pop
         exitWith $ ExitFailure 1
260 3d7cd10b Iustin Pop
261 5182e970 Iustin Pop
  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
262 ec18dca9 Iustin Pop
                                then Node.setOffline n True
263 a1c6212e Iustin Pop
                                else n) fixed_nl
264 646aa028 Iustin Pop
      nlf = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
265 646aa028 Iustin Pop
            nm
266 a30b2f5b Iustin Pop
267 ea017cbc Iustin Pop
  when (not oneline && verbose > 1) $
268 ea017cbc Iustin Pop
       putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags
269 ea017cbc Iustin Pop
270 646aa028 Iustin Pop
  when (Container.size ilf == 0) $ do
271 926c35b1 Iustin Pop
         (if oneline then putStrLn $ formatOneline 0 0 0
272 926c35b1 Iustin Pop
          else printf "Cluster is empty, exiting.\n")
273 dcbcdb58 Iustin Pop
         exitWith ExitSuccess
274 dcbcdb58 Iustin Pop
275 646aa028 Iustin Pop
  let split_insts = Cluster.findSplitInstances nlf ilf
276 646aa028 Iustin Pop
  when (not . null $ split_insts) $ do
277 646aa028 Iustin Pop
    hPutStrLn stderr "Found instances belonging to multiple node groups:"
278 646aa028 Iustin Pop
    mapM_ (\i -> hPutStrLn stderr $ "  " ++ Instance.name i) split_insts
279 646aa028 Iustin Pop
    hPutStrLn stderr "Aborting."
280 646aa028 Iustin Pop
    exitWith $ ExitFailure 1
281 646aa028 Iustin Pop
282 646aa028 Iustin Pop
  let ngroups = Cluster.splitCluster nlf ilf
283 646aa028 Iustin Pop
  when (length ngroups > 1 && isNothing (optGroup opts)) $ do
284 646aa028 Iustin Pop
    hPutStrLn stderr "Found multiple node groups:"
285 e0c85e08 Iustin Pop
    mapM_ (hPutStrLn stderr . ("  " ++) . Group.name .
286 d5072e4c Iustin Pop
           flip Container.find gl . fst) ngroups
287 646aa028 Iustin Pop
    hPutStrLn stderr "Aborting."
288 646aa028 Iustin Pop
    exitWith $ ExitFailure 1
289 646aa028 Iustin Pop
290 4188449c Iustin Pop
  maybeSaveData (optSaveCluster opts) "original" "before balancing" ini_cdata
291 4188449c Iustin Pop
292 27f96567 Iustin Pop
  unless oneline $ printf "Loaded %d nodes, %d instances\n"
293 646aa028 Iustin Pop
             (Container.size nlf)
294 646aa028 Iustin Pop
             (Container.size ilf)
295 646aa028 Iustin Pop
296 10ef6b4e Iustin Pop
  (gname, (nl, il)) <- case optGroup opts of
297 10ef6b4e Iustin Pop
    Nothing -> do
298 10ef6b4e Iustin Pop
         let (gidx, cdata) = head ngroups
299 10ef6b4e Iustin Pop
             grp = Container.find gidx gl
300 10ef6b4e Iustin Pop
         return (Group.name grp, cdata)
301 10ef6b4e Iustin Pop
    Just g -> case Container.findByName gl g of
302 646aa028 Iustin Pop
      Nothing -> do
303 646aa028 Iustin Pop
        hPutStrLn stderr $ "Node group " ++ g ++
304 646aa028 Iustin Pop
          " not found. Node group list is:"
305 10ef6b4e Iustin Pop
        mapM_ (hPutStrLn stderr . ("  " ++) . Group.name ) (Container.elems gl)
306 646aa028 Iustin Pop
        hPutStrLn stderr "Aborting."
307 646aa028 Iustin Pop
        exitWith $ ExitFailure 1
308 10ef6b4e Iustin Pop
      Just grp ->
309 10ef6b4e Iustin Pop
          case lookup (Group.idx grp) ngroups of
310 10ef6b4e Iustin Pop
            Nothing -> do
311 10ef6b4e Iustin Pop
              -- TODO: while this is unlikely to happen, log here the
312 10ef6b4e Iustin Pop
              -- actual group data to help debugging
313 d5072e4c Iustin Pop
              hPutStrLn stderr "Internal failure, missing group idx"
314 10ef6b4e Iustin Pop
              exitWith $ ExitFailure 1
315 10ef6b4e Iustin Pop
            Just cdata -> return (Group.name grp, cdata)
316 646aa028 Iustin Pop
317 646aa028 Iustin Pop
  unless oneline $ printf "Group size %d nodes, %d instances\n"
318 e4f08c46 Iustin Pop
             (Container.size nl)
319 e4f08c46 Iustin Pop
             (Container.size il)
320 a0529a64 Iustin Pop
321 10ef6b4e Iustin Pop
  putStrLn $ "Selected node group: " ++ gname
322 646aa028 Iustin Pop
323 9f6dcdea Iustin Pop
  when (length csf > 0 && not oneline && verbose > 1) $
324 9f6dcdea Iustin Pop
       printf "Note: Stripping common suffix of '%s' from names\n" csf
325 a0529a64 Iustin Pop
326 e4f08c46 Iustin Pop
  let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
327 7eff5b09 Iustin Pop
  unless (oneline || verbose == 0) $ printf
328 27f96567 Iustin Pop
             "Initial check done: %d bad nodes, %d bad instances.\n"
329 e4f08c46 Iustin Pop
             (length bad_nodes) (length bad_instances)
330 e4f08c46 Iustin Pop
331 9f6dcdea Iustin Pop
  when (length bad_nodes > 0) $
332 289c3835 Iustin Pop
         putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
333 289c3835 Iustin Pop
                  \that the cluster will end N+1 happy."
334 e4f08c46 Iustin Pop
335 33e44f0c Iustin Pop
  maybePrintInsts showinsts "Initial" (Cluster.printInsts nl il)
336 507fda3f Iustin Pop
337 417f6b50 Iustin Pop
  maybePrintNodes shownodes "Initial cluster" (Cluster.printNodes nl)
338 e4f08c46 Iustin Pop
339 e4f08c46 Iustin Pop
  let ini_cv = Cluster.compCV nl
340 e4f08c46 Iustin Pop
      ini_tbl = Cluster.Table nl il ini_cv []
341 b0517d61 Iustin Pop
      min_cv = optMinScore opts
342 b0517d61 Iustin Pop
343 b0517d61 Iustin Pop
  when (ini_cv < min_cv) $ do
344 b0517d61 Iustin Pop
         (if oneline then
345 ba6c6006 Iustin Pop
              putStrLn $ formatOneline ini_cv 0 ini_cv
346 b0517d61 Iustin Pop
          else printf "Cluster is already well balanced (initial score %.6g,\n\
347 b0517d61 Iustin Pop
                      \minimum score %.6g).\nNothing to do, exiting\n"
348 b0517d61 Iustin Pop
                      ini_cv min_cv)
349 b0517d61 Iustin Pop
         exitWith ExitSuccess
350 b0517d61 Iustin Pop
351 d09b6ed3 Iustin Pop
  unless oneline (if verbose > 2 then
352 7eff5b09 Iustin Pop
                      printf "Initial coefficients: overall %.8f, %s\n"
353 7eff5b09 Iustin Pop
                      ini_cv (Cluster.printStats nl)
354 7eff5b09 Iustin Pop
                  else
355 7eff5b09 Iustin Pop
                      printf "Initial score: %.8f\n" ini_cv)
356 e4f08c46 Iustin Pop
357 27f96567 Iustin Pop
  unless oneline $ putStrLn "Trying to minimize the CV..."
358 14c972c7 Iustin Pop
  let imlen = maximum . map (length . Instance.alias) $ Container.elems il
359 14c972c7 Iustin Pop
      nmlen = maximum . map (length . Node.alias) $ Container.elems nl
360 7dfaafb1 Iustin Pop
361 7dfaafb1 Iustin Pop
  (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
362 c0501c69 Iustin Pop
                         (optDiskMoves opts)
363 e7f7c003 Guido Trotter
                         (optInstMoves opts)
364 848b65c9 Iustin Pop
                         nmlen imlen [] oneline min_cv
365 848b65c9 Iustin Pop
                         (optMinGainLim opts) (optMinGain opts)
366 848b65c9 Iustin Pop
                         (optEvacMode opts)
367 507fda3f Iustin Pop
  let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
368 e4f08c46 Iustin Pop
      ord_plc = reverse fin_plc
369 cc532bdd Iustin Pop
      sol_msg = case () of
370 cc532bdd Iustin Pop
                  _ | null fin_plc -> printf "No solution found\n"
371 cc532bdd Iustin Pop
                    | verbose > 2 ->
372 cc532bdd Iustin Pop
                        printf "Final coefficients:   overall %.8f, %s\n"
373 cc532bdd Iustin Pop
                        fin_cv (Cluster.printStats fin_nl)
374 cc532bdd Iustin Pop
                    | otherwise ->
375 cc532bdd Iustin Pop
                        printf "Cluster score improved from %.8f to %.8f\n"
376 cc532bdd Iustin Pop
                        ini_cv fin_cv ::String
377 e4f08c46 Iustin Pop
378 7eff5b09 Iustin Pop
  unless oneline $ putStr sol_msg
379 7eff5b09 Iustin Pop
380 7eff5b09 Iustin Pop
  unless (oneline || verbose == 0) $
381 7eff5b09 Iustin Pop
         printf "Solution length=%d\n" (length ord_plc)
382 e4f08c46 Iustin Pop
383 b2245847 Iustin Pop
  let cmd_jobs = Cluster.splitJobs cmd_strs
384 b2245847 Iustin Pop
      cmd_data = Cluster.formatCmds cmd_jobs
385 e0eb63f0 Iustin Pop
386 e0eb63f0 Iustin Pop
  when (isJust $ optShowCmds opts) $
387 e4f08c46 Iustin Pop
       do
388 e0eb63f0 Iustin Pop
         let out_path = fromJust $ optShowCmds opts
389 e4f08c46 Iustin Pop
         putStrLn ""
390 e0eb63f0 Iustin Pop
         (if out_path == "-" then
391 e0eb63f0 Iustin Pop
              printf "Commands to run to reach the above solution:\n%s"
392 e0eb63f0 Iustin Pop
                     (unlines . map ("  " ++) .
393 0e8ae201 Iustin Pop
                      filter (/= "  check") .
394 e0eb63f0 Iustin Pop
                      lines $ cmd_data)
395 e0eb63f0 Iustin Pop
          else do
396 0427285d Iustin Pop
            writeFile out_path (shTemplate ++ cmd_data)
397 e0eb63f0 Iustin Pop
            printf "The commands have been written to file '%s'\n" out_path)
398 e0eb63f0 Iustin Pop
399 4188449c Iustin Pop
  maybeSaveData (optSaveCluster opts) "balanced" "after balancing"
400 4188449c Iustin Pop
                (ClusterData gl fin_nl fin_il ctags)
401 b2245847 Iustin Pop
402 33e44f0c Iustin Pop
  maybePrintInsts showinsts "Final" (Cluster.printInsts fin_nl fin_il)
403 507fda3f Iustin Pop
404 417f6b50 Iustin Pop
  maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)
405 417f6b50 Iustin Pop
406 417f6b50 Iustin Pop
  when (verbose > 3) $ do
407 1a7eff0e Iustin Pop
         let ini_cs = Cluster.totalResources nl
408 1a7eff0e Iustin Pop
             fin_cs = Cluster.totalResources fin_nl
409 417f6b50 Iustin Pop
         printf "Original: mem=%d disk=%d\n"
410 417f6b50 Iustin Pop
                    (Cluster.csFmem ini_cs) (Cluster.csFdsk ini_cs) :: IO ()
411 417f6b50 Iustin Pop
         printf "Final:    mem=%d disk=%d\n"
412 417f6b50 Iustin Pop
                    (Cluster.csFmem fin_cs) (Cluster.csFdsk fin_cs)
413 ba6c6006 Iustin Pop
  when oneline $
414 ba6c6006 Iustin Pop
         putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv
415 748654f7 Iustin Pop
416 23448f82 Iustin Pop
  eval <-
417 23448f82 Iustin Pop
      if optExecJobs opts && not (null ord_plc)
418 23448f82 Iustin Pop
      then (case optLuxi opts of
419 748654f7 Iustin Pop
              Nothing -> do
420 748654f7 Iustin Pop
                hPutStrLn stderr "Execution of commands possible only on LUXI"
421 23448f82 Iustin Pop
                return False
422 03cb89f0 Iustin Pop
              Just master -> runJobSet master fin_nl il cmd_jobs)
423 23448f82 Iustin Pop
      else return True
424 d5072e4c Iustin Pop
  unless eval (exitWith (ExitFailure 1))