Statistics
| Branch: | Tag: | Revision:

root / htools / hail.hs @ a69ff623

History | View | Annotate | Download (3.7 kB)

1 585d4420 Iustin Pop
{-| Solver for N+1 cluster errors
2 585d4420 Iustin Pop
3 585d4420 Iustin Pop
-}
4 585d4420 Iustin Pop
5 e2fa2baf Iustin Pop
{-
6 e2fa2baf Iustin Pop
7 4bc33d60 Iustin Pop
Copyright (C) 2009, 2010, 2011 Google Inc.
8 e2fa2baf Iustin Pop
9 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
10 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
11 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 e2fa2baf Iustin Pop
(at your option) any later version.
13 e2fa2baf Iustin Pop
14 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
15 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 e2fa2baf Iustin Pop
General Public License for more details.
18 e2fa2baf Iustin Pop
19 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
20 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
21 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 e2fa2baf Iustin Pop
02110-1301, USA.
23 e2fa2baf Iustin Pop
24 e2fa2baf Iustin Pop
-}
25 e2fa2baf Iustin Pop
26 585d4420 Iustin Pop
module Main (main) where
27 585d4420 Iustin Pop
28 585d4420 Iustin Pop
import Data.List
29 f3d53161 Iustin Pop
import Data.Maybe (isJust, fromJust)
30 585d4420 Iustin Pop
import Monad
31 0903280b Iustin Pop
import System (exitWith, ExitCode(..))
32 585d4420 Iustin Pop
import System.IO
33 585d4420 Iustin Pop
import qualified System
34 585d4420 Iustin Pop
35 585d4420 Iustin Pop
import qualified Ganeti.HTools.Cluster as Cluster
36 0427285d Iustin Pop
37 0427285d Iustin Pop
import Ganeti.HTools.CLI
38 585d4420 Iustin Pop
import Ganeti.HTools.IAlloc
39 e4c5beaf Iustin Pop
import Ganeti.HTools.Types
40 34c00528 Iustin Pop
import Ganeti.HTools.Loader (RqType(..), Request(..), ClusterData(..))
41 01fec0a1 Iustin Pop
import Ganeti.HTools.ExtLoader (loadExternalData)
42 585d4420 Iustin Pop
43 585d4420 Iustin Pop
-- | Options list and functions
44 0427285d Iustin Pop
options :: [OptType]
45 01fec0a1 Iustin Pop
options =
46 01fec0a1 Iustin Pop
    [ oPrintNodes
47 01fec0a1 Iustin Pop
    , oDataFile
48 01fec0a1 Iustin Pop
    , oNodeSim
49 01fec0a1 Iustin Pop
    , oShowVer
50 01fec0a1 Iustin Pop
    , oShowHelp
51 01fec0a1 Iustin Pop
    ]
52 f826c5e0 Iustin Pop
53 54365762 Iustin Pop
processResults :: (Monad m) =>
54 54365762 Iustin Pop
                  RqType -> Cluster.AllocSolution
55 db4d9a9b Iustin Pop
               -> m Cluster.AllocSolution
56 db4d9a9b Iustin Pop
processResults _ (Cluster.AllocSolution { Cluster.asSolutions = [],
57 db4d9a9b Iustin Pop
                                          Cluster.asLog = msgs }) =
58 db4d9a9b Iustin Pop
  fail $ intercalate ", " msgs
59 db4d9a9b Iustin Pop
60 db4d9a9b Iustin Pop
processResults (Evacuate _) as = return as
61 54365762 Iustin Pop
62 85d0ddc3 Iustin Pop
processResults _ as =
63 85d0ddc3 Iustin Pop
    case Cluster.asSolutions as of
64 db4d9a9b Iustin Pop
      _:[] -> return as
65 23f9ab76 Iustin Pop
      _ -> fail "Internal error: multiple allocation solutions"
66 585d4420 Iustin Pop
67 78694255 Iustin Pop
-- | Process a request and return new node lists
68 f2280553 Iustin Pop
processRequest :: Request
69 478df686 Iustin Pop
               -> Result Cluster.AllocSolution
70 78694255 Iustin Pop
processRequest request =
71 34c00528 Iustin Pop
  let Request rqtype (ClusterData gl nl il _) = request
72 78694255 Iustin Pop
  in case rqtype of
73 aec636b9 Iustin Pop
       Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn
74 4bc33d60 Iustin Pop
       Relocate idx reqn exnodes -> Cluster.tryMGReloc gl nl il
75 4bc33d60 Iustin Pop
                                    idx reqn exnodes
76 1bc47d38 Iustin Pop
       Evacuate exnodes -> Cluster.tryMGEvac gl nl il exnodes
77 78694255 Iustin Pop
78 01fec0a1 Iustin Pop
-- | Reads the request from the data file(s)
79 01fec0a1 Iustin Pop
readRequest :: Options -> [String] -> IO Request
80 01fec0a1 Iustin Pop
readRequest opts args = do
81 01fec0a1 Iustin Pop
  when (null args) $ do
82 01fec0a1 Iustin Pop
         hPutStrLn stderr "Error: this program needs an input file."
83 01fec0a1 Iustin Pop
         exitWith $ ExitFailure 1
84 01fec0a1 Iustin Pop
85 01fec0a1 Iustin Pop
  input_data <- readFile (head args)
86 01fec0a1 Iustin Pop
  r1 <- case (parseData input_data) of
87 01fec0a1 Iustin Pop
          Bad err -> do
88 01fec0a1 Iustin Pop
            hPutStrLn stderr $ "Error: " ++ err
89 01fec0a1 Iustin Pop
            exitWith $ ExitFailure 1
90 01fec0a1 Iustin Pop
          Ok rq -> return rq
91 d5072e4c Iustin Pop
  (if isJust (optDataFile opts) ||  (not . null . optNodeSim) opts
92 d5072e4c Iustin Pop
   then do
93 d5072e4c Iustin Pop
     cdata <- loadExternalData opts
94 d5072e4c Iustin Pop
     let Request rqt _ = r1
95 d5072e4c Iustin Pop
     return $ Request rqt cdata
96 d5072e4c Iustin Pop
   else return r1)
97 01fec0a1 Iustin Pop
98 585d4420 Iustin Pop
-- | Main function.
99 585d4420 Iustin Pop
main :: IO ()
100 585d4420 Iustin Pop
main = do
101 585d4420 Iustin Pop
  cmd_args <- System.getArgs
102 f3d53161 Iustin Pop
  (opts, args) <- parseOpts cmd_args "hail" options
103 585d4420 Iustin Pop
104 01fec0a1 Iustin Pop
  let shownodes = optShowNodes opts
105 585d4420 Iustin Pop
106 01fec0a1 Iustin Pop
  request <- readRequest opts args
107 585d4420 Iustin Pop
108 34c00528 Iustin Pop
  let Request rq cdata = request
109 f3d53161 Iustin Pop
110 f3d53161 Iustin Pop
  when (isJust shownodes) $ do
111 f3d53161 Iustin Pop
         hPutStrLn stderr "Initial cluster status:"
112 34c00528 Iustin Pop
         hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata)
113 34c00528 Iustin Pop
                       (fromJust shownodes)
114 f3d53161 Iustin Pop
115 54365762 Iustin Pop
  let sols = processRequest request >>= processResults rq
116 478df686 Iustin Pop
  let (ok, info, rn) =
117 478df686 Iustin Pop
          case sols of
118 db4d9a9b Iustin Pop
            Ok as -> (True, "Request successful: " ++
119 db4d9a9b Iustin Pop
                            intercalate ", " (Cluster.asLog as),
120 db4d9a9b Iustin Pop
                      Cluster.asSolutions as)
121 478df686 Iustin Pop
            Bad s -> (False, "Request failed: " ++ s, [])
122 3e4480e0 Iustin Pop
      resp = formatResponse ok info rq rn
123 ed41c179 Iustin Pop
  putStrLn resp