htools.hs 1.96 KB
Newer Older
Iustin Pop's avatar
Iustin Pop committed
1
2
3
4
5
6
{-| Main htools binary.

-}

{-

7
Copyright (C) 2011, 2012 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Main (main) where

28
29
import Control.Exception
import Control.Monad (guard)
Iustin Pop's avatar
Iustin Pop committed
30
import Data.Char (toLower)
31
import System.Environment
Iustin Pop's avatar
Iustin Pop committed
32
import System.IO
33
import System.IO.Error (isDoesNotExistError)
Iustin Pop's avatar
Iustin Pop committed
34

35
import Ganeti.Common (formatCommands)
36
import Ganeti.HTools.CLI (parseOpts, genericOpts)
37
import Ganeti.HTools.Program (personalities)
38
import Ganeti.Utils
Iustin Pop's avatar
Iustin Pop committed
39
40
41
42
43
44
45

-- | Display usage and exit.
usage :: String -> IO ()
usage name = do
  hPutStrLn stderr $ "Unrecognised personality '" ++ name ++ "'."
  hPutStrLn stderr "This program must be installed under one of the following\
                   \ names:"
46
  hPutStrLn stderr . unlines $ formatCommands personalities
47
48
  exitErr "Please either rename/symlink the program or set\n\
          \the environment variable HTOOLS to the desired role."
Iustin Pop's avatar
Iustin Pop committed
49
50
51

main :: IO ()
main = do
52
53
  binary <- catchJust (guard . isDoesNotExistError)
            (getEnv "HTOOLS") (const getProgName)
Iustin Pop's avatar
Iustin Pop committed
54
  let name = map toLower binary
55
  case name `lookup` personalities of
56
    Nothing -> usage name
57
    Just (fn, options, arguments, _) -> do
58
         cmd_args <- getArgs
59
60
         real_options <- options
         (opts, args) <- parseOpts cmd_args name (real_options ++ genericOpts)
61
                           arguments
62
         fn opts args