code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Common.hs

   1 {-| Base common functionality.
   2
   3 This module holds common functionality shared across Ganeti daemons,
   4 HTools and any other programs.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Ganeti.Common
  30   ( GenericOptType
  31   , StandardOptions(..)
  32   , OptCompletion(..)
  33   , ArgCompletion(..)
  34   , PersonalityList
  35   , optComplYesNo
  36   , oShowHelp
  37   , oShowVer
  38   , oShowComp
  39   , usageHelp
  40   , versionInfo
  41   , reqWithConversion
  42   , parseYesNo
  43   , parseOpts
  44   , parseOptsInner
  45   ) where
  46
  47 import Control.Monad (foldM)
  48 import Data.Char (toLower)
  49 import Data.List (intercalate, stripPrefix)
  50 import Data.Maybe (fromMaybe)
  51 import qualified Data.Version
  52 import System.Console.GetOpt
  53 import System.Exit
  54 import System.Info
  55 import System.IO
  56 import Text.Printf (printf)
  57
  58 import Ganeti.BasicTypes
  59 import qualified Ganeti.Version as Version (version)
  60
  61 -- | Parameter type.
  62 data OptCompletion = OptComplNone             -- ^ No parameter to this option
  63                    | OptComplFile             -- ^ An existing file
  64                    | OptComplDir              -- ^ An existing directory
  65                    | OptComplHost             -- ^ Host name
  66                    | OptComplInetAddr         -- ^ One ipv4\/ipv6 address
  67                    | OptComplOneNode          -- ^ One node
  68                    | OptComplManyNodes        -- ^ Many nodes, comma-sep
  69                    | OptComplOneInstance      -- ^ One instance
  70                    | OptComplManyInstances    -- ^ Many instances, comma-sep
  71                    | OptComplOneOs            -- ^ One OS name
  72                    | OptComplOneIallocator    -- ^ One iallocator
  73                    | OptComplInstAddNodes     -- ^ Either one or two nodes
  74                    | OptComplOneGroup         -- ^ One group
  75                    | OptComplInteger          -- ^ Integer values
  76                    | OptComplFloat            -- ^ Float values
  77                    | OptComplJobId            -- ^ Job Id
  78                    | OptComplCommand          -- ^ Command (executable)
  79                    | OptComplString           -- ^ Arbitrary string
  80                    | OptComplChoices [String] -- ^ List of string choices
  81                    | OptComplSuggest [String] -- ^ Suggested choices
  82                    deriving (Show, Eq)
  83
  84 -- | Argument type. This differs from (and wraps) an Option by the
  85 -- fact that it can (and usually does) support multiple repetitions of
  86 -- the same argument, via a min and max limit.
  87 data ArgCompletion = ArgCompletion OptCompletion Int (Maybe Int)
  88                      deriving (Show, Eq)
  89
  90 -- | A personality definition.
  91 type Personality a = ( a -> [String] -> IO () -- The main function
  92                      , IO [GenericOptType a]  -- The options
  93                      , [ArgCompletion]        -- The description of args
  94                      )
  95
  96 -- | Personality lists type, common across all binaries that expose
  97 -- multiple personalities.
  98 type PersonalityList  a = [(String, Personality a)]
  99
 100 -- | Yes\/no choices completion.
 101 optComplYesNo :: OptCompletion
 102 optComplYesNo = OptComplChoices ["yes", "no"]
 103
 104 -- | Text serialisation for 'OptCompletion', used on the Python side.
 105 complToText :: OptCompletion -> String
 106 complToText (OptComplChoices choices) = "choices=" ++ intercalate "," choices
 107 complToText (OptComplSuggest choices) = "suggest=" ++ intercalate "," choices
 108 complToText compl =
 109   let show_compl = show compl
 110       stripped = stripPrefix "OptCompl" show_compl
 111   in map toLower $ fromMaybe show_compl stripped
 112
 113 -- | Tex serialisation for 'ArgCompletion'.
 114 argComplToText :: ArgCompletion -> String
 115 argComplToText (ArgCompletion optc min_cnt max_cnt) =
 116   complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
 117
 118 -- | Abrreviation for the option type.
 119 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
 120
 121 -- | Type class for options which support help and version.
 122 class StandardOptions a where
 123   helpRequested :: a -> Bool
 124   verRequested  :: a -> Bool
 125   compRequested :: a -> Bool
 126   requestHelp   :: a -> a
 127   requestVer    :: a -> a
 128   requestComp   :: a -> a
 129
 130 -- | Option to request help output.
 131 oShowHelp :: (StandardOptions a) => GenericOptType a
 132 oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
 133              OptComplNone)
 134
 135 -- | Option to request version information.
 136 oShowVer :: (StandardOptions a) => GenericOptType a
 137 oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
 138             "show the version of the program",
 139             OptComplNone)
 140
 141 -- | Option to request completion information
 142 oShowComp :: (StandardOptions a) => GenericOptType a
 143 oShowComp =
 144   (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
 145    "show completion info", OptComplNone)
 146
 147 -- | Usage info.
 148 usageHelp :: String -> [GenericOptType a] -> String
 149 usageHelp progname =
 150   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 151              progname Version.version progname) . map fst
 152
 153 -- | Show the program version info.
 154 versionInfo :: String -> String
 155 versionInfo progname =
 156   printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 157          progname Version.version compilerName
 158          (Data.Version.showVersion compilerVersion)
 159          os arch
 160
 161 -- | Show completion info.
 162 completionInfo :: String -> [GenericOptType a] -> [ArgCompletion] -> String
 163 completionInfo _ opts args =
 164   unlines $
 165   map (\(Option shorts longs _ _, compinfo) ->
 166          let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
 167          in intercalate "," all_opts ++ " " ++ complToText compinfo
 168       ) opts ++
 169   map argComplToText args
 170
 171 -- | Helper for parsing a yes\/no command line flag.
 172 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
 173            -> Maybe String -- ^ Parameter value
 174            -> Result Bool  -- ^ Resulting boolean value
 175 parseYesNo v Nothing      = return v
 176 parseYesNo _ (Just "yes") = return True
 177 parseYesNo _ (Just "no")  = return False
 178 parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
 179                                   "', pass one of 'yes' or 'no'")
 180
 181 -- | Helper function for required arguments which need to be converted
 182 -- as opposed to stored just as string.
 183 reqWithConversion :: (String -> Result a)
 184                   -> (a -> b -> Result b)
 185                   -> String
 186                   -> ArgDescr (b -> Result b)
 187 reqWithConversion conversion_fn updater_fn =
 188   ReqArg (\string_opt opts -> do
 189             parsed_value <- conversion_fn string_opt
 190             updater_fn parsed_value opts)
 191
 192 -- | Command line parser, using a generic 'Options' structure.
 193 parseOpts :: (StandardOptions a) =>
 194              a                      -- ^ The default options
 195           -> [String]               -- ^ The command line arguments
 196           -> String                 -- ^ The program name
 197           -> [GenericOptType a]     -- ^ The supported command line options
 198           -> [ArgCompletion]        -- ^ The supported command line arguments
 199           -> IO (a, [String])       -- ^ The resulting options and
 200                                     -- leftover arguments
 201 parseOpts defaults argv progname options arguments =
 202   case parseOptsInner defaults argv progname options arguments of
 203     Left (code, msg) -> do
 204       hPutStr (if code == ExitSuccess then stdout else stderr) msg
 205       exitWith code
 206     Right result ->
 207       return result
 208
 209 -- | Inner parse options. The arguments are similar to 'parseOpts',
 210 -- but it returns either a 'Left' composed of exit code and message,
 211 -- or a 'Right' for the success case.
 212 parseOptsInner :: (StandardOptions a) =>
 213                   a
 214                -> [String]
 215                -> String
 216                -> [GenericOptType a]
 217                -> [ArgCompletion]
 218                -> Either (ExitCode, String) (a, [String])
 219 parseOptsInner defaults argv progname options arguments  =
 220   case getOpt Permute (map fst options) argv of
 221     (opts, args, []) ->
 222       case foldM (flip id) defaults opts of
 223            Bad msg -> Left (ExitFailure 1,
 224                             "Error while parsing command line arguments:\n"
 225                             ++ msg ++ "\n")
 226            Ok parsed ->
 227              select (Right (parsed, args))
 228                  [ (helpRequested parsed,
 229                     Left (ExitSuccess, usageHelp progname options))
 230                  , (verRequested parsed,
 231                     Left (ExitSuccess, versionInfo progname))
 232                  , (compRequested parsed,
 233                     Left (ExitSuccess, completionInfo progname options
 234                                          arguments))
 235                  ]
 236     (_, _, errs) ->
 237       Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++
 238             usageHelp progname options)