Revision 458a286a

b/.gitignore
100 100

  
101 101
/htools/hbal
102 102
/htools/hscan
103
/htools/hail
104 103
/htools/hspace
105 104
/htools/htools
106 105
/htools/test
b/Makefile.am
46 46
HTOOLS_DIRS = \
47 47
	htools \
48 48
	htools/Ganeti \
49
	htools/Ganeti/HTools
49
	htools/Ganeti/HTools \
50
	htools/Ganeti/HTools/Program
50 51

  
51 52
DIRS = \
52 53
	autotools \
......
82 83
	$(APIDOC_PY_DIR) \
83 84
	$(APIDOC_HS_DIR) \
84 85
	$(APIDOC_HS_DIR)/Ganeti $(APIDOC_HS_DIR)/Ganeti/HTools \
86
	$(APIDOC_HS_DIR)/Ganeti/HTools/Program \
85 87
	$(COVERAGE_DIR) \
86 88
	$(COVERAGE_PY_DIR) \
87 89
	$(COVERAGE_HS_DIR) \
......
307 309
HS_PROGS = \
308 310
	htools/hbal \
309 311
	htools/hscan \
310
	htools/hail \
311 312
	htools/hspace \
312 313
	htools/htools
313 314

  
......
341 342
	htools/Ganeti/HTools/Text.hs \
342 343
	htools/Ganeti/HTools/Types.hs \
343 344
	htools/Ganeti/HTools/Utils.hs \
345
	htools/Ganeti/HTools/Program/Hail.hs \
344 346
	htools/Ganeti/Jobs.hs \
345 347
	htools/Ganeti/Luxi.hs \
346 348
	htools/Ganeti/OpCodes.hs
......
447 449
	qa/qa_utils.py
448 450

  
449 451
bin_SCRIPTS =
450
iallocators_SCRIPTS =
451 452
if WANT_HTOOLS
452 453
bin_SCRIPTS += $(filter-out htools/hail,$(HS_PROGS))
453
iallocators_SCRIPTS += $(filter htools/hail,$(HS_PROGS))
454
install-exec-hook:
455
	@mkdir_p@ $(DESTDIR)$(iallocatorsdir)
456
	$(LN_S) -f $(DESTDIR)$(bindir)/htools \
457
		   $(DESTDIR)$(iallocatorsdir)/hail
454 458
endif
455 459

  
456 460
$(HS_ALL_PROGS): %: %.hs $(HS_LIB_SRCS) $(HS_BUILT_SRCS) Makefile
......
1108 1112
	@test -n "$(HADDOCK)" || \
1109 1113
	    { echo 'haddock' not found during configure; exit 1; }
1110 1114
	rm -rf $(APIDOC_HS_DIR)/*
1111
	@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/HTools
1115
	@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/HTools/Program
1112 1116
	$(HSCOLOUR) -print-css > $(APIDOC_HS_DIR)/Ganeti/hscolour.css
1113 1117
	ln -s ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/HTools/hscolour.css
1114 1118
	set -e ; \
b/htools/Ganeti/HTools/Program/Hail.hs
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 Ganeti.HTools.Program.Hail (main) where
27

  
28
import Control.Monad
29
import System.IO
30
import qualified System
31

  
32
import qualified Ganeti.HTools.Cluster as Cluster
33

  
34
import Ganeti.HTools.CLI
35
import Ganeti.HTools.IAlloc
36
import Ganeti.HTools.Loader (Request(..), ClusterData(..))
37
import Ganeti.HTools.ExtLoader (maybeSaveData)
38

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

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

  
57
  let shownodes = optShowNodes opts
58
      verbose = optVerbose opts
59
      savecluster = optSaveCluster 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
  maybePrintNodes shownodes "Initial cluster"
72
       (Cluster.printNodes (cdNodes cdata))
73

  
74
  maybeSaveData savecluster "pre-ialloc" "before iallocator run" cdata
75

  
76
  let (maybe_ni, resp) = runIAllocator request
77
      (fin_nl, fin_il) = maybe (cdNodes cdata, cdInstances cdata) id maybe_ni
78
  putStrLn resp
79

  
80
  maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)
81

  
82
  maybeSaveData savecluster "post-ialloc" "after iallocator run"
83
       (cdata { cdNodes = fin_nl, cdInstances = fin_il})
/dev/null
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 System.IO
30
import qualified System
31

  
32
import qualified Ganeti.HTools.Cluster as Cluster
33

  
34
import Ganeti.HTools.CLI
35
import Ganeti.HTools.IAlloc
36
import Ganeti.HTools.Loader (Request(..), ClusterData(..))
37
import Ganeti.HTools.ExtLoader (maybeSaveData)
38

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

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

  
57
  let shownodes = optShowNodes opts
58
      verbose = optVerbose opts
59
      savecluster = optSaveCluster 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
  maybePrintNodes shownodes "Initial cluster"
72
       (Cluster.printNodes (cdNodes cdata))
73

  
74
  maybeSaveData savecluster "pre-ialloc" "before iallocator run" cdata
75

  
76
  let (maybe_ni, resp) = runIAllocator request
77
      (fin_nl, fin_il) = maybe (cdNodes cdata, cdInstances cdata) id maybe_ni
78
  putStrLn resp
79

  
80
  maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)
81

  
82
  maybeSaveData savecluster "post-ialloc" "after iallocator run"
83
       (cdata { cdNodes = fin_nl, cdInstances = fin_il})
b/htools/htools.hs
30 30
import System.IO
31 31

  
32 32
import Ganeti.HTools.Utils
33
import qualified Ganeti.HTools.Program.Hail as Hail
33 34

  
34 35
-- | Supported binaries.
35 36
personalities :: [(String, IO ())]
36
personalities = []
37
personalities = [ ("hail", Hail.main)
38
                ]
37 39

  
38 40
-- | Display usage and exit.
39 41
usage :: String -> IO ()

Also available in: Unified diff