summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 13:51:58 -0400
committerJoey Hess2014-04-01 13:51:58 -0400
commit79cbdf35b1188d83e64a713efa82bc7a0a72a181 (patch)
tree4ad96d9fa0d2e61f6cd15a2b635fef67ea7c9bb1 /Propellor
parent2c328ad142421302b41bc961aa175f60e27f0ab3 (diff)
better method of starting propellor simplesh inside docker
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/CmdLine.hs19
-rw-r--r--Propellor/PrivData.hs9
-rw-r--r--Propellor/Property/Cron.hs1
-rw-r--r--Propellor/Property/Docker.hs99
-rw-r--r--Propellor/SimpleSh.hs20
-rw-r--r--Propellor/Types.hs20
6 files changed, 103 insertions, 65 deletions
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
index 8edfe19e..73254165 100644
--- a/Propellor/CmdLine.hs
+++ b/Propellor/CmdLine.hs
@@ -9,21 +9,10 @@ import System.Log.Handler (setFormatter, LogHandler)
import System.Log.Handler.Simple
import Propellor
-import Propellor.SimpleSh
+import qualified Propellor.Property.Docker as Docker
import Utility.FileMode
import Utility.SafeCommand
-data CmdLine
- = Run HostName
- | Spin HostName
- | Boot HostName
- | Set HostName PrivDataField
- | AddKey String
- | Continue CmdLine
- | SimpleSh FilePath
- | Chain HostName
- deriving (Read, Show, Eq)
-
usage :: IO a
usage = do
putStrLn $ unlines
@@ -49,7 +38,6 @@ processCmdLine = go =<< getArgs
go ("--continue":s:[]) = case readish s of
Just cmdline -> return $ Continue cmdline
Nothing -> errorMessage "--continue serialization failure"
- go ("--simplesh":f:[]) = return $ SimpleSh f
go ("--chain":h:[]) = return $ Chain h
go (h:[])
| "--" `isPrefixOf` h = usage
@@ -71,8 +59,8 @@ defaultMain getprops = do
go _ (Continue cmdline) = go False cmdline
go _ (Set host field) = setPrivData host field
go _ (AddKey keyid) = addKey keyid
- go _ (SimpleSh f) = simpleSh f
go _ (Chain host) = withprops host $ print <=< ensureProperties'
+ go _ (ChainDocker host) = Docker.chain host
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
go True cmdline = updateFirst cmdline $ go False cmdline
go False (Spin host) = withprops host $ const $ spin host
@@ -296,9 +284,6 @@ keyring = privDataDir </> "keyring.gpg"
gpgopts :: [String]
gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]
-localdir :: FilePath
-localdir = "/usr/local/propellor"
-
getUrl :: IO String
getUrl = maybe nourl return =<< getM get urls
where
diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
index 98a1da62..d97a7725 100644
--- a/Propellor/PrivData.hs
+++ b/Propellor/PrivData.hs
@@ -18,15 +18,6 @@ import Utility.Tmp
import Utility.SafeCommand
import Utility.Misc
--- | Note that removing or changing field names will break the
--- serialized privdata files, so don't do that!
--- It's fine to add new fields.
-data PrivDataField
- = DockerAuthentication
- | SshPrivKey UserName
- | Password UserName
- deriving (Read, Show, Ord, Eq)
-
withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result
withPrivData field a = maybe missing a =<< getPrivData field
where
diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
index 212e94e9..10e28ed7 100644
--- a/Propellor/Property/Cron.hs
+++ b/Propellor/Property/Cron.hs
@@ -3,7 +3,6 @@ module Propellor.Property.Cron where
import Propellor
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
-import Propellor.CmdLine
type CronTimes = String
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 56ec0bde..d849497d 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -3,11 +3,13 @@
module Propellor.Property.Docker where
import Propellor
-import Propellor.CmdLine
import Propellor.SimpleSh
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import Utility.SafeCommand
+import Utility.Path
+
+import Control.Concurrent.Async
dockercmd :: String
dockercmd = "docker.io"
@@ -76,6 +78,9 @@ containerProperties findcontainer = \h -> case toContainerId h of
Just (Container _ cprops) ->
Just $ fromContainerized cprops
+containerDesc :: ContainerId -> Desc -> Desc
+containerDesc cid d = "docker container " ++ fromContainerId cid ++ " " ++ d
+
-- | Ensures that a docker container is set up and running. The container
-- has its own Properties which are handled by running propellor
-- inside the container.
@@ -84,22 +89,20 @@ hasContainer
-> ContainerName
-> (HostName -> ContainerName -> Maybe (Container))
-> Property
-hasContainer hn cn findcontainer =
+hasContainer hn cn findcontainer =
case findcontainer hn cn of
- Nothing -> Property desc $ do
+ Nothing -> Property (containerDesc cid "") $ do
warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
return FailedChange
Just (Container image containerprops) ->
- Property desc (provisionContainer cid)
- `requires`
- Property desc (ensureContainer cid image containerprops)
+ provisionContainer cid
+ `requires`
+ runningContainer cid image containerprops
where
cid = ContainerId hn cn
- desc = "docker container " ++ fromContainerId cid
-
-ensureContainer :: ContainerId -> Image -> [Containerized Property] -> IO Result
-ensureContainer cid@(ContainerId hn cn) image containerprops = do
+runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
+runningContainer cid@(ContainerId hn cn) image containerprops = Property (containerDesc cid "running") $ do
l <- listContainers RunningContainers
if cid `elem` l
then do
@@ -123,11 +126,9 @@ ensureContainer cid@(ContainerId hn cn) image containerprops = do
-- is also started, so the user can attach and use it if desired.
startsimplesh = ["sh", "-c", "./propellor --simplesh " ++ namedPipe cid ++ " & bash -l"]
- getrunningident = simpleShClient (namedPipe cid) "cat" [propellorIdent] $
- pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout
- setrunningident = simpleShClient (namedPipe cid) "sh"
- ["-c", "echo '" ++ show ident ++ "' > " ++ propellorIdent]
- (const noop)
+ getrunningident = catchDefaultIO Nothing $
+ simpleShClient (namedPipe cid) "cat" [propellorIdent] $
+ pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout
runps = getRunParams $ containerprops ++
-- expose propellor directory inside the container
@@ -140,15 +141,55 @@ ensureContainer cid@(ContainerId hn cn) image containerprops = do
]
go img = ifM (runContainer img (runps ++ ["-i", "-d", "-t"]) startsimplesh)
- ( do
- setrunningident
- return MadeChange
+ ( return MadeChange
, return FailedChange
)
-provisionContainer :: ContainerId -> IO Result
-provisionContainer cid = do
- simpleShClient (namedPipe cid) "./propellor" [show params] (go Nothing)
+-- | Two containers with the same ContainerIdent were started from
+-- the same base image (possibly a different version though), and
+-- with the same RunParams.
+data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
+ deriving (Read, Show, Eq)
+
+-- | The ContainerIdent of a container is written to
+-- /.propellor-ident inside it. This can be checked to see if
+-- the container has the same ident later.
+propellorIdent :: FilePath
+propellorIdent = "/.propellor-ident"
+
+-- | Named pipe used for communication with the container.
+namedPipe :: ContainerId -> FilePath
+namedPipe cid = "docker/" ++ fromContainerId cid
+
+-- | Called when propellor is running inside a docker container.
+-- The string should be the container's ContainerIdent.
+--
+-- Fork a thread to run the SimpleSh server in the background.
+-- In the foreground, run an interactive bash (or sh) shell,
+-- so that the user can interact with it when attached to the container.
+chain :: String -> IO ()
+chain s = case readish s of
+ Nothing -> error $ "Invalid ContainerId: " ++ s
+ Just ident@(ContainerIdent _image hn cn _rp) -> do
+ let cid = ContainerId hn cn
+ writeFile propellorIdent (show ident)
+ t <- async $ simpleSh $ namedPipe cid
+ void $ ifM (inPath "bash")
+ ( boolSystem "bash" [Param "-l"]
+ , boolSystem "/bin/sh" []
+ )
+ wait t
+
+-- | Once a container is running, propellor can be run inside
+-- it to provision it.
+--
+-- Note that there is a race here, between the simplesh
+-- server starting up in the container, and this property
+-- being run. So, retry connections to the client for up to
+-- 1 minute.
+provisionContainer :: ContainerId -> Property
+provisionContainer cid = Property (containerDesc cid "provision") $
+ simpleShClientRetry 60 (namedPipe cid) "./propellor" [show params] (go Nothing)
where
params = Chain $ fromContainerId cid
@@ -169,22 +210,6 @@ provisionContainer cid = do
ret lastline = return $ fromMaybe FailedChange $
readish =<< lastline
--- | Two containers with the same ContainerIdent were started from
--- the same base image (possibly a different version though), and
--- with the same RunParams.
-data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
- deriving (Read, Show, Eq)
-
--- | The ContainerIdent of a container is written to
--- /.propellor-ident inside it. This can be checked to see if
--- the container has the same ident later.
-propellorIdent :: FilePath
-propellorIdent = "/.propellor-ident"
-
--- | Named pipe used for communication with the container.
-namedPipe :: ContainerId -> FilePath
-namedPipe cid = "docker/" ++ fromContainerId cid
-
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs
index 25a154a9..741c1bc8 100644
--- a/Propellor/SimpleSh.hs
+++ b/Propellor/SimpleSh.hs
@@ -12,6 +12,8 @@ import System.Process (std_in, std_out, std_err)
import System.Exit
import Propellor
+import Utility.FileMode
+import Utility.ThreadScheduler
data Cmd = Cmd String [String]
deriving (Read, Show)
@@ -22,7 +24,9 @@ data Resp = StdoutLine String | StderrLine String | Done ExitCode
simpleSh :: FilePath -> IO ()
simpleSh namedpipe = do
nukeFile namedpipe
- createDirectoryIfMissing True (takeDirectory namedpipe)
+ let dir = takeDirectory namedpipe
+ createDirectoryIfMissing True dir
+ modifyFileMode dir (removeModes otherGroupModes)
s <- socket AF_UNIX Stream defaultProtocol
bind s (SockAddrUnix namedpipe)
listen s 2
@@ -73,6 +77,20 @@ simpleShClient namedpipe cmd params handler = do
resps <- catMaybes . map readish . lines <$> hGetContents h
hClose h `after` handler resps
+simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
+simpleShClientRetry retries namedpipe cmd params handler = go retries
+ where
+ run = simpleShClient namedpipe cmd params handler
+ go n
+ | n < 1 = run
+ | otherwise = do
+ v <- tryIO run
+ case v of
+ Right r -> return r
+ Left _ -> do
+ threadDelaySeconds (Seconds 1)
+ go (n - 1)
+
getStdout :: Resp -> Maybe String
getStdout (StdoutLine s) = Just s
getStdout _ = Nothing
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index aef62de4..df139dd6 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -37,3 +37,23 @@ instance ActionResult Result where
getActionResult NoChange = ("unchanged", Dull, Green)
getActionResult MadeChange = ("done", Vivid, Green)
getActionResult FailedChange = ("failed", Vivid, Red)
+
+data CmdLine
+ = Run HostName
+ | Spin HostName
+ | Boot HostName
+ | Set HostName PrivDataField
+ | AddKey String
+ | Continue CmdLine
+ | Chain HostName
+ | ChainDocker HostName
+ deriving (Read, Show, Eq)
+
+-- | Note that removing or changing field names will break the
+-- serialized privdata files, so don't do that!
+-- It's fine to add new fields.
+data PrivDataField
+ = DockerAuthentication
+ | SshPrivKey UserName
+ | Password UserName
+ deriving (Read, Show, Ord, Eq)