cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

adding support for linked containers

This commit is contained in:
Joey Hess 2014-04-08 01:10:54 -04:00
parent 2b687fbca3
commit bd5c0c1f52
Failed to extract signature
1 changed files with 22 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Propellor/Property/Docker.hs
View File

@ -116,7 +116,7 @@ containerProperties findcontainer = \h -> case toContainerId h of
-- container. -- container.
data Container = Container Image [Containerized Property] data Container = Container Image [Containerized Property]
data Containerized a = Containerized [RunParam] a data Containerized a = Containerized [HostName -> RunParam] a
-- | Parameters to pass to `docker run` when creating a container. -- | Parameters to pass to `docker run` when creating a container.
type RunParam = String type RunParam = String
@ -170,6 +170,15 @@ workdir = runProp "workdir"
memory :: String -> Containerized Property memory :: String -> Containerized Property
memory = runProp "memory" memory = runProp "memory"
-- | Link with another container on the same host.
link :: ContainerName -> ContainerAlias -> Containerized Property
link linkwith alias = genProp "link" $ \hn ->
fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
-- | A short alias for a linked container.
-- Each container has its own alias namespace.
type ContainerAlias = 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
@ -181,10 +190,10 @@ data ContainerId = ContainerId HostName ContainerName
data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam] data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
deriving (Read, Show, Eq) deriving (Read, Show, Eq)
getRunParams :: [Containerized a] -> [RunParam] getRunParams :: HostName -> [Containerized a] -> [RunParam]
getRunParams l = concatMap get l getRunParams hn l = concatMap get l
where where
get (Containerized ps _) = ps get (Containerized ps _) = map (\a -> a hn ) ps
fromContainerized :: forall a. [Containerized a] -> [a] fromContainerized :: forall a. [Containerized a] -> [a]
fromContainerized l = map get l fromContainerized l = map get l
@ -243,7 +252,7 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
simpleShClient (namedPipe cid) "cat" [propellorIdent] $ simpleShClient (namedPipe cid) "cat" [propellorIdent] $
pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout
runps = getRunParams $ containerprops ++ runps = getRunParams hn $ containerprops ++
-- expose propellor directory inside the container -- expose propellor directory inside the container
[ volume (localdir++":"++localdir) [ volume (localdir++":"++localdir)
-- name the container in a predictable way so we -- name the container in a predictable way so we
@ -386,11 +395,17 @@ listImages :: IO [Image]
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"] listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
runProp :: String -> RunParam -> Containerized Property runProp :: String -> RunParam -> Containerized Property
runProp field val = runProp field val = Containerized
Containerized ["--" ++ param] (Property (param) (return NoChange)) [\_ -> "--" ++ param]
(Property (param) (return NoChange))
where where
param = field++"="++val param = field++"="++val
genProp :: String -> (HostName -> RunParam) -> Containerized Property
genProp field mkval = Containerized
[\h -> "--" ++ field ++ "=" ++ mkval h]
(Property field (return NoChange))
-- | The ContainerIdent of a container is written to -- | The ContainerIdent of a container is written to
-- /.propellor-ident inside it. This can be checked to see if -- /.propellor-ident inside it. This can be checked to see if
-- the container has the same ident later. -- the container has the same ident later.