hspace.hs 12.5 KB
Newer Older
Iustin Pop's avatar
Iustin Pop committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
{-| Cluster space sizing

-}

{-

Copyright (C) 2009 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Main (main) where

28
import Data.Char (toUpper, isAlphaNum)
Iustin Pop's avatar
Iustin Pop committed
29
30
import Data.List
import Data.Function
31
import Data.Maybe (isJust, fromJust)
Iustin Pop's avatar
Iustin Pop committed
32
import Monad
Iustin Pop's avatar
Iustin Pop committed
33
import System (exitWith, ExitCode(..))
Iustin Pop's avatar
Iustin Pop committed
34
35
36
import System.IO
import qualified System

37
import Text.Printf (printf, hPrintf)
Iustin Pop's avatar
Iustin Pop committed
38
39
40
41
42
43
44

import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance

import Ganeti.HTools.Utils
45
import Ganeti.HTools.Types
46
import Ganeti.HTools.CLI
47
import Ganeti.HTools.ExtLoader
Iustin Pop's avatar
Iustin Pop committed
48
49

-- | Options list and functions
50
options :: [OptType]
Iustin Pop's avatar
Iustin Pop committed
51
options =
52
    [ oPrintNodes
53
    , oDataFile
54
    , oNodeSim
55
56
57
58
59
60
61
62
63
64
65
    , oRapiMaster
    , oLuxiSocket
    , oVerbose
    , oQuiet
    , oOfflineNode
    , oIMem
    , oIDisk
    , oIVcpus
    , oINodes
    , oMaxCpu
    , oMinDisk
66
    , oTieredSpec
67
68
    , oShowVer
    , oShowHelp
Iustin Pop's avatar
Iustin Pop committed
69
70
    ]

71
72
73
74
75
-- | The allocation phase we're in (initial, after tiered allocs, or
-- after regular allocation).
data Phase = PInitial
           | PFinal
           | PTiered
76
77

statsData :: [(String, Cluster.CStats -> String)]
78
79
80
81
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
            , ("INST_CNT", printf "%d" . Cluster.csNinst)
            , ("MEM_FREE", printf "%d" . Cluster.csFmem)
            , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
82
            , ("MEM_RESVD",
83
84
               \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
            , ("MEM_INST", printf "%d" . Cluster.csImem)
85
            , ("MEM_OVERHEAD",
86
               \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
87
            , ("MEM_EFF",
88
89
90
               \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
                                     Cluster.csTmem cs))
            , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
91
            , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
92
            , ("DSK_RESVD",
93
94
               \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
            , ("DSK_INST", printf "%d" . Cluster.csIdsk)
95
            , ("DSK_EFF",
96
97
98
               \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
                                    Cluster.csTdsk cs))
            , ("CPU_INST", printf "%d" . Cluster.csIcpu)
99
            , ("CPU_EFF",
100
101
102
103
               \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
                                     Cluster.csTcpu cs))
            , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
            , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
104
105
            ]

106
107
108
109
specData :: [(String, RSpec -> String)]
specData = [ ("MEM", printf "%d" . rspecMem)
           , ("DSK", printf "%d" . rspecDsk)
           , ("CPU", printf "%d" . rspecCpu)
110
111
112
           ]

clusterData :: [(String, Cluster.CStats -> String)]
113
114
115
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
              , ("DSK", printf "%.0f" . Cluster.csTdsk)
              , ("CPU", printf "%.0f" . Cluster.csTcpu)
116
117
              ]

Iustin Pop's avatar
Iustin Pop committed
118
-- | Recursively place instances on the cluster until we're out of space
Iustin Pop's avatar
Iustin Pop committed
119
120
121
122
iterateDepth :: Node.List
             -> Instance.List
             -> Instance.Instance
             -> Int
123
             -> [Instance.Instance]
124
             -> Result (FailStats, Node.List, [Instance.Instance])
125
126
iterateDepth nl il newinst nreq ixes =
      let depth = length ixes
Iustin Pop's avatar
Iustin Pop committed
127
128
          newname = printf "new-%d" depth::String
          newidx = length (Container.elems il) + depth
Iustin Pop's avatar
Iustin Pop committed
129
          newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
130
131
132
      in case Cluster.tryAlloc nl il newi2 nreq of
           Bad s -> Bad s
           Ok (errs, _, sols3) ->
133
               case sols3 of
134
135
                 [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
                 (_, (xnl, xi, _)):[] ->
136
                     iterateDepth xnl il newinst nreq $! (xi:ixes)
137
138
                 _ -> Bad "Internal error: multiple solutions for single\
                          \ allocation"
Iustin Pop's avatar
Iustin Pop committed
139

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
tieredAlloc :: Node.List
            -> Instance.List
            -> Instance.Instance
            -> Int
            -> [Instance.Instance]
            -> Result (FailStats, Node.List, [Instance.Instance])
tieredAlloc nl il newinst nreq ixes =
    case iterateDepth nl il newinst nreq ixes of
      Bad s -> Bad s
      Ok (errs, nl', ixes') ->
          case Instance.shrinkByType newinst . fst . last $
               sortBy (compare `on` snd) errs of
            Bad _ -> Ok (errs, nl', ixes')
            Ok newinst' ->
                tieredAlloc nl' il newinst' nreq ixes'


Iustin Pop's avatar
Iustin Pop committed
157
-- | Function to print stats for a given phase
158
159
160
161
162
163
printStats :: Phase -> Cluster.CStats -> [(String, String)]
printStats ph cs =
  map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
  where kind = case ph of
                 PInitial -> "INI"
                 PFinal -> "FIN"
164
                 PTiered -> "TRL"
Iustin Pop's avatar
Iustin Pop committed
165

166
167
168
169
170
171
-- | Print final stats and related metrics
printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
printResults fin_nl num_instances allocs sreason = do
  let fin_stats = Cluster.totalResources fin_nl
      fin_instances = num_instances + allocs

172
  when (num_instances + allocs /= Cluster.csNinst fin_stats) $
173
174
175
       do
         hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
                        \ != counted (%d)\n" (num_instances + allocs)
Iustin Pop's avatar
Iustin Pop committed
176
                                 (Cluster.csNinst fin_stats) :: IO ()
177
178
         exitWith $ ExitFailure 1

179
180
181
182
  printKeys $ printStats PFinal fin_stats
  printKeys [ ("ALLOC_USAGE", printf "%.8f"
                                ((fromIntegral num_instances::Double) /
                                 fromIntegral fin_instances))
183
            , ("ALLOC_INSTANCES", printf "%d" allocs)
184
185
186
187
188
189
190
            , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
            ]
  printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
                               printf "%d" y)) sreason
  -- this should be the final entry
  printKeys [("OK", "1")]

191
192
193
194
195
196
-- | Ensure a value is quoted if needed
ensureQuoted :: String -> String
ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
                 then '\'':v ++ "'"
                 else v

197
198
-- | Format a list of key/values as a shell fragment
printKeys :: [(String, String)] -> IO ()
199
200
printKeys = mapM_ (\(k, v) ->
                   printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
201

202
203
204
205
206
207
208
209
210
211
212
printInstance :: Node.List -> Instance.Instance -> [String]
printInstance nl i = [ Instance.name i
                     , (Container.nameOf nl $ Instance.pNode i)
                     , (let sdx = Instance.sNode i
                        in if sdx == Node.noSecondary then ""
                           else Container.nameOf nl sdx)
                     , show (Instance.mem i)
                     , show (Instance.dsk i)
                     , show (Instance.vcpus i)
                     ]

Iustin Pop's avatar
Iustin Pop committed
213
214
215
216
-- | Main function.
main :: IO ()
main = do
  cmd_args <- System.getArgs
217
  (opts, args) <- parseOpts cmd_args "hspace" options
Iustin Pop's avatar
Iustin Pop committed
218
219
220
221
222

  unless (null args) $ do
         hPutStrLn stderr "Error: this program doesn't take any arguments."
         exitWith $ ExitFailure 1

223
  let verbose = optVerbose opts
224
      ispec = optISpec opts
225
      shownodes = optShowNodes opts
226

227
  (fixed_nl, il, _, csf) <- loadExternalData opts
228

229
230
  printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
  printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
231

232
  let num_instances = length $ Container.elems il
Iustin Pop's avatar
Iustin Pop committed
233
234
235
236

  let offline_names = optOffline opts
      all_nodes = Container.elems fixed_nl
      all_names = map Node.name all_nodes
Iustin Pop's avatar
Iustin Pop committed
237
      offline_wrong = filter (flip notElem all_names) offline_names
Iustin Pop's avatar
Iustin Pop committed
238
239
240
      offline_indices = map Node.idx $
                        filter (\n -> elem (Node.name n) offline_names)
                               all_nodes
241
      req_nodes = optINodes opts
242
243
      m_cpu = optMcpu opts
      m_dsk = optMdsk opts
Iustin Pop's avatar
Iustin Pop committed
244
245

  when (length offline_wrong > 0) $ do
246
         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
Iustin Pop's avatar
Iustin Pop committed
247
                     (commaJoin offline_wrong) :: IO ()
Iustin Pop's avatar
Iustin Pop committed
248
249
         exitWith $ ExitFailure 1

250
  when (req_nodes /= 1 && req_nodes /= 2) $ do
Iustin Pop's avatar
Iustin Pop committed
251
252
         hPrintf stderr "Error: Invalid required nodes (%d)\n"
                                            req_nodes :: IO ()
253
254
         exitWith $ ExitFailure 1

255
  let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
Iustin Pop's avatar
Iustin Pop committed
256
257
                                then Node.setOffline n True
                                else n) fixed_nl
258
259
      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
           nm
Iustin Pop's avatar
Iustin Pop committed
260

Iustin Pop's avatar
Iustin Pop committed
261
  when (length csf > 0 && verbose > 1) $
262
       hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
Iustin Pop's avatar
Iustin Pop committed
263

264
  when (isJust shownodes) $
Iustin Pop's avatar
Iustin Pop committed
265
       do
266
         hPutStrLn stderr "Initial cluster status:"
267
         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
Iustin Pop's avatar
Iustin Pop committed
268
269

  let ini_cv = Cluster.compCV nl
Iustin Pop's avatar
Iustin Pop committed
270
      ini_stats = Cluster.totalResources nl
Iustin Pop's avatar
Iustin Pop committed
271

Iustin Pop's avatar
Iustin Pop committed
272
  when (verbose > 2) $
273
274
         hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
                 ini_cv (Cluster.printStats nl)
275

276
277
278
  printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
  printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
  printKeys $ printStats PInitial ini_stats
Iustin Pop's avatar
Iustin Pop committed
279

280
281
282
283
284
285
286
  let bad_nodes = fst $ Cluster.computeBadItems nl il
  when (length bad_nodes > 0) $ do
         -- This is failn1 case, so we print the same final stats and
         -- exit early
         printResults nl num_instances 0 [(FailN1, 1)]
         exitWith ExitSuccess

287
288
  -- utility functions
  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
Iustin Pop's avatar
Iustin Pop committed
289
                    (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
290
291
      exitifbad val = (case val of
                         Bad s -> do
Iustin Pop's avatar
Iustin Pop committed
292
                           hPrintf stderr "Failure: %s\n" s :: IO ()
293
294
295
296
297
298
299
300
301
302
303
304
305
306
                           exitWith $ ExitFailure 1
                         Ok x -> return x)


  let reqinst = iofspec ispec

  -- Run the tiered allocation, if enabled

  (case optTieredSpec opts of
     Nothing -> return ()
     Just tspec -> do
       let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
       (_, trl_nl, trl_ixes) <- exitifbad tresu
       let fin_trl_ixes = reverse trl_ixes
307
308
309
           ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
           spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
                      ix_byspec::[(RSpec, Int)]
310
311
312
313
           spec_map' = map (\(spec, cnt) ->
                                printf "%d,%d,%d=%d" (rspecMem spec)
                                       (rspecDsk spec) (rspecCpu spec) cnt)
                       spec_map::[String]
314
315
316
317
318
319

       when (verbose > 1) $ do
         hPutStrLn stderr "Tiered allocation map"
         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
                 formatTable (map (printInstance trl_nl) fin_trl_ixes)
                                 [False, False, False, True, True, True]
320

321
       when (isJust shownodes) $ do
322
323
         hPutStrLn stderr ""
         hPutStrLn stderr "Tiered allocation status:"
324
         hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
325

326
327
       printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
       printKeys [("TSPEC", intercalate " " spec_map')])
328
329

  -- Run the standard (avg-mode) allocation
Iustin Pop's avatar
Iustin Pop committed
330

331
  let result = iterateDepth nl il reqinst req_nodes []
332
333
  (ereason, fin_nl, ixes) <- exitifbad result

334
  let allocs = length ixes
335
      fin_ixes = reverse ixes
336
      sreason = reverse $ sortBy (compare `on` snd) ereason
337

338
339
340
341
342
  when (verbose > 1) $ do
         hPutStrLn stderr "Instance map"
         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
                 formatTable (map (printInstance fin_nl) fin_ixes)
                                 [False, False, False, True, True, True]
343
  when (isJust shownodes) $
Iustin Pop's avatar
Iustin Pop committed
344
       do
345
346
         hPutStrLn stderr ""
         hPutStrLn stderr "Final cluster status:"
347
         hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
348
349

  printResults fin_nl num_instances allocs sreason