summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-11-20 15:15:28 -0400
committerJoey Hess2014-11-20 15:15:28 -0400
commita4f04fcb02d76d9903c5bbc65827565bad6c2d8c (patch)
treeda5e6584ca447a0091b2001bae3d9033095b5339 /src
parent4d155864fadb5571d788ed645c842ad853f55d71 (diff)
propellor spin
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/CmdLine.hs6
-rw-r--r--src/Propellor/Engine.hs18
-rw-r--r--src/Propellor/Property/Chroot.hs76
-rw-r--r--src/Propellor/Property/Docker.hs14
-rw-r--r--src/Propellor/Shim.hs (renamed from src/Propellor/Property/Docker/Shim.hs)7
-rw-r--r--src/Propellor/Types.hs1
6 files changed, 102 insertions, 20 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 061c9700..466b60f5 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -15,7 +15,8 @@ import Propellor.Git
import Propellor.Ssh
import Propellor.Server
import qualified Propellor.Property.Docker as Docker
-import qualified Propellor.Property.Docker.Shim as DockerShim
+import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Shim as Shim
import Utility.SafeCommand
usage :: Handle -> IO ()
@@ -72,7 +73,7 @@ processCmdLine = go =<< getArgs
-- | Runs propellor on hosts, as controlled by command-line options.
defaultMain :: [Host] -> IO ()
defaultMain hostlist = do
- DockerShim.cleanEnv
+ Shim.cleanEnv
checkDebugMode
cmdline <- processCmdLine
debug ["command line: ", show cmdline]
@@ -85,6 +86,7 @@ defaultMain hostlist = do
go _ ListFields = listPrivDataFields hostlist
go _ (AddKey keyid) = addKey keyid
go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
+ go _ (ChrootChain hn loc) = Chroot.chain hostlist hn loc
go _ (DockerInit hn) = Docker.init hn
go _ (GitPush fin fout) = gitPushHelper fin fout
go _ (Update _) = forceConsole >> fetchFirst (onlyprocess update)
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 3fa9ffc0..0cbf6247 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -11,12 +11,15 @@ import "mtl" Control.Monad.Reader
import Control.Exception (bracket)
import System.PosixCompat
import System.Posix.IO
+import Data.Maybe
import Propellor.Types
import Propellor.Message
import Propellor.Exception
import Propellor.Info
import Utility.Exception
+import Utility.PartialPrelude
+import Utility.Monad
runPropellor :: Host -> Propellor a -> IO a
runPropellor host a = runReaderT (runWithHost a) host
@@ -62,3 +65,18 @@ onlyProcess lockfile a = bracket lock unlock (const a)
return l
unlock = closeFd
alreadyrunning = error "Propellor is already running on this host!"
+
+-- | Reads and displays each line from the Handle, except for the last line
+-- which is a Result.
+processChainOutput :: Handle -> IO Result
+processChainOutput h = go Nothing
+ where
+ go lastline = do
+ v <- catchMaybeIO (hGetLine h)
+ case v of
+ Nothing -> pure $ fromMaybe FailedChange $
+ readish =<< lastline
+ Just s -> do
+ maybe noop putStrLn lastline
+ hFlush stdout
+ go (Just s)
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index e5046937..38e09b52 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -2,12 +2,17 @@ module Propellor.Property.Chroot (
Chroot,
chroot,
provisioned,
+ chain,
) where
import Propellor
import qualified Propellor.Property.Debootstrap as Debootstrap
+import qualified Propellor.Shim as Shim
+import Utility.SafeCommand
import qualified Data.Map as M
+import Data.List.Utils
+import System.Posix.Directory
data Chroot = Chroot FilePath System Host
@@ -35,8 +40,7 @@ provisioned c@(Chroot loc system _) = RevertableProperty
(propigateChrootInfo c (go "exists" setup))
(go "removed" teardown)
where
- go desc a = property ("chroot " ++ loc ++ " " ++ desc) $ do
- ensureProperties [a]
+ go desc a = property (chrootDesc c desc) $ ensureProperties [a]
setup = provisionChroot c `requires` built
@@ -53,5 +57,71 @@ propigateChrootInfo c@(Chroot loc _ h) p = propigateInfo c p (<> chrootinfo)
where
chrootinfo = mempty $ mempty { _chroots = M.singleton loc h }
+-- | Propellor is run inside the chroot to provision it.
+--
+-- Strange and wonderful tricks let the host's /usr/local/propellor
+-- be used inside the chroot, without needing to install anything.
provisionChroot :: Chroot -> Property
-provisionChroot = undefined
+provisionChroot c@(Chroot loc _ _) = property (chrootDesc c "provisioned") $ do
+ let d = localdir </> shimdir c
+ let me = localdir </> "propellor"
+ shim <- liftIO $ ifM (doesDirectoryExist d)
+ ( pure (Shim.file me d)
+ , Shim.setup me d
+ )
+ ifM (liftIO $ bindmount shim)
+ ( chainprovision shim
+ , return FailedChange
+ )
+ where
+ bindmount shim = ifM (doesFileExist (loc ++ shim))
+ ( return True
+ , do
+ let mntpnt = loc ++ localdir
+ createDirectoryIfMissing True mntpnt
+ boolSystem "mount"
+ [ Param "--bind"
+ , File localdir, File mntpnt
+ ]
+ )
+
+ chainprovision shim = do
+ parenthost <- asks hostName
+ let p = inChrootProcess c
+ [ shim
+ , "--continue"
+ , show $ toChain parenthost c
+ ]
+ liftIO $ withHandle StdoutHandle createProcessSuccess p
+ processChainOutput
+
+toChain :: HostName -> Chroot -> CmdLine
+toChain parenthost (Chroot loc _ _) = ChrootChain parenthost loc
+
+chain :: [Host] -> HostName -> FilePath -> IO ()
+chain hostlist hn loc = case findHostNoAlias hostlist hn of
+ Nothing -> errorMessage ("cannot find host " ++ hn)
+ Just parenthost -> case M.lookup loc (_chroots $ _chrootinfo $ hostInfo parenthost) of
+ Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
+ Just h -> go h
+ where
+ go h = do
+ changeWorkingDirectory localdir
+ onlyProcess (provisioningLock loc) $ do
+ r <- runPropellor h $ ensureProperties $ hostProperties h
+ putStrLn $ "\n" ++ show r
+
+inChrootProcess :: Chroot -> [String] -> CreateProcess
+inChrootProcess (Chroot loc _ _) cmd = proc "chroot" (loc:cmd)
+
+provisioningLock :: FilePath -> FilePath
+provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
+
+shimdir :: Chroot -> FilePath
+shimdir (Chroot loc _ _) = "chroot" </> mungeloc loc ++ ".shim"
+
+mungeloc :: FilePath -> String
+mungeloc = replace "/" "_"
+
+chrootDesc :: Chroot -> String -> String
+chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 92cc124a..5cf60ff9 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -41,7 +41,7 @@ module Propellor.Property.Docker (
import Propellor hiding (init)
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import qualified Propellor.Property.Docker.Shim as Shim
+import qualified Propellor.Shim as Shim
import Utility.SafeCommand
import Utility.Path
import Utility.ThreadScheduler
@@ -432,20 +432,10 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
[ if isConsole msgh then "-it" else "-i" ]
(shim : params)
r <- withHandle StdoutHandle createProcessSuccess p $
- processoutput Nothing
+ processChainOutput
when (r /= FailedChange) $
setProvisionedFlag cid
return r
- where
- processoutput lastline h = do
- v <- catchMaybeIO (hGetLine h)
- case v of
- Nothing -> pure $ fromMaybe FailedChange $
- readish =<< lastline
- Just s -> do
- maybe noop putStrLn lastline
- hFlush stdout
- processoutput (Just s) h
toChain :: ContainerId -> CmdLine
toChain cid = DockerChain (containerHostName cid) (fromContainerId cid)
diff --git a/src/Propellor/Property/Docker/Shim.hs b/src/Propellor/Shim.hs
index c2f35d0c..5b5aa68e 100644
--- a/src/Propellor/Property/Docker/Shim.hs
+++ b/src/Propellor/Shim.hs
@@ -1,9 +1,10 @@
--- | Support for running propellor, as built outside a docker container,
--- inside the container.
+-- | Support for running propellor, as built outside a container,
+-- inside the container, without needing to install anything into the
+-- container.
--
-- Note: This is currently Debian specific, due to glibcLibs.
-module Propellor.Property.Docker.Shim (setup, cleanEnv, file) where
+module Propellor.Shim (setup, cleanEnv, file) where
import Propellor
import Utility.LinuxMkLibs
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 16ddcc7d..56eafc6d 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -155,6 +155,7 @@ data CmdLine
| Update HostName
| DockerInit HostName
| DockerChain HostName String
+ | ChrootChain HostName FilePath
| GitPush Fd Fd
deriving (Read, Show, Eq)