propellor spin

This commit is contained in:
Joey Hess 2014-11-22 22:37:25 -04:00
parent ca09087caf
commit 5fefb161c3
Failed to extract signature
4 changed files with 23 additions and 12 deletions

View File

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

View File

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

View File

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

View File

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