Merge branch 'joeyconfig'

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]