propellor spin

propellor.cabal

@@ -126,6 +126,7 @@ Library
     Propellor.PrivData.Paths
     Propellor.Protocol
     Propellor.Shim
+    Propellor.Property.Chroot.Util
     Utility.Applicative
     Utility.Data
     Utility.Directory

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
@@ -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

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"

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,7 @@ built target system@(System _ arch) config =
 			, Param target
 			]
 		cmd <- fromMaybe "debootstrap" <$> programPath
-		de <- debootstrapEnv
+		de <- standardPathEnv
 		ifM (boolSystemEnv cmd params (Just de))
 			( do
 				fixForeignDev target
@@ -234,15 +235,6 @@ makeWrapperScript dir = do
 		]
 	modifyFileMode wrapperScript (addModes $ readModes ++ executeModes)
 
--- workaround for http://bugs.debian.org/770658
-debootstrapEnv :: IO [(String, String)]
-debootstrapEnv = do
-	path <- getEnvDefault "PATH" "/bin"
-	addEntry "PATH" (path ++ debianPath)
-		<$> getEnvironment
-  where
-	debianPath = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
-
 -- Work around for http://bugs.debian.org/770217
 makeDevicesTarball :: IO ()
 makeDevicesTarball = do
@@ -257,7 +249,7 @@ makeDevicesTarball = do
 
 fixForeignDev :: FilePath -> IO ()
 fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $ do
-	de <- debootstrapEnv
+	de <- standardPathEnv
 	void $ boolSystemEnv "chroot"
 		[ File target
 		, Param "sh"