Revision 1494a4cc

b/.gitignore
98 98
/htools/.hpc
99 99
/htools/coverage
100 100

  
101
/htools/hspace
102 101
/htools/htools
103 102
/htools/test
104 103
/htools/*.prof*
b/Makefile.am
306 306
	doc/upgrade.rst \
307 307
	doc/walkthrough.rst
308 308

  
309
HS_PROGS = \
310
	htools/hspace \
311
	htools/htools
312
HS_BIN_ROLES = hbal hscan
309
HS_PROGS = htools/htools
310
HS_BIN_ROLES = hbal hscan hspace
313 311

  
314 312
HS_ALL_PROGS = $(HS_PROGS) htools/test
315 313
HS_PROG_SRCS = $(patsubst %,%.hs,$(HS_ALL_PROGS))
......
344 342
	htools/Ganeti/HTools/Program/Hail.hs \
345 343
	htools/Ganeti/HTools/Program/Hbal.hs \
346 344
	htools/Ganeti/HTools/Program/Hscan.hs \
345
	htools/Ganeti/HTools/Program/Hspace.hs \
347 346
	htools/Ganeti/Jobs.hs \
348 347
	htools/Ganeti/Luxi.hs \
349 348
	htools/Ganeti/OpCodes.hs
b/htools/Ganeti/HTools/Program/Hspace.hs
1
{-| Cluster space sizing
2

  
3
-}
4

  
5
{-
6

  
7
Copyright (C) 2009, 2010, 2011 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 Ganeti.HTools.Program.Hspace (main) where
27

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

  
37
import Text.Printf (printf, hPrintf)
38

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

  
44
import Ganeti.HTools.Utils
45
import Ganeti.HTools.Types
46
import Ganeti.HTools.CLI
47
import Ganeti.HTools.ExtLoader
48
import Ganeti.HTools.Loader (ClusterData(..))
49

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

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

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

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

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

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

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

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

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

  
155
formatRSpec :: Double -> String -> RSpec -> [(String, String)]
156
formatRSpec m_cpu s r =
157
    [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
158
    , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
159
    , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
160
    , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
161
    ]
162

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

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

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

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

  
194
-- | Optionally print the allocation map
195
printAllocationMap :: Int -> String
196
                   -> Node.List -> [Instance.Instance] -> IO ()
197
printAllocationMap verbose msg nl ixes =
198
  when (verbose > 1) $ do
199
    hPutStrLn stderr msg
200
    hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
201
            formatTable (map (printInstance nl) (reverse ixes))
202
                        -- This is the numberic-or-not field
203
                        -- specification; the first three fields are
204
                        -- strings, whereas the rest are numeric
205
                       [False, False, False, True, True, True]
206

  
207
-- | Main function.
208
main :: IO ()
209
main = do
210
  cmd_args <- System.getArgs
211
  (opts, args) <- parseOpts cmd_args "hspace" options
212

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

  
217
  let verbose = optVerbose opts
218
      ispec = optISpec opts
219
      shownodes = optShowNodes opts
220
      disk_template = optDiskTemplate opts
221
      req_nodes = Instance.requiredNodes disk_template
222

  
223
  (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
224

  
225
  printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
226
  printKeys [ ("SPEC_RQN", printf "%d" req_nodes) ]
227
  printKeys [ ("SPEC_DISK_TEMPLATE", dtToString disk_template) ]
228

  
229
  let num_instances = length $ Container.elems il
230

  
231
  let offline_names = optOffline opts
232
      all_nodes = Container.elems fixed_nl
233
      all_names = map Node.name all_nodes
234
      offline_wrong = filter (`notElem` all_names) offline_names
235
      offline_indices = map Node.idx $
236
                        filter (\n ->
237
                                 Node.name n `elem` offline_names ||
238
                                 Node.alias n `elem` offline_names)
239
                               all_nodes
240
      m_cpu = optMcpu opts
241
      m_dsk = optMdsk opts
242

  
243
  when (length offline_wrong > 0) $ do
244
         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
245
                     (commaJoin offline_wrong) :: IO ()
246
         exitWith $ ExitFailure 1
247

  
248
  when (req_nodes /= 1 && req_nodes /= 2) $ do
249
         hPrintf stderr "Error: Invalid required nodes (%d)\n"
250
                                            req_nodes :: IO ()
251
         exitWith $ ExitFailure 1
252

  
253
  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
254
                                then Node.setOffline n True
255
                                else n) fixed_nl
256
      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
257
           nm
258
      csf = commonSuffix fixed_nl il
259

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

  
263
  when (isJust shownodes) $
264
       do
265
         hPutStrLn stderr "Initial cluster status:"
266
         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
267

  
268
  let ini_cv = Cluster.compCV nl
269
      ini_stats = Cluster.totalResources nl
270

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

  
275
  printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
276
  printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
277
  printKeys $ printStats PInitial ini_stats
278

  
279
  let bad_nodes = fst $ Cluster.computeBadItems nl il
280
      stop_allocation = length bad_nodes > 0
281
      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
282

  
283
  -- utility functions
284
  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
285
                    (rspecCpu spx) "running" [] True (-1) (-1) disk_template
286
      exitifbad val = (case val of
287
                         Bad s -> do
288
                           hPrintf stderr "Failure: %s\n" s :: IO ()
289
                           exitWith $ ExitFailure 1
290
                         Ok x -> return x)
291

  
292

  
293
  let reqinst = iofspec ispec
294

  
295
  allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True
296

  
297
  -- Run the tiered allocation, if enabled
298

  
299
  (case optTieredSpec opts of
300
     Nothing -> return ()
301
     Just tspec -> do
302
       (_, trl_nl, trl_il, trl_ixes, _) <-
303
           if stop_allocation
304
           then return result_noalloc
305
           else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)
306
                                  allocnodes [] [])
307
       let spec_map' = Cluster.tieredSpecMap trl_ixes
308

  
309
       printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
310

  
311
       maybePrintNodes shownodes "Tiered allocation"
312
                           (Cluster.printNodes trl_nl)
313

  
314
       maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation"
315
                     (ClusterData gl trl_nl trl_il ctags)
316

  
317
       printKeys $ map (\(a, fn) -> ("TSPEC_INI_" ++ a, fn tspec)) specData
318
       printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
319
       printKeys [("TSPEC", intercalate " " spec_map')]
320
       printAllocationStats m_cpu nl trl_nl)
321

  
322
  -- Run the standard (avg-mode) allocation
323

  
324
  (ereason, fin_nl, fin_il, ixes, _) <-
325
      if stop_allocation
326
      then return result_noalloc
327
      else exitifbad (Cluster.iterateAlloc nl il Nothing
328
                      reqinst allocnodes [] [])
329

  
330
  let allocs = length ixes
331
      sreason = reverse $ sortBy (comparing snd) ereason
332

  
333
  printAllocationMap verbose "Standard allocation map" fin_nl ixes
334

  
335
  maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
336

  
337
  maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
338
       (ClusterData gl fin_nl fin_il ctags)
339

  
340
  printResults fin_nl num_instances allocs sreason
/dev/null
1
{-| Cluster space sizing
2

  
3
-}
4

  
5
{-
6

  
7
Copyright (C) 2009, 2010, 2011 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 Control.Monad
29
import Data.Char (toUpper, isAlphaNum)
30
import Data.List
31
import Data.Maybe (isJust, fromJust)
32
import Data.Ord (comparing)
33
import System (exitWith, ExitCode(..))
34
import System.IO
35
import qualified System
36

  
37
import Text.Printf (printf, hPrintf)
38

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

  
44
import Ganeti.HTools.Utils
45
import Ganeti.HTools.Types
46
import Ganeti.HTools.CLI
47
import Ganeti.HTools.ExtLoader
48
import Ganeti.HTools.Loader (ClusterData(..))
49

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

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

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

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

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

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

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

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

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

  
155
formatRSpec :: Double -> String -> RSpec -> [(String, String)]
156
formatRSpec m_cpu s r =
157
    [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
158
    , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
159
    , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
160
    , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
161
    ]
162

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

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

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

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

  
194
-- | Optionally print the allocation map
195
printAllocationMap :: Int -> String
196
                   -> Node.List -> [Instance.Instance] -> IO ()
197
printAllocationMap verbose msg nl ixes =
198
  when (verbose > 1) $ do
199
    hPutStrLn stderr msg
200
    hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
201
            formatTable (map (printInstance nl) (reverse ixes))
202
                        -- This is the numberic-or-not field
203
                        -- specification; the first three fields are
204
                        -- strings, whereas the rest are numeric
205
                       [False, False, False, True, True, True]
206

  
207
-- | Main function.
208
main :: IO ()
209
main = do
210
  cmd_args <- System.getArgs
211
  (opts, args) <- parseOpts cmd_args "hspace" options
212

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

  
217
  let verbose = optVerbose opts
218
      ispec = optISpec opts
219
      shownodes = optShowNodes opts
220
      disk_template = optDiskTemplate opts
221
      req_nodes = Instance.requiredNodes disk_template
222

  
223
  (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
224

  
225
  printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
226
  printKeys [ ("SPEC_RQN", printf "%d" req_nodes) ]
227
  printKeys [ ("SPEC_DISK_TEMPLATE", dtToString disk_template) ]
228

  
229
  let num_instances = length $ Container.elems il
230

  
231
  let offline_names = optOffline opts
232
      all_nodes = Container.elems fixed_nl
233
      all_names = map Node.name all_nodes
234
      offline_wrong = filter (`notElem` all_names) offline_names
235
      offline_indices = map Node.idx $
236
                        filter (\n ->
237
                                 Node.name n `elem` offline_names ||
238
                                 Node.alias n `elem` offline_names)
239
                               all_nodes
240
      m_cpu = optMcpu opts
241
      m_dsk = optMdsk opts
242

  
243
  when (length offline_wrong > 0) $ do
244
         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
245
                     (commaJoin offline_wrong) :: IO ()
246
         exitWith $ ExitFailure 1
247

  
248
  when (req_nodes /= 1 && req_nodes /= 2) $ do
249
         hPrintf stderr "Error: Invalid required nodes (%d)\n"
250
                                            req_nodes :: IO ()
251
         exitWith $ ExitFailure 1
252

  
253
  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
254
                                then Node.setOffline n True
255
                                else n) fixed_nl
256
      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
257
           nm
258
      csf = commonSuffix fixed_nl il
259

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

  
263
  when (isJust shownodes) $
264
       do
265
         hPutStrLn stderr "Initial cluster status:"
266
         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
267

  
268
  let ini_cv = Cluster.compCV nl
269
      ini_stats = Cluster.totalResources nl
270

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

  
275
  printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
276
  printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
277
  printKeys $ printStats PInitial ini_stats
278

  
279
  let bad_nodes = fst $ Cluster.computeBadItems nl il
280
      stop_allocation = length bad_nodes > 0
281
      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
282

  
283
  -- utility functions
284
  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
285
                    (rspecCpu spx) "running" [] True (-1) (-1) disk_template
286
      exitifbad val = (case val of
287
                         Bad s -> do
288
                           hPrintf stderr "Failure: %s\n" s :: IO ()
289
                           exitWith $ ExitFailure 1
290
                         Ok x -> return x)
291

  
292

  
293
  let reqinst = iofspec ispec
294

  
295
  allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True
296

  
297
  -- Run the tiered allocation, if enabled
298

  
299
  (case optTieredSpec opts of
300
     Nothing -> return ()
301
     Just tspec -> do
302
       (_, trl_nl, trl_il, trl_ixes, _) <-
303
           if stop_allocation
304
           then return result_noalloc
305
           else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)
306
                                  allocnodes [] [])
307
       let spec_map' = Cluster.tieredSpecMap trl_ixes
308

  
309
       printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
310

  
311
       maybePrintNodes shownodes "Tiered allocation"
312
                           (Cluster.printNodes trl_nl)
313

  
314
       maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation"
315
                     (ClusterData gl trl_nl trl_il ctags)
316

  
317
       printKeys $ map (\(a, fn) -> ("TSPEC_INI_" ++ a, fn tspec)) specData
318
       printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
319
       printKeys [("TSPEC", intercalate " " spec_map')]
320
       printAllocationStats m_cpu nl trl_nl)
321

  
322
  -- Run the standard (avg-mode) allocation
323

  
324
  (ereason, fin_nl, fin_il, ixes, _) <-
325
      if stop_allocation
326
      then return result_noalloc
327
      else exitifbad (Cluster.iterateAlloc nl il Nothing
328
                      reqinst allocnodes [] [])
329

  
330
  let allocs = length ixes
331
      sreason = reverse $ sortBy (comparing snd) ereason
332

  
333
  printAllocationMap verbose "Standard allocation map" fin_nl ixes
334

  
335
  maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
336

  
337
  maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
338
       (ClusterData gl fin_nl fin_il ctags)
339

  
340
  printResults fin_nl num_instances allocs sreason
b/htools/htools.hs
33 33
import qualified Ganeti.HTools.Program.Hail as Hail
34 34
import qualified Ganeti.HTools.Program.Hbal as Hbal
35 35
import qualified Ganeti.HTools.Program.Hscan as Hscan
36
import qualified Ganeti.HTools.Program.Hspace as Hspace
36 37

  
37 38
-- | Supported binaries.
38 39
personalities :: [(String, IO ())]
39 40
personalities = [ ("hail", Hail.main)
40 41
                , ("hbal", Hbal.main)
41 42
                , ("hscan", Hscan.main)
43
                , ("hspace", Hspace.main)
42 44
                ]
43 45

  
44 46
-- | Display usage and exit.

Also available in: Unified diff