summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Chroot.hs7
-rw-r--r--src/Propellor/Property/Chroot/Util.hs15
-rw-r--r--src/Propellor/Property/Debootstrap.hs37
-rw-r--r--src/Propellor/Property/Docker.hs2
-rw-r--r--src/Propellor/Property/Git.hs25
-rw-r--r--src/Propellor/Property/Group.hs14
-rw-r--r--src/Propellor/Property/User.hs11
7 files changed, 99 insertions, 12 deletions
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index c3b14a8e..3da8b0d6 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -11,6 +11,7 @@ module Propellor.Property.Chroot (
import Propellor
import Propellor.Types.Chroot
+import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Systemd.Core as Systemd
import qualified Propellor.Shim as Shim
@@ -88,7 +89,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
let me = localdir </> "propellor"
shim <- liftIO $ ifM (doesDirectoryExist d)
( pure (Shim.file me d)
- , Shim.setup me d
+ , Shim.setup me Nothing d
)
ifM (liftIO $ bindmount shim)
( chainprovision shim
@@ -109,12 +110,14 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
chainprovision shim = do
parenthost <- asks hostName
cmd <- liftIO $ toChain parenthost c systemdonly
+ pe <- liftIO standardPathEnv
let p = mkproc
[ shim
, "--continue"
, show cmd
]
- liftIO $ withHandle StdoutHandle createProcessSuccess p
+ let p' = p { env = Just pe }
+ liftIO $ withHandle StdoutHandle createProcessSuccess p'
processChainOutput
toChain :: HostName -> Chroot -> Bool -> IO CmdLine
diff --git a/src/Propellor/Property/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs
new file mode 100644
index 00000000..feb71d01
--- /dev/null
+++ b/src/Propellor/Property/Chroot/Util.hs
@@ -0,0 +1,15 @@
+module Propellor.Property.Chroot.Util where
+
+import Utility.Env
+import Control.Applicative
+
+-- When chrooting, it's useful to ensure that PATH has all the standard
+-- directories in it. This adds those directories to whatever PATH is
+-- already set.
+standardPathEnv :: IO [(String, String)]
+standardPathEnv = do
+ path <- getEnvDefault "PATH" "/bin"
+ addEntry "PATH" (path ++ std)
+ <$> getEnvironment
+ where
+ std = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 0611e735..ab5bddf4 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -8,6 +8,7 @@ module Propellor.Property.Debootstrap (
import Propellor
import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.Chroot.Util
import Utility.Path
import Utility.SafeCommand
import Utility.FileMode
@@ -78,7 +79,8 @@ built target system@(System _ arch) config =
, Param target
]
cmd <- fromMaybe "debootstrap" <$> programPath
- ifM (boolSystem cmd params)
+ de <- standardPathEnv
+ ifM (boolSystemEnv cmd params (Just de))
( do
fixForeignDev target
return MadeChange
@@ -141,8 +143,26 @@ installed = RevertableProperty install remove
aptremove = Apt.removed ["debootstrap"]
sourceInstall :: Property
-sourceInstall = property "debootstrap installed from source"
- (liftIO sourceInstall')
+sourceInstall = property "debootstrap installed from source" (liftIO sourceInstall')
+ `requires` perlInstalled
+ `requires` arInstalled
+
+perlInstalled :: Property
+perlInstalled = check (not <$> inPath "perl") $ property "perl installed" $ do
+ v <- liftIO $ firstM id
+ [ yumInstall "perl"
+ ]
+ if isJust v then return MadeChange else return FailedChange
+
+arInstalled :: Property
+arInstalled = check (not <$> inPath "ar") $ property "ar installed" $ do
+ v <- liftIO $ firstM id
+ [ yumInstall "binutils"
+ ]
+ if isJust v then return MadeChange else return FailedChange
+
+yumInstall :: String -> IO Bool
+yumInstall p = boolSystem "yum" [Param "-y", Param "install", Param p]
sourceInstall' :: IO Result
sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
@@ -228,18 +248,23 @@ makeDevicesTarball = do
tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz"
fixForeignDev :: FilePath -> IO ()
-fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $
- void $ boolSystem "chroot"
+fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $ do
+ de <- standardPathEnv
+ void $ boolSystemEnv "chroot"
[ File target
, Param "sh"
, Param "-c"
, Param $ intercalate " && "
- [ "rm -rf /dev"
+ [ "apt-get update"
+ , "apt-get -y install makedev"
+ , "rm -rf /dev"
, "mkdir /dev"
, "cd /dev"
+ , "mount -t proc proc /proc"
, "/sbin/MAKEDEV std ptmx fd consoleonly"
]
]
+ (Just de)
foreignDevFlag :: FilePath
foreignDevFlag = "/dev/.propellor-foreign-dev"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 460bc3ec..586ebc2e 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -377,7 +377,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
liftIO $ do
clearProvisionedFlag cid
createDirectoryIfMissing True (takeDirectory $ identFile cid)
- shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
+ shim <- liftIO $ Shim.setup (localdir </> "propellor") Nothing (localdir </> shimdir cid)
liftIO $ writeFile (identFile cid) (show ident)
ensureProperty $ boolProperty "run" $ runContainer img
(runps ++ ["-i", "-d", "-t"])
diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs
index 8d49cbd0..eb7801c1 100644
--- a/src/Propellor/Property/Git.hs
+++ b/src/Propellor/Property/Git.hs
@@ -57,8 +57,9 @@ type Branch = String
-- | Specified git repository is cloned to the specified directory.
--
--- If the firectory exists with some other content, it will be recursively
--- deleted.
+-- If the directory exists with some other content (either a non-git
+-- repository, or a git repository cloned from some other location),
+-- it will be recursively deleted first.
--
-- A branch can be specified, to check out.
cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property
@@ -94,3 +95,23 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
isGitDir :: FilePath -> IO Bool
isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir])
+
+data GitShared = Shared GroupName | SharedAll | NotShared
+
+bareRepo :: FilePath -> UserName -> GitShared -> Property
+bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $
+ dirExists repo : case gitshared of
+ NotShared ->
+ [ ownerGroup repo user user
+ , userScriptProperty user ["git", "init", "--bare", "--shared=false", repo]
+ ]
+ SharedAll ->
+ [ ownerGroup repo user user
+ , userScriptProperty user ["git", "init", "--bare", "--shared=all", repo]
+ ]
+ Shared group' ->
+ [ ownerGroup repo user group'
+ , userScriptProperty user ["git", "init", "--bare", "--shared=group", repo]
+ ]
+ where
+ isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo'])
diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs
new file mode 100644
index 00000000..f03510cf
--- /dev/null
+++ b/src/Propellor/Property/Group.hs
@@ -0,0 +1,14 @@
+module Propellor.Property.Group where
+
+import Propellor
+
+type GID = Int
+
+exists :: GroupName -> Maybe GID -> Property
+exists group' mgid = check test (cmdProperty "addgroup" $ args mgid)
+ `describe` unwords ["group", group']
+ where
+ groupFile = "/etc/group"
+ test = not <$> elem group' <$> words <$> readProcess "cut" ["-d:", "-f1", groupFile]
+ args Nothing = [group']
+ args (Just gid) = ["--gid", show gid, group']
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index f9c400a8..6a51703a 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -30,7 +30,7 @@ hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus use
hasPassword :: UserName -> Context -> Property
hasPassword user context = withPrivData (Password user) context $ \getpassword ->
- property (user ++ " has password") $
+ property (user ++ " has password") $
getpassword $ \password -> makeChange $
withHandle StdinHandle createProcessSuccess
(proc "chpasswd" []) $ \h -> do
@@ -60,3 +60,12 @@ isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
homedir :: UserName -> IO FilePath
homedir user = homeDirectory <$> getUserEntryForName user
+
+hasGroup :: UserName -> GroupName -> Property
+hasGroup user group' = check test $ cmdProperty "adduser"
+ [ user
+ , group'
+ ]
+ `describe` unwords ["user", user, "in group", group']
+ where
+ test = not . elem group' . words <$> readProcess "groups" [user]