2014-03-31 03:37:54 +00:00
|
|
|
module Propellor.Property.Cmd (
|
2014-03-30 19:31:57 +00:00
|
|
|
cmdProperty,
|
|
|
|
cmdProperty',
|
2014-04-01 05:12:05 +00:00
|
|
|
scriptProperty,
|
|
|
|
serviceRunning,
|
2014-03-30 19:31:57 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Control.Applicative
|
2014-03-31 02:14:14 +00:00
|
|
|
import Data.List
|
2014-03-30 19:31:57 +00:00
|
|
|
|
2014-03-31 03:37:54 +00:00
|
|
|
import Propellor.Types
|
2014-03-30 19:31:57 +00:00
|
|
|
import Utility.Monad
|
|
|
|
import Utility.SafeCommand
|
|
|
|
import Utility.Env
|
|
|
|
|
2014-03-31 03:55:59 +00:00
|
|
|
-- | A property that can be satisfied by running a command.
|
|
|
|
--
|
|
|
|
-- The command must exit 0 on success.
|
|
|
|
cmdProperty :: String -> [String] -> Property
|
2014-03-30 19:31:57 +00:00
|
|
|
cmdProperty cmd params = cmdProperty' cmd params []
|
|
|
|
|
2014-03-31 03:55:59 +00:00
|
|
|
-- | A property that can be satisfied by running a command,
|
|
|
|
-- with added environment.
|
|
|
|
cmdProperty' :: String -> [String] -> [(String, String)] -> Property
|
2014-03-30 19:31:57 +00:00
|
|
|
cmdProperty' cmd params env = Property desc $ do
|
|
|
|
env' <- addEntries env <$> getEnvironment
|
2014-03-31 03:55:59 +00:00
|
|
|
ifM (boolSystemEnv cmd (map Param params) (Just env'))
|
2014-03-30 19:31:57 +00:00
|
|
|
( return MadeChange
|
|
|
|
, return FailedChange
|
|
|
|
)
|
|
|
|
where
|
2014-03-31 03:55:59 +00:00
|
|
|
desc = unwords $ cmd : params
|
2014-03-31 02:14:14 +00:00
|
|
|
|
2014-03-31 03:55:59 +00:00
|
|
|
-- | A property that can be satisfied by running a series of shell commands.
|
2014-03-31 02:14:14 +00:00
|
|
|
scriptProperty :: [String] -> Property
|
2014-03-31 03:55:59 +00:00
|
|
|
scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
|
2014-03-31 02:14:14 +00:00
|
|
|
where
|
2014-03-31 02:23:18 +00:00
|
|
|
shellcmd = intercalate " ; " ("set -e" : script)
|
2014-04-01 05:12:05 +00:00
|
|
|
|
|
|
|
-- | Ensures that a service is running.
|
|
|
|
--
|
|
|
|
-- Note that due to the general poor state of init scripts, the best
|
|
|
|
-- we can do is try to start the service, and if it fails, assume
|
|
|
|
-- this means it's already running.
|
|
|
|
serviceRunning :: String -> Property
|
|
|
|
serviceRunning svc = scriptProperty
|
|
|
|
["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
|
2014-04-01 18:08:35 +00:00
|
|
|
`describe` ("running " ++ svc)
|