Statistics
| Branch: | Tag: | Revision:

root / htools / hail.hs @ cabce2f4

History | View | Annotate | Download (2.2 kB)

1
{-| IAllocator plugin for Ganeti.
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.List
30
import Data.Maybe (isJust, fromJust)
31
import System.IO
32
import qualified System
33

    
34
import qualified Ganeti.HTools.Cluster as Cluster
35

    
36
import Ganeti.HTools.CLI
37
import Ganeti.HTools.IAlloc
38
import Ganeti.HTools.Types
39
import Ganeti.HTools.Loader (Request(..), ClusterData(..))
40

    
41
-- | Options list and functions
42
options :: [OptType]
43
options =
44
    [ oPrintNodes
45
    , oDataFile
46
    , oNodeSim
47
    , oVerbose
48
    , oShowVer
49
    , oShowHelp
50
    ]
51

    
52
-- | Main function.
53
main :: IO ()
54
main = do
55
  cmd_args <- System.getArgs
56
  (opts, args) <- parseOpts cmd_args "hail" options
57

    
58
  let shownodes = optShowNodes opts
59
      verbose = optVerbose opts
60

    
61
  request <- readRequest opts args
62

    
63
  let Request rq cdata = request
64

    
65
  when (verbose > 1) $
66
       hPutStrLn stderr $ "Received request: " ++ show rq
67

    
68
  when (verbose > 2) $
69
       hPutStrLn stderr $ "Received cluster data: " ++ show cdata
70

    
71
  when (isJust shownodes) $ do
72
         hPutStrLn stderr "Initial cluster status:"
73
         hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata)
74
                       (fromJust shownodes)
75

    
76
  let sols = processRequest request >>= processResults rq
77
  let (ok, info, rn) =
78
          case sols of
79
            Ok as -> (True, "Request successful: " ++
80
                            intercalate ", " (Cluster.asLog as),
81
                      Cluster.asSolutions as)
82
            Bad s -> (False, "Request failed: " ++ s, [])
83
      resp = formatResponse ok info rq rn
84
  putStrLn resp