From 82da31b3e0e9acdfbca4c48eb12ab1f28515ba10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 9 Jul 2014 22:11:31 -0400 Subject: propellor (0.8.1) unstable; urgency=medium * Run apt-get update in initial bootstrap. * --list-fields now includes a table of fields that are not currently set, but would be used if they got set. * Remove .gitignore from cabal file list, to avoid build failure on Debian. Closes: #754334 # imported from the archive --- src/Propellor/Property/Cmd.hs | 49 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 src/Propellor/Property/Cmd.hs (limited to 'src/Propellor/Property/Cmd.hs') diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs new file mode 100644 index 00000000..bcd08246 --- /dev/null +++ b/src/Propellor/Property/Cmd.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE PackageImports #-} + +module Propellor.Property.Cmd ( + cmdProperty, + cmdProperty', + scriptProperty, + userScriptProperty, +) where + +import Control.Applicative +import Data.List +import "mtl" Control.Monad.Reader + +import Propellor.Types +import Propellor.Property +import Utility.Monad +import Utility.SafeCommand +import Utility.Env + +-- | A property that can be satisfied by running a command. +-- +-- The command must exit 0 on success. +cmdProperty :: String -> [String] -> Property +cmdProperty cmd params = cmdProperty' cmd params [] + +-- | A property that can be satisfied by running a command, +-- with added environment. +cmdProperty' :: String -> [String] -> [(String, String)] -> Property +cmdProperty' cmd params env = property desc $ liftIO $ do + env' <- addEntries env <$> getEnvironment + ifM (boolSystemEnv cmd (map Param params) (Just env')) + ( return MadeChange + , return FailedChange + ) + where + desc = unwords $ cmd : params + +-- | A property that can be satisfied by running a series of shell commands. +scriptProperty :: [String] -> Property +scriptProperty script = cmdProperty "sh" ["-c", shellcmd] + where + shellcmd = intercalate " ; " ("set -e" : script) + +-- | A property that can satisfied by running a series of shell commands, +-- as user (cd'd to their home directory). +userScriptProperty :: UserName -> [String] -> Property +userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user] + where + shellcmd = intercalate " ; " ("set -e" : "cd" : script) -- cgit v1.3-2-g0d8e