Merge branch 'joeyconfig'

6 files changed, 45 insertions, 20 deletions

diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index ec2b6679..0e9d00d8 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -16,6 +16,7 @@ import Propellor
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Property.Chroot.Util
+import Propellor.Property.Mount
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
 import qualified Propellor.Shim as Shim
@@ -55,8 +56,9 @@ debootstrapped system conf location = case system of
 -- | Ensures that the chroot exists and is provisioned according to its
 -- properties.
 --
--- Reverting this property removes the chroot. Note that it does not ensure
--- that any processes that might be running inside the chroot are stopped.
+-- Reverting this property removes the chroot. Anything mounted inside it
+-- is first unmounted. Note that it does not ensure that any processes
+-- that might be running inside the chroot are stopped.
 provisioned :: Chroot -> RevertableProperty
 provisioned c = provisioned' (propigateChrootInfo c) c False
 
@@ -101,6 +103,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
 		( pure (Shim.file me d)
 		, Shim.setup me Nothing d
 		)
+	liftIO mountproc
 	ifM (liftIO $ bindmount shim)
 		( chainprovision shim
 		, return FailedChange
@@ -117,6 +120,12 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
 				]
 		)
 	
+	-- /proc needs to be mounted in the chroot for the linker to use
+	-- /proc/self/exe which is necessary for some commands to work
+	mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $
+		void $ mount "proc" "proc" procloc
+	procloc = loc </> "proc"
+
 	chainprovision shim = do
 		parenthost <- asks hostName
 		cmd <- liftIO $ toChain parenthost c systemdonly
diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs
index 23f1075b..23816a94 100644
--- a/src/Propellor/Property/Cmd.hs
+++ b/src/Propellor/Property/Cmd.hs
@@ -14,18 +14,19 @@ module Propellor.Property.Cmd (
 	boolSystemEnv,
 	safeSystem,
 	safeSystemEnv,
-	shellEscape
+	shellEscape,
+	createProcess,
 ) where
 
 import Control.Applicative
 import Data.List
 import "mtl" Control.Monad.Reader
-import System.Process (CreateProcess)
 
 import Propellor.Types
 import Propellor.Property
 import Utility.SafeCommand
 import Utility.Env
+import Utility.Process (createProcess, CreateProcess)
 
 -- | A property that can be satisfied by running a command.
 --
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index f29ae56b..8d974eba 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -106,9 +106,7 @@ unpopulated d = null <$> catchDefaultIO [] (dirContents d)
 
 removetarget :: FilePath -> IO ()
 removetarget target = do
-	submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
-		. filter (dirContains target)
-		<$> mountPoints
+	submnts <- mountPointsBelow target
 	forM_ submnts umountLazy
 	removeDirectoryRecursive target
 
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index a081b1e7..ff47f4d9 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -1,22 +1,33 @@
 module Propellor.Property.Mount where
 
 import Propellor
+import Utility.Path
 
 type FsType = String
 type Source = String
 
+-- | Lists all mount points of the system.
 mountPoints :: IO [FilePath]
 mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
 
+-- | Finds all filesystems mounted inside the specified directory.
+mountPointsBelow :: FilePath -> IO [FilePath]
+mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target)
+	. filter (dirContains target)
+	<$> mountPoints
+
+-- | Filesystem type mounted at a given location.
 getFsType :: FilePath -> IO (Maybe FsType)
 getFsType mnt = catchDefaultIO Nothing $
 	headMaybe . lines
 		<$> readProcess "findmnt" ["-n", mnt, "--output", "fstype"]
 
+-- | Unmounts a device, lazily so any running processes don't block it.
 umountLazy :: FilePath -> IO ()
 umountLazy mnt =  
 	unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $
 		errorMessage $ "failed unmounting " ++ mnt
 
+-- | Mounts a device.
 mount :: FsType -> Source -> FilePath -> IO Bool
 mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt]
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index 073d5dc8..b51f4df1 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -22,7 +22,8 @@ reloaded :: Property NoInfo
 reloaded = Service.reloaded "postfix"
 
 -- | Configures postfix as a satellite system, which 
--- relays all mail through a relay host, which defaults to smtp.domain. 
+-- relays all mail through a relay host, which defaults to smtp.domain,
+-- but can be changed by mainCf "relayhost"
 --
 -- The smarthost may refuse to relay mail on to other domains, without
 -- futher coniguration/keys. But this should be enough to get cron job
@@ -34,14 +35,14 @@ satellite = check (not <$> mainCfIsSet "relayhost") setup
 	setup = trivial $ property "postfix satellite system" $ do
 		hn <- asks hostName
 		let (_, domain) = separate (== '.') hn
-		ensureProperties 
+		ensureProperties
 			[ Apt.reConfigure "postfix"
 				[ ("postfix/main_mailer_type", "select", "Satellite system")
 				, ("postfix/root_address", "string", "root")
 				, ("postfix/destinations", "string", "localhost")
 				, ("postfix/mailname", "string", hn)
 				]
-			, mainCf ("relayhost", domain)
+			, mainCf ("relayhost", "smtp." ++ domain)
 				`onChange` reloaded
 			]
 
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 86bf104c..3c638721 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -94,19 +94,24 @@ cabalDeps = flagFile go cabalupdated
 		go = userScriptProperty (User builduser) ["cabal update && cabal install git-annex --only-dependencies || true"]
 		cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache"
 
-standardAutoBuilderContainer :: Architecture -> Int -> TimeOut -> Systemd.Container
-standardAutoBuilderContainer arch buildminute timeout = Systemd.container name bootstrap
-	& os osver
-	& Apt.stdSourcesList
-	& Apt.unattendedUpgrades
-	& User.accountFor (User builduser)
-	& tree arch
-	& buildDepsApt
-	& autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout
+standardAutoBuilderContainer :: System -> Times -> TimeOut -> Systemd.Container
+standardAutoBuilderContainer osver@(System _ arch) crontime timeout =
+	Systemd.container name bootstrap
+		& standardAutoBuilder osver crontime timeout
   where
 	name = arch ++ "-git-annex-builder"
 	bootstrap = Chroot.debootstrapped osver mempty
-	osver = System (Debian Testing) arch
+
+standardAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo
+standardAutoBuilder osver@(System _ arch) crontime timeout =
+	propertyList "git-annex-builder" $ props
+		& os osver
+		& Apt.stdSourcesList
+		& Apt.unattendedUpgrades
+		& User.accountFor (User builduser)
+		& tree arch
+		& buildDepsApt
+		& autobuilder arch crontime timeout
 
 androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
 androidAutoBuilderContainer crontimes timeout =