Revision e10be8f2

b/.gitignore
17 17
hbal
18 18
hscan
19 19
hail
20
hspace
20 21
test
21 22
*.prof*
22 23
*.stat
b/Makefile
1
HPROGS = hbal hn1 hscan hail
1
HPROGS = hbal hn1 hscan hail hspace
2 2
HALLPROGS = $(HPROGS) test
3 3
HSRCS := $(wildcard Ganeti/HTools/*.hs)
4 4
HDDIR = apidoc
b/hspace.hs
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.List
29
import Data.Function
30
import Data.Maybe (isJust, fromJust, fromMaybe, isNothing)
31
import Monad
32
import System
33
import System.IO
34
import System.Console.GetOpt
35
import qualified System
36

  
37
import Text.Printf (printf)
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
import qualified Ganeti.HTools.CLI as CLI
44

  
45
import Ganeti.HTools.Utils
46

  
47
-- | Command line options structure.
48
data Options = Options
49
    { optShowNodes :: Bool           -- ^ Whether to show node status
50
    , optNodef     :: FilePath       -- ^ Path to the nodes file
51
    , optNodeSet   :: Bool           -- ^ The nodes have been set by options
52
    , optInstf     :: FilePath       -- ^ Path to the instances file
53
    , optInstSet   :: Bool           -- ^ The insts have been set by options
54
    , optMaster    :: String         -- ^ Collect data from RAPI
55
    , optVerbose   :: Int            -- ^ Verbosity level
56
    , optOffline   :: [String]       -- ^ Names of offline nodes
57
    , optIMem      :: Int            -- ^ Instance memory
58
    , optIDsk      :: Int            -- ^ Instance disk
59
    , optINodes    :: Int            -- ^ Nodes required for an instance
60
    , optShowVer   :: Bool           -- ^ Just show the program version
61
    , optShowHelp  :: Bool           -- ^ Just show the help
62
    } deriving Show
63

  
64
instance CLI.CLIOptions Options where
65
    showVersion = optShowVer
66
    showHelp    = optShowHelp
67

  
68
instance CLI.EToolOptions Options where
69
    nodeFile   = optNodef
70
    nodeSet    = optNodeSet
71
    instFile   = optInstf
72
    instSet    = optInstSet
73
    masterName = optMaster
74
    silent a   = (optVerbose a) == 0
75

  
76
-- | Default values for the command line options.
77
defaultOptions :: Options
78
defaultOptions  = Options
79
 { optShowNodes = False
80
 , optNodef     = "nodes"
81
 , optNodeSet   = False
82
 , optInstf     = "instances"
83
 , optInstSet   = False
84
 , optMaster    = ""
85
 , optVerbose   = 1
86
 , optOffline   = []
87
 , optIMem      = 4096
88
 , optIDsk      = 102400
89
 , optINodes    = 2
90
 , optShowVer   = False
91
 , optShowHelp  = False
92
 }
93

  
94
-- | Options list and functions
95
options :: [OptDescr (Options -> Options)]
96
options =
97
    [ Option ['p']     ["print-nodes"]
98
      (NoArg (\ opts -> opts { optShowNodes = True }))
99
      "print the final node list"
100
    , Option ['n']     ["nodes"]
101
      (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
102
      "the node list FILE"
103
    , Option ['i']     ["instances"]
104
      (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
105
      "the instance list FILE"
106
    , Option ['m']     ["master"]
107
      (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
108
      "collect data via RAPI at the given ADDRESS"
109
    , Option ['v']     ["verbose"]
110
      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
111
      "increase the verbosity level"
112
    , Option ['q']     ["quiet"]
113
      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
114
      "decrease the verbosity level"
115
    , Option ['O']     ["offline"]
116
      (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
117
      "set node as offline"
118
    , Option []        ["memory"]
119
      (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
120
      "memory size for instances"
121
    , Option []        ["disk"]
122
      (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
123
      "disk size for instances"
124
    , Option []        ["req-nodes"]
125
      (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
126
      "number of nodes for the new instances (1=plain, 2=mirrored)"
127
    , Option ['V']     ["version"]
128
      (NoArg (\ opts -> opts { optShowVer = True}))
129
      "show the version of the program"
130
    , Option ['h']     ["help"]
131
      (NoArg (\ opts -> opts { optShowHelp = True}))
132
      "show help"
133
    ]
134

  
135
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
136
            -> m [(Node.List, [Node.Node])]
137
filterFails sols =
138
    if null sols then fail "No nodes onto which to allocate at all"
139
    else let sols' = filter (isJust . fst) sols
140
         in if null sols' then
141
                fail "No valid allocation solutions"
142
            else
143
                return $ map (\(x, y) -> (fromJust x, y)) sols'
144

  
145
processResults :: (Monad m) => [(Node.List, [Node.Node])]
146
               -> m (Node.List, [Node.Node])
147
processResults sols =
148
    let sols' = map (\(nl', ns) -> (Cluster.compCV  nl', (nl', ns))) sols
149
        sols'' = sortBy (compare `on` fst) sols'
150
    in return $ snd $ head sols''
151

  
152
iterateDepth :: Node.List
153
             -> Instance.List
154
             -> Instance.Instance
155
             -> Int
156
             -> Int
157
             -> (Node.List, Int)
158
iterateDepth nl il newinst nreq depth =
159
      let newname = printf "new-%d" depth
160
          newidx = (length $ Container.elems il) + depth
161
          newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
162
          sols = Cluster.tryAlloc nl il newi2 nreq
163
          orig = (nl, depth)
164
      in
165
        if isNothing sols then orig
166
        else let sols' = fromJust sols
167
                 sols'' = filterFails sols'
168
             in if isNothing sols'' then orig
169
                else let (xnl, _) = fromJust $ processResults $ fromJust sols''
170
                     in iterateDepth xnl il newinst nreq (depth+1)
171

  
172

  
173
-- | Main function.
174
main :: IO ()
175
main = do
176
  cmd_args <- System.getArgs
177
  (opts, args) <- CLI.parseOpts cmd_args "hspace" options defaultOptions
178

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

  
183
  let verbose = optVerbose opts
184

  
185
  (fixed_nl, il, csf) <- CLI.loadExternalData opts
186

  
187
  let offline_names = optOffline opts
188
      all_nodes = Container.elems fixed_nl
189
      all_names = map Node.name all_nodes
190
      offline_wrong = filter (\n -> not $ elem n all_names) offline_names
191
      offline_indices = map Node.idx $
192
                        filter (\n -> elem (Node.name n) offline_names)
193
                               all_nodes
194

  
195
  when (length offline_wrong > 0) $ do
196
         printf "Wrong node name(s) set as offline: %s\n"
197
                (commaJoin offline_wrong)
198
         exitWith $ ExitFailure 1
199

  
200
  let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
201
                                then Node.setOffline n True
202
                                else n) fixed_nl
203

  
204
  when (length csf > 0 && verbose > 1) $ do
205
         printf "Note: Stripping common suffix of '%s' from names\n" csf
206

  
207
  let bad_nodes = fst $ Cluster.computeBadItems nl il
208
  when (length bad_nodes > 0) $ do
209
         putStrLn "Cluster not N+1, no space to allocate."
210
         exitWith $ ExitFailure 1
211

  
212
  when (optShowNodes opts) $
213
       do
214
         putStrLn "Initial cluster status:"
215
         putStrLn $ Cluster.printNodes nl
216

  
217
  let ini_cv = Cluster.compCV nl
218

  
219
  (if verbose > 2 then
220
       printf "Initial coefficients: overall %.8f, %s\n"
221
       ini_cv (Cluster.printStats nl)
222
   else
223
       printf "Initial score: %.8f\n" ini_cv)
224

  
225
  let imlen = Container.maxNameLen il
226
      nmlen = Container.maxNameLen nl
227
      newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
228
                "ADMIN_down" (-1) (-1)
229

  
230
  let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0
231

  
232
  unless (verbose == 0) $
233
         printf "Solution length=%d\n" fin_depth
234

  
235
  when (optShowNodes opts) $
236
       do
237
         let (orig_mem, orig_disk) = Cluster.totalResources nl
238
             (final_mem, final_disk) = Cluster.totalResources fin_nl
239
         putStrLn ""
240
         putStrLn "Final cluster status:"
241
         putStrLn $ Cluster.printNodes fin_nl
242
         when (verbose > 3) $
243
              do
244
                printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
245
                printf "Final:    mem=%d disk=%d\n" final_mem final_disk

Also available in: Unified diff