Merge branch 'joeyconfig'

4 files changed, 26 insertions, 25 deletions

diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs
index 5678a865..767d6ef7 100644
--- a/src/Propellor/Property/Bootstrap.hs
+++ b/src/Propellor/Property/Bootstrap.hs
@@ -17,17 +17,17 @@ data RepoSource
 -- | Bootstraps a propellor installation into
 -- /usr/local/propellor/
 --
--- Normally, propellor is already bootstrapped when it runs, so this
--- property is not useful. However, this can be useful inside a
--- chroot used to build a disk image, to make the disk image
--- have propellor installed.
+-- This property only does anything when used inside a chroot.
+-- This is particularly useful inside a chroot used to build a
+-- disk image, to make the disk image have propellor installed.
 --
 -- The git repository is cloned (or pulled to update if it already exists).
 --
 -- All build dependencies are installed, using distribution packages
 -- or falling back to using cabal.
 bootstrappedFrom :: RepoSource -> Property Linux
-bootstrappedFrom reposource = go `requires` clonedFrom reposource
+bootstrappedFrom reposource = check inChroot $
+	go `requires` clonedFrom reposource
   where
 	go :: Property Linux
 	go = property "Propellor bootstrapped" $ do
@@ -35,7 +35,8 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource
 		assumeChange $ exposeTrueLocaldir $ const $ 
 			runShellCommand $ buildShellCommand
 				[ "cd " ++ localdir
-				, bootstrapPropellorCommand system
+				, checkDepsCommand system
+				, buildCommand
 				]
 
 -- | Clones the propellor repeository into /usr/local/propellor/
@@ -83,7 +84,7 @@ clonedFrom reposource = case reposource of
 	-- configuration.
 	copygitconfig :: Property Linux
 	copygitconfig = property ("Propellor repo git config copied from outside the chroot") $ do
-		let gitconfig = localdir <> ".git" <> "config"
+		let gitconfig = localdir </> ".git" </> "config"
 		cfg <- liftIO $ B.readFile gitconfig
 		exposeTrueLocaldir $ const $
 			liftIO $ B.writeFile gitconfig cfg
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index ad2ae705..65749e34 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -37,7 +37,6 @@ import Utility.Split
 
 import qualified Data.Map as M
 import System.Posix.Directory
-import System.Console.Concurrent
 
 -- | Specification of a chroot. Normally you'll use `debootstrapped` or
 -- `bootstrapped` to construct a Chroot value.
@@ -201,9 +200,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
 			, "--continue"
 			, show cmd
 			]
-		let p' = p { env = Just pe }
-		r <- liftIO $ withHandle StdoutHandle createProcessSuccess p'
-			processChainOutput
+		r <- liftIO $ chainPropellor (p { env = Just pe })
 		liftIO cleanup
 		return r
 
@@ -223,13 +220,12 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 	go h = do
 		changeWorkingDirectory localdir
 		when onconsole forceConsole
-		onlyProcess (provisioningLock loc) $ do
-			r <- runPropellor (setInChroot h) $ ensureChildProperties $
-				if systemdonly
-					then [toChildProperty Systemd.installed]
-					else hostProperties h
-			flushConcurrentOutput
-			putStrLn $ "\n" ++ show r
+		onlyProcess (provisioningLock loc) $
+			runChainPropellor (setInChroot h) $
+				ensureChildProperties $
+					if systemdonly
+						then [toChildProperty Systemd.installed]
+						else hostProperties h
 chain _ _ = errorMessage "bad chain command"
 
 inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 90b7010b..d5898d7c 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -247,7 +247,7 @@ getMountSz szm l (Just mntpt) =
 --
 -- If the file is too large, truncates it down to the specified size.
 imageExists :: FilePath -> ByteSize -> Property Linux
-imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
+imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do
 	ms <- catchMaybeIO $ getFileStatus img
 	case ms of
 		Just s
@@ -258,6 +258,12 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
 		_ -> do
 			L.writeFile img (L.replicate (fromIntegral sz) 0)
 			return MadeChange
+  where
+	sz = ceiling (fromInteger isz / sectorsize) * ceiling sectorsize
+	-- Disks have a sector size, and making a disk image not
+	-- aligned to a sector size will confuse some programs.
+	-- Common sector sizes are 512 and 4096; use 4096 as it's larger.
+	sectorsize = 4096 :: Double
 
 -- | A pair of properties. The first property is satisfied within the
 -- chroot, and is typically used to download the boot loader.
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index d53bab71..66418253 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -576,8 +576,7 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
 	let p = inContainerProcess cid
 		(if isConsole msgh then ["-it"] else [])
 		(shim : params)
-	r <- withHandle StdoutHandle createProcessSuccess p $
-		processChainOutput
+	r <- chainPropellor p
 	when (r /= FailedChange) $
 		setProvisionedFlag cid
 	return r
@@ -596,10 +595,9 @@ chain hostlist hn s = case toContainerId s of
   where
 	go cid h = do
 		changeWorkingDirectory localdir
-		onlyProcess (provisioningLock cid) $ do
-			r <- runPropellor h $ ensureChildProperties $ hostProperties h
-			flushConcurrentOutput
-			putStrLn $ "\n" ++ show r
+		onlyProcess (provisioningLock cid) $
+			runChainPropellor h $ 
+				ensureChildProperties $ hostProperties h
 
 stopContainer :: ContainerId -> IO Bool
 stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]