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   , optComplYesNo
  34   , oShowHelp
  35   , oShowVer
  36   , oShowComp
  37   , usageHelp
  38   , versionInfo
  39   , reqWithConversion
  40   , parseYesNo
  41   , parseOpts
  42   , parseOptsInner
  43   ) where
  44
  45 import Control.Monad (foldM)
  46 import Data.Char (toLower)
  47 import Data.List (intercalate, stripPrefix)
  48 import Data.Maybe (fromMaybe)
  49 import qualified Data.Version
  50 import System.Console.GetOpt
  51 import System.Exit
  52 import System.Info
  53 import System.IO
  54 import Text.Printf (printf)
  55
  56 import Ganeti.BasicTypes
  57 import qualified Ganeti.Version as Version (version)
  58
  59 -- | Parameter type.
  60 data OptCompletion = OptComplNone             -- ^ No parameter to this option
  61                    | OptComplFile             -- ^ An existing file
  62                    | OptComplDir              -- ^ An existing directory
  63                    | OptComplHost             -- ^ Host name
  64                    | OptComplInetAddr         -- ^ One ipv4\/ipv6 address
  65                    | OptComplOneNode          -- ^ One node
  66                    | OptComplManyNodes        -- ^ Many nodes, comma-sep
  67                    | OptComplOneInstance      -- ^ One instance
  68                    | OptComplManyInstances    -- ^ Many instances, comma-sep
  69                    | OptComplOneOs            -- ^ One OS name
  70                    | OptComplOneIallocator    -- ^ One iallocator
  71                    | OptComplInstAddNodes     -- ^ Either one or two nodes
  72                    | OptComplOneGroup         -- ^ One group
  73                    | OptComplNumeric          -- ^ Float values
  74                    | OptComplString           -- ^ Arbitrary string
  75                    | OptComplChoices [String] -- ^ List of string choices
  76                    deriving (Show, Read, Eq)
  77
  78 -- | Yes\/no choices completion.
  79 optComplYesNo :: OptCompletion
  80 optComplYesNo = OptComplChoices ["yes", "no"]
  81
  82 -- | Text serialisation for 'OptCompletion', used on the Python side.
  83 complToText :: OptCompletion -> String
  84 complToText (OptComplChoices choices) = "choices " ++ intercalate "," choices
  85 complToText compl =
  86   let show_compl = show compl
  87       stripped = stripPrefix "OptCompl" show_compl
  88   in map toLower $ fromMaybe show_compl stripped
  89
  90 -- | Abrreviation for the option type.
  91 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
  92
  93 -- | Type class for options which support help and version.
  94 class StandardOptions a where
  95   helpRequested :: a -> Bool
  96   verRequested  :: a -> Bool
  97   compRequested :: a -> Bool
  98   requestHelp   :: a -> a
  99   requestVer    :: a -> a
 100   requestComp   :: a -> a
 101
 102 -- | Option to request help output.
 103 oShowHelp :: (StandardOptions a) => GenericOptType a
 104 oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
 105              OptComplNone)
 106
 107 -- | Option to request version information.
 108 oShowVer :: (StandardOptions a) => GenericOptType a
 109 oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
 110             "show the version of the program",
 111             OptComplNone)
 112
 113 -- | Option to request completion information
 114 oShowComp :: (StandardOptions a) => GenericOptType a
 115 oShowComp =
 116   (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
 117    "show completion info", OptComplNone)
 118
 119 -- | Usage info.
 120 usageHelp :: String -> [GenericOptType a] -> String
 121 usageHelp progname =
 122   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 123              progname Version.version progname) . map fst
 124
 125 -- | Show the program version info.
 126 versionInfo :: String -> String
 127 versionInfo progname =
 128   printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 129          progname Version.version compilerName
 130          (Data.Version.showVersion compilerVersion)
 131          os arch
 132
 133 -- | Show completion info.
 134 completionInfo :: String -> [GenericOptType a] -> String
 135 completionInfo _ =
 136   unlines .
 137   map (\(Option shorts longs _ _, compinfo) ->
 138          let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
 139          in intercalate "," all_opts ++ " " ++ complToText compinfo
 140       )
 141
 142 -- | Helper for parsing a yes\/no command line flag.
 143 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
 144            -> Maybe String -- ^ Parameter value
 145            -> Result Bool  -- ^ Resulting boolean value
 146 parseYesNo v Nothing      = return v
 147 parseYesNo _ (Just "yes") = return True
 148 parseYesNo _ (Just "no")  = return False
 149 parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
 150                                   "', pass one of 'yes' or 'no'")
 151
 152 -- | Helper function for required arguments which need to be converted
 153 -- as opposed to stored just as string.
 154 reqWithConversion :: (String -> Result a)
 155                   -> (a -> b -> Result b)
 156                   -> String
 157                   -> ArgDescr (b -> Result b)
 158 reqWithConversion conversion_fn updater_fn =
 159   ReqArg (\string_opt opts -> do
 160             parsed_value <- conversion_fn string_opt
 161             updater_fn parsed_value opts)
 162
 163 -- | Command line parser, using a generic 'Options' structure.
 164 parseOpts :: (StandardOptions a) =>
 165              a                      -- ^ The default options
 166           -> [String]               -- ^ The command line arguments
 167           -> String                 -- ^ The program name
 168           -> [GenericOptType a]     -- ^ The supported command line options
 169           -> IO (a, [String])       -- ^ The resulting options and
 170                                     -- leftover arguments
 171 parseOpts defaults argv progname options =
 172   case parseOptsInner defaults argv progname options of
 173     Left (code, msg) -> do
 174       hPutStr (if code == ExitSuccess then stdout else stderr) msg
 175       exitWith code
 176     Right result ->
 177       return result
 178
 179 -- | Inner parse options. The arguments are similar to 'parseOpts',
 180 -- but it returns either a 'Left' composed of exit code and message,
 181 -- or a 'Right' for the success case.
 182 parseOptsInner :: (StandardOptions a) =>
 183                   a
 184                -> [String]
 185                -> String
 186                -> [GenericOptType a]
 187                -> Either (ExitCode, String) (a, [String])
 188 parseOptsInner defaults argv progname options  =
 189   case getOpt Permute (map fst options) argv of
 190     (opts, args, []) ->
 191       case foldM (flip id) defaults opts of
 192            Bad msg -> Left (ExitFailure 1,
 193                             "Error while parsing command line arguments:\n"
 194                             ++ msg ++ "\n")
 195            Ok parsed ->
 196              select (Right (parsed, args))
 197                  [ (helpRequested parsed,
 198                     Left (ExitSuccess, usageHelp progname options))
 199                  , (verRequested parsed,
 200                     Left (ExitSuccess, versionInfo progname))
 201                  , (compRequested parsed,
 202                     Left (ExitSuccess, completionInfo progname options))
 203                  ]
 204     (_, _, errs) ->
 205       Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++
 206             usageHelp progname options)