1 {-| Solver for N+1 cluster errors
7 Copyright (C) 2009 Google Inc.
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.
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.
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
26 module Main (main) where
30 import Data.Maybe (isJust, fromJust)
34 import System.Console.GetOpt
35 import qualified System
37 import Text.Printf (printf)
39 import qualified Ganeti.HTools.Cluster as Cluster
40 import qualified Ganeti.HTools.Node as Node
41 import qualified Ganeti.HTools.Instance as Instance
42 import qualified Ganeti.HTools.CLI as CLI
43 import Ganeti.HTools.IAlloc
44 import Ganeti.HTools.Types
45 import Ganeti.HTools.Loader (RqType(..), Request(..))
46 import Ganeti.HTools.Utils
48 -- | Command line options structure.
49 data Options = Options
50 { optShowVer :: Bool -- ^ Just show the program version
51 , optShowHelp :: Bool -- ^ Just show the help
54 -- | Default values for the command line options.
55 defaultOptions :: Options
56 defaultOptions = Options
61 instance CLI.CLIOptions Options where
62 showVersion = optShowVer
63 showHelp = optShowHelp
65 -- | Options list and functions
66 options :: [OptDescr (Options -> Options)]
68 [ Option ['V'] ["version"]
69 (NoArg (\ opts -> opts { optShowVer = True}))
70 "show the version of the program"
71 , Option ['h'] ["help"]
72 (NoArg (\ opts -> opts { optShowHelp = True}))
77 filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
78 -> m [(Node.List, [Node.Node])]
80 if null sols then fail "No nodes onto which to allocate at all"
81 else let sols' = filter (isJust . fst3) sols
83 fail "No valid allocation solutions"
85 return $ map (\(x, _, y) -> (fromJust x, y)) sols'
87 processResults :: (Monad m) => [(Node.List, [Node.Node])]
88 -> m (String, [Node.Node])
90 let sols' = map (\(nl', ns) -> (Cluster.compCV nl', ns)) sols
91 sols'' = sortBy (compare `on` fst) sols'
92 (best, w) = head sols''
93 (worst, l) = last sols''
94 info = (printf "Valid results: %d, best score: %.8f for node(s) %s, \
95 \worst score: %.8f for node(s) %s" (length sols'')
96 best (intercalate "/" . map Node.name $ w)
97 worst (intercalate "/" . map Node.name $ l))::String
100 -- | Process a request and return new node lists
103 -> Result [(Maybe Node.List, Instance.Instance, [Node.Node])]
104 processRequest request =
105 let Request rqtype nl il _ = request
107 Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
108 Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
113 cmd_args <- System.getArgs
114 (_, args) <- CLI.parseOpts cmd_args "hail" options defaultOptions
116 when (null args) $ do
117 hPutStrLn stderr "Error: this program needs an input file."
118 exitWith $ ExitFailure 1
120 let input_file = head args
121 input_data <- readFile input_file
123 request <- case (parseData input_data) of
125 putStrLn $ "Error: " ++ err
126 exitWith $ ExitFailure 1
129 let Request _ _ _ csf = request
130 sols = processRequest request >>= filterFails >>= processResults
131 let (ok, info, rn) = case sols of
132 Ok (info, sn) -> (True, "Request successful: " ++ info,
133 map ((++ csf) . Node.name) sn)
134 Bad s -> (False, "Request failed: " ++ s, [])
135 resp = formatResponse ok info rn