2014-04-10 21:22:32 +00:00
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
|
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,
|
2014-04-01 20:58:11 +00:00
|
|
|
userScriptProperty,
|
2014-03-30 19:31:57 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Control.Applicative
|
2014-03-31 02:14:14 +00:00
|
|
|
import Data.List
|
2014-04-10 21:22:32 +00:00
|
|
|
import "mtl" Control.Monad.Reader
|
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-04-10 21:22:32 +00:00
|
|
|
cmdProperty' cmd params env = Property desc $ liftIO $ do
|
2014-03-30 19:31:57 +00:00
|
|
|
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
|
|
|
|
2014-04-01 20:58:11 +00:00
|
|
|
-- | A property that can satisfied by running a series of shell commands,
|
2014-04-03 06:27:17 +00:00
|
|
|
-- as user (cd'd to their home directory).
|
2014-04-01 20:58:11 +00:00
|
|
|
userScriptProperty :: UserName -> [String] -> Property
|
|
|
|
userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]
|
|
|
|
where
|
|
|
|
shellcmd = intercalate " ; " ("set -e" : "cd" : script)
|