Synnefo » snf-ganeti » ganeti-local

	htools/Ganeti/Common.hs \

	htest/Test/Ganeti/Common.hs \

	htest/Test/Ganeti/Daemon.hs \

{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for the 'Ganeti.Common' module.

-}

{-

Copyright (C) 2009, 2010, 2011, 2012 Google Inc.

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 Test.Ganeti.Common

  ( testCommon

  , checkOpt

  , passFailOpt

  , checkEarlyExit

  ) where

import Test.QuickCheck hiding (Result)

import Test.HUnit

import qualified System.Console.GetOpt as GetOpt

import System.Exit

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Ganeti.BasicTypes

import Ganeti.Common

-- | Helper to check for correct parsing of an option.

checkOpt :: (StandardOptions b) =>

            (a -> Maybe String) -- ^ Converts the value into a cmdline form

         -> b                   -- ^ The default options

         -> (String -> c)       -- ^ Fail test function

         -> (String -> d -> d -> c) -- ^ Check for equality function

         -> (a -> d)            -- ^ Transforms the value to a compare val

         -> (a, GenericOptType b, b -> d) -- ^ Triple of value, the

                                          -- option, function to

                                          -- extract the set value

                                          -- from the options

         -> c

checkOpt repr defaults failfn eqcheck valfn

         (val, opt@(GetOpt.Option _ longs _ _), fn) =

  case longs of

    [] -> failfn "no long options?"

    cmdarg:_ ->

      case parseOptsInner defaults

             ["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)]

             "prog" [opt] of

        Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++

                  show e

        Right (options, _) -> eqcheck ("Wrong value in option " ++

                                       cmdarg ++ "?") (valfn val) (fn options)

-- | Helper to check for correct and incorrect parsing of an option.

passFailOpt :: (StandardOptions b) =>

               b                 -- ^ The default options

            -> (String -> c)     -- ^ Fail test function

            -> c                 -- ^ Pass function

            -> (GenericOptType b, String, String)

            -- ^ The list of enabled options, fail value and pass value

            -> c

passFailOpt defaults failfn passfn

              (opt@(GetOpt.Option _ longs _ _), bad, good) =

  let prefix = "--" ++ head longs ++ "="

      good_cmd = prefix ++ good

      bad_cmd = prefix ++ bad in

  case (parseOptsInner defaults [bad_cmd]  "prog" [opt],

        parseOptsInner defaults [good_cmd] "prog" [opt]) of

    (Left _,  Right _) -> passfn

    (Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++

                          "' succeeded when it shouldn't"

    (Left  _, Left  _) -> failfn $ "Command line '" ++ good_cmd ++

                          "' failed when it shouldn't"

    (Right _, Left  _) ->

      failfn $ "Command line '" ++ bad_cmd ++

               "' succeeded when it shouldn't, while command line '" ++

               good_cmd ++ "' failed when it shouldn't"

-- | Helper to test that a given option is accepted OK with quick exit.

checkEarlyExit :: (StandardOptions a) =>

                  a -> String -> [GenericOptType a] -> Assertion

checkEarlyExit defaults name options =

  mapM_ (\param ->

           case parseOptsInner defaults [param] name options of

             Left (code, _) ->

               assertEqual ("Program " ++ name ++

                            " returns invalid code " ++ show code ++

                            " for option " ++ param) ExitSuccess code

             _ -> assertFailure $ "Program " ++ name ++

                  " doesn't consider option " ++

                  param ++ " as early exit one"

        ) ["-h", "--help", "-V", "--version"]

-- | Test parseYesNo.

prop_parse_yes_no :: Bool -> Bool -> String -> Property

prop_parse_yes_no def testval val =

  forAll (elements [val, "yes", "no"]) $ \actual_val ->

  if testval

    then parseYesNo def Nothing ==? Ok def

    else let result = parseYesNo def (Just actual_val)

         in if actual_val `elem` ["yes", "no"]

              then result ==? Ok (actual_val == "yes")

              else property $ isBad result

testSuite "Common"

          [ 'prop_parse_yes_no

          ]

{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for ganeti-htools.

-}

{-

Copyright (C) 2009, 2010, 2011, 2012 Google Inc.

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 Test.Ganeti.Daemon (testDaemon) where

import Test.QuickCheck hiding (Result)

import Test.HUnit

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Test.Ganeti.Common

import Ganeti.Common

import Ganeti.Daemon as Daemon

-- | Test a few string arguments.

prop_string_arg :: String -> Property

prop_string_arg argument =

  let args = [ (argument, oBindAddress, optBindAddress)

             ]

  in conjoin $

     map (checkOpt Just defaultOptions failTest (const (==?)) Just) args

-- | Test a few integer arguments (only one for now).

prop_numeric_arg :: Int -> Property

prop_numeric_arg argument =

  checkOpt (Just . show) defaultOptions

    failTest (const (==?)) (Just . fromIntegral)

    (argument, oPort 0, optPort)

-- | Test a few boolean arguments.

case_bool_arg :: Assertion

case_bool_arg =

  mapM_ (checkOpt (const Nothing) defaultOptions assertFailure

                  assertEqual id)

        [ (False, oNoDaemonize,  optDaemonize)

        , (True,  oDebug,        optDebug)

        , (True,  oNoUserChecks, optNoUserChecks)

        ]

-- | Tests a few invalid arguments.

case_wrong_arg :: Assertion

case_wrong_arg = do

  mapM_ (passFailOpt defaultOptions assertFailure (return ()))

        [ (oSyslogUsage, "foo", "yes")

        , (oPort 0,      "x",   "10")

        ]

-- | Test that the option list supports some common options.

case_stdopts :: Assertion

case_stdopts =

  checkEarlyExit defaultOptions "prog" [oShowHelp, oShowVer]

testSuite "Daemon"

          [ 'prop_string_arg

          , 'prop_numeric_arg

          , 'case_bool_arg

          , 'case_wrong_arg

          , 'case_stdopts

          ]

import Test.HUnit

import Test.Ganeti.Common

import Ganeti.HTools.CLI as CLI

  in parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)

  in case parseISpecString descr str of

prop_string_arg :: String -> Property

prop_string_arg argument =

  let args = [ (oDataFile,      optDataFile)

             , (oDynuFile,      optDynuFile)

             , (oSaveCluster,   optSaveCluster)

             , (oPrintCommands, optShowCmds)

             , (oLuxiSocket,    optLuxi)

             , (oIAllocSrc,     optIAllocSrc)

             ]

  in conjoin $ map (\(o, opt) ->

                      checkOpt Just defaultOptions

                      failTest (const (==?)) Just (argument, o, opt)) args

-- | Test a few positive arguments.

prop_numeric_arg :: Positive Double -> Property

prop_numeric_arg (Positive argument) =

  let args = [ (oMaxCpu,     optMcpu)

             , (oMinDisk,    Just . optMdsk)

             , (oMinGain,    Just . optMinGain)

             , (oMinGainLim, Just . optMinGainLim)

             , (oMinScore,   Just . optMinScore)

  in conjoin $

     map (\(x, y) -> checkOpt (Just . show) defaultOptions

                     failTest (const (==?)) Just (argument, x, y)) args

-- | Test a few boolean arguments.

case_bool_arg :: Assertion

case_bool_arg =

  mapM_ (checkOpt (const Nothing) defaultOptions assertFailure

                  assertEqual id)

        [ (False, oDiskMoves,    optDiskMoves)

        , (False, oInstMoves,    optInstMoves)

        , (True,  oEvacMode,     optEvacMode)

        , (True,  oExecJobs,     optExecJobs)

        , (True,  oNoHeaders,    optNoHeaders)

        , (True,  oNoSimulation, optNoSimulation)

        ]

-- | Tests a few invalid arguments.

case_wrong_arg :: Assertion

case_wrong_arg = do

  mapM_ (passFailOpt defaultOptions assertFailure (return ()))

        [ (oSpindleUse,   "-1", "1")

        , (oSpindleUse,   "a",  "1")

        , (oMaxCpu,       "-1", "1")

        , (oMinDisk,      "a",  "1")

        , (oMinGainLim,   "a",  "1")

        , (oMaxSolLength, "x",  "10")

        , (oStdSpec,      "no-such-spec", "1,1,1")

        , (oTieredSpec,   "no-such-spec", "1,1,1")

        ]

-- | Test that all binaries support some common options.

case_stdopts :: Assertion

case_stdopts =

  mapM_ (\(name, (_, o)) -> checkEarlyExit defaultOptions name o)

      Program.personalities

          , 'prop_string_arg

          , 'prop_numeric_arg

          , 'case_bool_arg

          , 'case_wrong_arg

          , 'case_stdopts

import Test.Ganeti.Common

import Test.Ganeti.Daemon

  , (True, testCommon)

  , (True, testDaemon)

{-| Base common functionality.

This module holds common functionality shared across Ganeti daemons,

HTools and any other programs.

-}

{-

Copyright (C) 2009, 2010, 2011, 2012 Google Inc.

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 Ganeti.Common

  ( GenericOptType

  , StandardOptions(..)

  , oShowHelp

  , oShowVer

  , usageHelp

  , versionInfo

  , reqWithConversion

  , parseYesNo

  , parseOpts

  , parseOptsInner

  ) where

import Control.Monad (foldM)

import qualified Data.Version

import System.Console.GetOpt

import System.Exit

import System.Info

import System.IO

import Text.Printf (printf)

import Ganeti.BasicTypes

import qualified Ganeti.Version as Version (version)

-- | Abrreviation for the option type.

type GenericOptType a = OptDescr (a -> Result a)

-- | Type class for options which support help and version.

class StandardOptions a where

  helpRequested :: a -> Bool

  verRequested  :: a -> Bool

  requestHelp   :: a -> a

  requestVer    :: a -> a

-- | Options to request help output.

oShowHelp :: (StandardOptions a) => GenericOptType a

oShowHelp = Option "h" ["help"] (NoArg (Ok . requestHelp))

            "show help"

oShowVer :: (StandardOptions a) => GenericOptType a

oShowVer = Option "V" ["version"] (NoArg (Ok . requestVer))

           "show the version of the program"

-- | Usage info.

usageHelp :: String -> [GenericOptType a] -> String

usageHelp progname =

  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"

             progname Version.version progname)

-- | Show the program version info.

versionInfo :: String -> String

versionInfo progname =

  printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"

         progname Version.version compilerName

         (Data.Version.showVersion compilerVersion)

         os arch

-- | Helper for parsing a yes\/no command line flag.

parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)

           -> Maybe String -- ^ Parameter value

           -> Result Bool  -- ^ Resulting boolean value

parseYesNo v Nothing      = return v

parseYesNo _ (Just "yes") = return True

parseYesNo _ (Just "no")  = return False

parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++

                                  "', pass one of 'yes' or 'no'")

-- | Helper function for required arguments which need to be converted

-- as opposed to stored just as string.

reqWithConversion :: (String -> Result a)

                  -> (a -> b -> Result b)

                  -> String

                  -> ArgDescr (b -> Result b)

reqWithConversion conversion_fn updater_fn metavar =

  ReqArg (\string_opt opts -> do

            parsed_value <- conversion_fn string_opt

            updater_fn parsed_value opts) metavar

-- | Command line parser, using a generic 'Options' structure.

parseOpts :: (StandardOptions a) =>

             a                      -- ^ The default options

          -> [String]               -- ^ The command line arguments

          -> String                 -- ^ The program name

          -> [GenericOptType a]     -- ^ The supported command line options

          -> IO (a, [String])       -- ^ The resulting options and

                                    -- leftover arguments

parseOpts defaults argv progname options =

  case parseOptsInner defaults argv progname options of

    Left (code, msg) -> do

      hPutStr (if code == ExitSuccess then stdout else stderr) msg

      exitWith code

    Right result ->

      return result

-- | Inner parse options. The arguments are similar to 'parseOpts',

-- but it returns either a 'Left' composed of exit code and message,

-- or a 'Right' for the success case.

parseOptsInner :: (StandardOptions a) =>

                  a

               -> [String]

               -> String

               -> [GenericOptType a]

               -> Either (ExitCode, String) (a, [String])

parseOptsInner defaults argv progname options  =

  case getOpt Permute options argv of

    (opts, args, []) ->

      case foldM (flip id) defaults opts of

           Bad msg -> Left (ExitFailure 1,

                            "Error while parsing command line arguments:\n"

                            ++ msg ++ "\n")

           Ok parsed ->

             select (Right (parsed, args))

                 [ (helpRequested parsed,

                    Left (ExitSuccess, usageHelp progname options))

                 , (verRequested parsed,

                    Left (ExitSuccess, versionInfo progname))

                 ]

    (_, _, errs) ->

      Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++

            usageHelp progname options)

import Ganeti.Common as Common

instance StandardOptions DaemonOptions where

  helpRequested = optShowHelp

  verRequested  = optShowVer

  requestHelp   = \opts -> opts { optShowHelp = True }

  requestVer    = \opts -> opts { optShowVer  = True }

type OptType = GenericOptType DaemonOptions

  parseOpts defaultOptions cmd_args cmd options

  , defaultOptions

  , Ganeti.HTools.CLI.parseOpts

import Ganeti.Common as Common

type OptType = GenericOptType Options

instance StandardOptions Options where

  helpRequested = optShowHelp

  verRequested  = optShowVer

  requestHelp   = \opts -> opts { optShowHelp = True }

  requestVer    = \opts -> opts { optShowVer  = True }

                (reqWithConversion diskTemplateFromRaw

                 (\dt opts -> Ok opts { optDiskTemplate = Just dt })

              (reqWithConversion (tryRead "parsing spindle-use")

               (\su opts -> do

                  when (su < 0) $

                       fail "Invalid value of the spindle-use\

                            \ (expected >= 0)"

                  return $ opts { optSpindleUse = Just su })

          (reqWithConversion (tryRead "parsing max-cpu")

           (\mcpu opts -> do

              when (mcpu <= 0) $

                   fail "Invalid value of the max-cpu ratio,\

                        \ expected >0"

              return $ opts { optMcpu = Just mcpu }) "RATIO")

                (reqWithConversion (tryRead "max solution length")

                 (\i opts -> Ok opts { optMaxLength = i }) "N")

           (reqWithConversion (tryRead "min free disk space")

            (\n opts -> Ok opts { optMdsk = n }) "RATIO")

           (reqWithConversion (tryRead "min gain")

            (\g opts -> Ok opts { optMinGain = g }) "DELTA")

            (reqWithConversion (tryRead "min gain limit")

             (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")

            (reqWithConversion (tryRead "min score")

             (\e opts -> Ok opts { optMinScore = e }) "EPSILON")

-- | Wrapper over 'Common.parseOpts' with our custom options.

parseOpts = Common.parseOpts defaultOptions

printKeys prefix =

  mapM_ (\(k, v) ->

           printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))

           -> Bool      -- ^ Whether output should be machine readable;

                        -- note: if not, there is nothing to print