Statistics
| Branch: | Tag: | Revision:

root / hspace.hs @ 3ce8009a

History | View | Annotate | Download (11.8 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 -> Node.name n `elem` offline_names)
219
                               all_nodes
220
      req_nodes = optINodes opts
221
      m_cpu = optMcpu opts
222
      m_dsk = optMdsk opts
223

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

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

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

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

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

    
249
  let ini_cv = Cluster.compCV nl
250
      ini_stats = Cluster.totalResources nl
251

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

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

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

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

    
273

    
274
  let reqinst = iofspec ispec
275

    
276
  -- Run the tiered allocation, if enabled
277

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

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

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

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

    
310
  -- Run the standard (avg-mode) allocation
311

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

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

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

    
332
  printResults fin_nl num_instances allocs sreason