Statistics
| Branch: | Tag: | Revision:

root / hspace.hs @ f9acea10

History | View | Annotate | Download (11.9 kB)

1
{-| Cluster space sizing
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009 Google Inc.
8

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

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

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

    
24
-}
25

    
26
module Main (main) where
27

    
28
import Data.Char (toUpper, isAlphaNum)
29
import Data.List
30
import Data.Function
31
import Data.Maybe (isJust, fromJust)
32
import Data.Ord (comparing)
33
import Monad
34
import System (exitWith, ExitCode(..))
35
import System.IO
36
import qualified System
37

    
38
import Text.Printf (printf, hPrintf)
39

    
40
import qualified Ganeti.HTools.Container as Container
41
import qualified Ganeti.HTools.Cluster as Cluster
42
import qualified Ganeti.HTools.Node as Node
43
import qualified Ganeti.HTools.Instance as Instance
44

    
45
import Ganeti.HTools.Utils
46
import Ganeti.HTools.Types
47
import Ganeti.HTools.CLI
48
import Ganeti.HTools.ExtLoader
49

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

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

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

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

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

    
120
-- | Function to print stats for a given phase
121
printStats :: Phase -> Cluster.CStats -> [(String, String)]
122
printStats ph cs =
123
  map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
124
  where kind = case ph of
125
                 PInitial -> "INI"
126
                 PFinal -> "FIN"
127
                 PTiered -> "TRL"
128

    
129
-- | Print final stats and related metrics
130
printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
131
printResults fin_nl num_instances allocs sreason = do
132
  let fin_stats = Cluster.totalResources fin_nl
133
      fin_instances = num_instances + allocs
134

    
135
  when (num_instances + allocs /= Cluster.csNinst fin_stats) $
136
       do
137
         hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
138
                        \ != counted (%d)\n" (num_instances + allocs)
139
                                 (Cluster.csNinst fin_stats) :: IO ()
140
         exitWith $ ExitFailure 1
141

    
142
  printKeys $ printStats PFinal fin_stats
143
  printKeys [ ("ALLOC_USAGE", printf "%.8f"
144
                                ((fromIntegral num_instances::Double) /
145
                                 fromIntegral fin_instances))
146
            , ("ALLOC_INSTANCES", printf "%d" allocs)
147
            , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
148
            ]
149
  printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
150
                               printf "%d" y)) sreason
151
  -- this should be the final entry
152
  printKeys [("OK", "1")]
153

    
154
formatRSpec :: String -> RSpec -> [(String, String)]
155
formatRSpec s r =
156
    [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
157
    , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
158
    , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
159
    ]
160

    
161
printAllocationStats :: Node.List -> Node.List -> IO ()
162
printAllocationStats ini_nl fin_nl = do
163
  let ini_stats = Cluster.totalResources ini_nl
164
      fin_stats = Cluster.totalResources fin_nl
165
      (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
166
  printKeys $ formatRSpec "USED" rini
167
  printKeys $ formatRSpec "POOL" ralo
168
  printKeys $ formatRSpec "UNAV" runa
169

    
170
-- | Ensure a value is quoted if needed
171
ensureQuoted :: String -> String
172
ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
173
                 then '\'':v ++ "'"
174
                 else v
175

    
176
-- | Format a list of key\/values as a shell fragment
177
printKeys :: [(String, String)] -> IO ()
178
printKeys = mapM_ (\(k, v) ->
179
                   printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
180

    
181
printInstance :: Node.List -> Instance.Instance -> [String]
182
printInstance nl i = [ Instance.name i
183
                     , Container.nameOf nl $ Instance.pNode i
184
                     , let sdx = Instance.sNode i
185
                       in if sdx == Node.noSecondary then ""
186
                          else Container.nameOf nl sdx
187
                     , show (Instance.mem i)
188
                     , show (Instance.dsk i)
189
                     , show (Instance.vcpus i)
190
                     ]
191

    
192
-- | Main function.
193
main :: IO ()
194
main = do
195
  cmd_args <- System.getArgs
196
  (opts, args) <- parseOpts cmd_args "hspace" options
197

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

    
202
  let verbose = optVerbose opts
203
      ispec = optISpec opts
204
      shownodes = optShowNodes opts
205

    
206
  (fixed_nl, il, _) <- loadExternalData opts
207

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

    
211
  let num_instances = length $ Container.elems il
212

    
213
  let offline_names = optOffline opts
214
      all_nodes = Container.elems fixed_nl
215
      all_names = map Node.name all_nodes
216
      offline_wrong = filter (`notElem` all_names) offline_names
217
      offline_indices = map Node.idx $
218
                        filter (\n ->
219
                                 Node.name n `elem` offline_names ||
220
                                 Node.alias n `elem` offline_names)
221
                               all_nodes
222
      req_nodes = optINodes opts
223
      m_cpu = optMcpu opts
224
      m_dsk = optMdsk opts
225

    
226
  when (length offline_wrong > 0) $ do
227
         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
228
                     (commaJoin offline_wrong) :: IO ()
229
         exitWith $ ExitFailure 1
230

    
231
  when (req_nodes /= 1 && req_nodes /= 2) $ do
232
         hPrintf stderr "Error: Invalid required nodes (%d)\n"
233
                                            req_nodes :: IO ()
234
         exitWith $ ExitFailure 1
235

    
236
  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
237
                                then Node.setOffline n True
238
                                else n) fixed_nl
239
      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
240
           nm
241
      csf = commonSuffix fixed_nl il
242

    
243
  when (length csf > 0 && verbose > 1) $
244
       hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
245

    
246
  when (isJust shownodes) $
247
       do
248
         hPutStrLn stderr "Initial cluster status:"
249
         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
250

    
251
  let ini_cv = Cluster.compCV nl
252
      ini_stats = Cluster.totalResources nl
253

    
254
  when (verbose > 2) $
255
         hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
256
                 ini_cv (Cluster.printStats nl)
257

    
258
  printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
259
  printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
260
  printKeys $ printStats PInitial ini_stats
261

    
262
  let bad_nodes = fst $ Cluster.computeBadItems nl il
263
      stop_allocation = length bad_nodes > 0
264
      result_noalloc = ([(FailN1, 1)]::FailStats, nl, [])
265

    
266
  -- utility functions
267
  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
268
                    (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
269
      exitifbad val = (case val of
270
                         Bad s -> do
271
                           hPrintf stderr "Failure: %s\n" s :: IO ()
272
                           exitWith $ ExitFailure 1
273
                         Ok x -> return x)
274

    
275

    
276
  let reqinst = iofspec ispec
277

    
278
  -- Run the tiered allocation, if enabled
279

    
280
  (case optTieredSpec opts of
281
     Nothing -> return ()
282
     Just tspec -> do
283
       (_, trl_nl, trl_ixes) <-
284
           if stop_allocation
285
           then return result_noalloc
286
           else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
287
                                  req_nodes [])
288
       let fin_trl_ixes = reverse trl_ixes
289
           ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
290
           spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
291
                      ix_byspec::[(RSpec, Int)]
292
           spec_map' = map (\(spec, cnt) ->
293
                                printf "%d,%d,%d=%d" (rspecMem spec)
294
                                       (rspecDsk spec) (rspecCpu spec) cnt)
295
                       spec_map::[String]
296

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

    
303
       when (isJust shownodes) $ do
304
         hPutStrLn stderr ""
305
         hPutStrLn stderr "Tiered allocation status:"
306
         hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
307

    
308
       printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
309
       printKeys [("TSPEC", intercalate " " spec_map')]
310
       printAllocationStats nl trl_nl)
311

    
312
  -- Run the standard (avg-mode) allocation
313

    
314
  (ereason, fin_nl, ixes) <-
315
      if stop_allocation
316
      then return result_noalloc
317
      else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
318

    
319
  let allocs = length ixes
320
      fin_ixes = reverse ixes
321
      sreason = reverse $ sortBy (comparing snd) ereason
322

    
323
  when (verbose > 1) $ do
324
         hPutStrLn stderr "Instance map"
325
         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
326
                 formatTable (map (printInstance fin_nl) fin_ixes)
327
                                 [False, False, False, True, True, True]
328
  when (isJust shownodes) $
329
       do
330
         hPutStrLn stderr ""
331
         hPutStrLn stderr "Final cluster status:"
332
         hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
333

    
334
  printResults fin_nl num_instances allocs sreason