Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Common.hs @ 37904802

History | View | Annotate | Download (8.7 kB)

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