nicer parameters when run inside docker
This commit is contained in:
parent
1f314984b5
commit
e08accb35a
|
@ -39,6 +39,7 @@ processCmdLine = go =<< getArgs
|
||||||
Just cmdline -> return $ Continue cmdline
|
Just cmdline -> return $ Continue cmdline
|
||||||
Nothing -> errorMessage "--continue serialization failure"
|
Nothing -> errorMessage "--continue serialization failure"
|
||||||
go ("--chain":h:[]) = return $ Chain h
|
go ("--chain":h:[]) = return $ Chain h
|
||||||
|
go ("--docker":h:[]) = return $ Docker h
|
||||||
go (h:[])
|
go (h:[])
|
||||||
| "--" `isPrefixOf` h = usage
|
| "--" `isPrefixOf` h = usage
|
||||||
| otherwise = return $ Run h
|
| otherwise = return $ Run h
|
||||||
|
@ -62,7 +63,7 @@ defaultMain getprops = do
|
||||||
go _ (Chain host) = withprops host $ \ps -> do
|
go _ (Chain host) = withprops host $ \ps -> do
|
||||||
r <- ensureProperties' ps
|
r <- ensureProperties' ps
|
||||||
putStrLn $ "\n" ++ show r
|
putStrLn $ "\n" ++ show r
|
||||||
go _ (ChainDocker host) = Docker.chain host
|
go _ (Docker host) = Docker.chain host
|
||||||
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
|
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
|
||||||
go True cmdline = updateFirst cmdline $ go False cmdline
|
go True cmdline = updateFirst cmdline $ go False cmdline
|
||||||
go False (Spin host) = withprops host $ const $ spin host
|
go False (Spin host) = withprops host $ const $ spin host
|
||||||
|
|
|
@ -64,7 +64,7 @@ type ContainerName = String
|
||||||
-- | A container is identified by its name, and the host
|
-- | A container is identified by its name, and the host
|
||||||
-- on which it's deployed.
|
-- on which it's deployed.
|
||||||
data ContainerId = ContainerId HostName ContainerName
|
data ContainerId = ContainerId HostName ContainerName
|
||||||
deriving (Eq)
|
deriving (Eq, Read, Show)
|
||||||
|
|
||||||
toContainerId :: String -> Maybe ContainerId
|
toContainerId :: String -> Maybe ContainerId
|
||||||
toContainerId s = case separate (== '.') s of
|
toContainerId s = case separate (== '.') s of
|
||||||
|
@ -123,7 +123,7 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
|
||||||
if cid `elem` l
|
if cid `elem` l
|
||||||
then do
|
then do
|
||||||
runningident <- getrunningident
|
runningident <- getrunningident
|
||||||
if ident2id <$> runningident == Just (ident2id ident)
|
if (ident2id <$> runningident) == Just (ident2id ident)
|
||||||
then return NoChange
|
then return NoChange
|
||||||
else do
|
else do
|
||||||
void $ stopContainer cid
|
void $ stopContainer cid
|
||||||
|
@ -149,12 +149,15 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
|
||||||
, name (fromContainerId cid)
|
, name (fromContainerId cid)
|
||||||
]
|
]
|
||||||
|
|
||||||
chaincmd = [localdir </> "propellor", "--continue", show $ ChainDocker $ show ident]
|
chaincmd = [localdir </> "propellor", "--docker", show cid]
|
||||||
|
|
||||||
go img = ifM (runContainer img (runps ++ ["-i", "-d", "-t"]) chaincmd)
|
go img = do
|
||||||
( return MadeChange
|
createDirectoryIfMissing True (takeDirectory $ identFile cid)
|
||||||
, return FailedChange
|
writeFile (identFile cid) (show ident)
|
||||||
)
|
ifM (runContainer img (runps ++ ["-i", "-d", "-t"]) chaincmd)
|
||||||
|
( return MadeChange
|
||||||
|
, return FailedChange
|
||||||
|
)
|
||||||
|
|
||||||
-- | Two containers with the same ContainerIdent were started from
|
-- | Two containers with the same ContainerIdent were started from
|
||||||
-- the same base image (possibly a different version though), and
|
-- the same base image (possibly a different version though), and
|
||||||
|
@ -175,8 +178,15 @@ propellorIdent = "/.propellor-ident"
|
||||||
namedPipe :: ContainerId -> FilePath
|
namedPipe :: ContainerId -> FilePath
|
||||||
namedPipe cid = "docker/" ++ fromContainerId cid
|
namedPipe cid = "docker/" ++ fromContainerId cid
|
||||||
|
|
||||||
|
identFile :: ContainerId -> FilePath
|
||||||
|
identFile cid = "docker/" ++ fromContainerId cid ++ ".ident"
|
||||||
|
|
||||||
|
readIdentFile :: ContainerId -> IO ContainerIdent
|
||||||
|
readIdentFile cid = fromMaybe (error "bad ident in identFile")
|
||||||
|
. readish <$> readFile (identFile cid)
|
||||||
|
|
||||||
-- | Called when propellor is running inside a docker container.
|
-- | Called when propellor is running inside a docker container.
|
||||||
-- The string should be the container's ContainerIdent.
|
-- The string should be the container's ContainerId.
|
||||||
--
|
--
|
||||||
-- Fork a thread to run the SimpleSh server in the background.
|
-- Fork a thread to run the SimpleSh server in the background.
|
||||||
-- In the foreground, run an interactive bash (or sh) shell,
|
-- In the foreground, run an interactive bash (or sh) shell,
|
||||||
|
@ -184,10 +194,9 @@ namedPipe cid = "docker/" ++ fromContainerId cid
|
||||||
chain :: String -> IO ()
|
chain :: String -> IO ()
|
||||||
chain s = case readish s of
|
chain s = case readish s of
|
||||||
Nothing -> error $ "Invalid ContainerId: " ++ s
|
Nothing -> error $ "Invalid ContainerId: " ++ s
|
||||||
Just ident@(ContainerIdent _image hn cn _rp) -> do
|
Just cid -> do
|
||||||
changeWorkingDirectory localdir
|
changeWorkingDirectory localdir
|
||||||
let cid = ContainerId hn cn
|
writeFile propellorIdent . show =<< readIdentFile cid
|
||||||
writeFile propellorIdent (show ident)
|
|
||||||
void $ async $ simpleSh $ namedPipe cid
|
void $ async $ simpleSh $ namedPipe cid
|
||||||
forever $ do
|
forever $ do
|
||||||
void $ ifM (inPath "bash")
|
void $ ifM (inPath "bash")
|
||||||
|
|
|
@ -64,7 +64,7 @@ data CmdLine
|
||||||
| AddKey String
|
| AddKey String
|
||||||
| Continue CmdLine
|
| Continue CmdLine
|
||||||
| Chain HostName
|
| Chain HostName
|
||||||
| ChainDocker HostName
|
| Docker HostName
|
||||||
deriving (Read, Show, Eq)
|
deriving (Read, Show, Eq)
|
||||||
|
|
||||||
-- | Note that removing or changing field names will break the
|
-- | Note that removing or changing field names will break the
|
||||||
|
|
Loading…
Reference in New Issue