code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/CLI.hs

   1 {-| Implementation of command-line functions.
   2
   3 This module holds the common cli-related functions for the binaries,
   4 separated into this module since Utils.hs is used in many other places
   5 and this is more IO oriented.
   6
   7 -}
   8
   9 {-
  10
  11 Copyright (C) 2009 Google Inc.
  12
  13 This program is free software; you can redistribute it and/or modify
  14 it under the terms of the GNU General Public License as published by
  15 the Free Software Foundation; either version 2 of the License, or
  16 (at your option) any later version.
  17
  18 This program is distributed in the hope that it will be useful, but
  19 WITHOUT ANY WARRANTY; without even the implied warranty of
  20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 General Public License for more details.
  22
  23 You should have received a copy of the GNU General Public License
  24 along with this program; if not, write to the Free Software
  25 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 02110-1301, USA.
  27
  28 -}
  29
  30 module Ganeti.HTools.CLI
  31     ( CLIOptions(..)
  32     , EToolOptions(..)
  33     , parseOpts
  34     , parseEnv
  35     , shTemplate
  36     , loadExternalData
  37     , defaultLuxiSocket
  38     ) where
  39
  40 import Data.Maybe (isJust, fromJust)
  41 import qualified Data.Version
  42 import Monad
  43 import System.Console.GetOpt
  44 import System.Posix.Env
  45 import System.IO
  46 import System.Info
  47 import System
  48 import Text.Printf (printf, hPrintf)
  49
  50 import qualified Ganeti.HTools.Version as Version(version)
  51 import qualified Ganeti.HTools.Luxi as Luxi
  52 import qualified Ganeti.HTools.Rapi as Rapi
  53 import qualified Ganeti.HTools.Text as Text
  54 import qualified Ganeti.HTools.Loader as Loader
  55 import qualified Ganeti.HTools.Instance as Instance
  56 import qualified Ganeti.HTools.Node as Node
  57
  58 import Ganeti.HTools.Types
  59
  60 -- | The default value for the luxi socket
  61 defaultLuxiSocket :: FilePath
  62 defaultLuxiSocket = "/var/run/ganeti/socket/ganeti-master"
  63
  64 -- | Class for types which support show help and show version.
  65 class CLIOptions a where
  66     -- | Denotes whether the show help option has been passed.
  67     showHelp    :: a -> Bool
  68     -- | Denotes whether the show version option has been passed.
  69     showVersion :: a -> Bool
  70
  71 -- | Class for types which support the -i\/-n\/-m options.
  72 class EToolOptions a where
  73     -- | Returns the node file name.
  74     nodeFile   :: a -> FilePath
  75     -- | Tells whether the node file has been passed as an option.
  76     nodeSet    :: a -> Bool
  77     -- | Returns the instance file name.
  78     instFile   :: a -> FilePath
  79     -- | Tells whether the instance file has been passed as an option.
  80     instSet    :: a -> Bool
  81     -- | Rapi target, if one has been passed.
  82     masterName :: a -> String
  83     -- | Whether to connect to a local luxi socket.
  84     luxiSocket :: a -> Maybe FilePath
  85     -- | Whether to be less verbose.
  86     silent     :: a -> Bool
  87
  88 -- | Usage info
  89 usageHelp :: (CLIOptions a) => String -> [OptDescr (a -> a)] -> String
  90 usageHelp progname =
  91     usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
  92                progname Version.version progname)
  93
  94 -- | Command line parser, using the 'options' structure.
  95 parseOpts :: (CLIOptions b) =>
  96              [String]            -- ^ The command line arguments
  97           -> String              -- ^ The program name
  98           -> [OptDescr (b -> b)] -- ^ The supported command line options
  99           -> b                   -- ^ The default options record
 100           -> IO (b, [String])    -- ^ The resulting options a leftover
 101                                  -- arguments
 102 parseOpts argv progname options defaultOptions =
 103     case getOpt Permute options argv of
 104       (o, n, []) ->
 105           do
 106             let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
 107             when (showHelp po) $ do
 108               putStr $ usageHelp progname options
 109               exitWith ExitSuccess
 110             when (showVersion po) $ do
 111               printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 112                      progname Version.version
 113                      compilerName (Data.Version.showVersion compilerVersion)
 114                      os arch
 115               exitWith ExitSuccess
 116             return resu
 117       (_, _, errs) ->
 118           ioError (userError (concat errs ++ usageHelp progname options))
 119
 120 -- | Parse the environment and return the node\/instance names.
 121 --
 122 -- This also hardcodes here the default node\/instance file names.
 123 parseEnv :: () -> IO (String, String)
 124 parseEnv () = do
 125   a <- getEnvDefault "HTOOLS_NODES" "nodes"
 126   b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
 127   return (a, b)
 128
 129 -- | A shell script template for autogenerated scripts.
 130 shTemplate :: String
 131 shTemplate =
 132     printf "#!/bin/sh\n\n\
 133            \# Auto-generated script for executing cluster rebalancing\n\n\
 134            \# To stop, touch the file /tmp/stop-htools\n\n\
 135            \set -e\n\n\
 136            \check() {\n\
 137            \  if [ -f /tmp/stop-htools ]; then\n\
 138            \    echo 'Stop requested, exiting'\n\
 139            \    exit 0\n\
 140            \  fi\n\
 141            \}\n\n"
 142
 143 -- | External tool data loader from a variety of sources.
 144 loadExternalData :: (EToolOptions a) =>
 145                     a
 146                  -> IO (Node.List, Instance.List, String)
 147 loadExternalData opts = do
 148   (env_node, env_inst) <- parseEnv ()
 149   let nodef = if nodeSet opts then nodeFile opts
 150               else env_node
 151       instf = if instSet opts then instFile opts
 152               else env_inst
 153       mhost = masterName opts
 154       lsock = luxiSocket opts
 155   input_data <-
 156       case () of
 157         _ | mhost /= "" -> Rapi.loadData mhost
 158           | isJust lsock -> Luxi.loadData $ fromJust lsock
 159           | otherwise -> Text.loadData nodef instf
 160
 161   let ldresult = input_data >>= Loader.mergeData
 162   (loaded_nl, il, csf) <-
 163       (case ldresult of
 164          Ok x -> return x
 165          Bad s -> do
 166            hPrintf stderr "Error: failed to load data. Details:\n%s\n" s
 167            exitWith $ ExitFailure 1
 168       )
 169   let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
 170
 171   unless (null fix_msgs || silent opts) $ do
 172          hPutStrLn stderr "Warning: cluster has inconsistent data:"
 173          hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 174
 175   return (fixed_nl, il, csf)