summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 21:53:11 -0400
committerJoey Hess2014-04-01 21:53:11 -0400
commitf1017c7f8e7921d8468e8ae3c57ad6bd56172132 (patch)
tree9e96bee12ae4cef412bba731b6abe3ad4a33fa90 /Propellor/Property
parenta5f374385f56b9a92ef0a762846316c89e42aa0f (diff)
provision on boot
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Docker.hs261
1 files changed, 152 insertions, 109 deletions
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index c91771c4..a530cc68 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -24,9 +24,6 @@ import Utility.Path
import Control.Concurrent.Async
import System.Posix.Directory
-dockercmd :: String
-dockercmd = "docker.io"
-
-- | Configures docker with an authentication file, so that images can be
-- pushed to index.docker.io.
configured :: Property
@@ -38,20 +35,53 @@ configured = Property "docker configured" go `requires` installed
installed :: Property
installed = Apt.installed ["docker.io"]
--- | Parameters to pass to `docker run` when creating a container.
-type RunParam = String
+-- | 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.
+docked
+ :: (HostName -> ContainerName -> Maybe (Container))
+ -> HostName
+ -> ContainerName
+ -> Property
+docked findcontainer hn cn =
+ case findcontainer hn cn of
+ Nothing -> containerDesc cid $ Property "" $ do
+ warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
+ return FailedChange
+ Just (Container image containerprops) ->
+ provisionContainer cid
+ `requires`
+ runningContainer cid image containerprops
+ where
+ cid = ContainerId hn cn
-data Containerized a = Containerized [RunParam] a
+-- | Pass to defaultMain to add docker containers.
+-- You need to provide the function mapping from
+-- HostName and ContainerName to the Container to use.
+containerProperties
+ :: (HostName -> ContainerName -> Maybe (Container))
+ -> (HostName -> Maybe [Property])
+containerProperties findcontainer = \h -> case toContainerId h of
+ Nothing -> Nothing
+ Just cid@(ContainerId hn cn) ->
+ case findcontainer hn cn of
+ Nothing -> Nothing
+ Just (Container _ cprops) ->
+ Just $ map (containerDesc cid) $
+ fromContainerized cprops
-getRunParams :: [Containerized a] -> [RunParam]
-getRunParams l = concatMap get l
- where
- get (Containerized ps _) = ps
+-- | This type is used to configure a docker container.
+-- It has an image, and a list of Properties, but these
+-- properties are Containerized; they can specify
+-- things about the container's configuration, in
+-- addition to properties of the system inside the
+-- container.
+data Container = Container Image [Containerized Property]
-fromContainerized :: forall a. [Containerized a] -> [a]
-fromContainerized l = map get l
- where
- get (Containerized _ a) = a
+data Containerized a = Containerized [RunParam] a
+
+-- | Parameters to pass to `docker run` when creating a container.
+type RunParam = String
-- | A docker image, that can be used to run a container.
type Image = String
@@ -61,11 +91,71 @@ type Image = String
-- only [a-zA-Z0-9_.-] are allowed
type ContainerName = String
+-- | Lift a Property to apply inside a container.
+inside1 :: Property -> Containerized Property
+inside1 = Containerized []
+
+inside :: [Property] -> Containerized Property
+inside = Containerized [] . combineProperties "provision"
+
+-- | Set custom dns server for container.
+dns :: String -> Containerized Property
+dns = runProp "dns"
+
+-- | Set container host name.
+hostname :: String -> Containerized Property
+hostname = runProp "hostname"
+
+-- | Set name for container. (Normally done automatically.)
+name :: String -> Containerized Property
+name = runProp "name"
+
+-- | Publish a container's port to the host
+-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
+publish :: String -> Containerized Property
+publish = runProp "publish"
+
+-- | Username or UID for container.
+user :: String -> Containerized Property
+user = runProp "user"
+
+-- | Bind mount a volume
+volume :: String -> Containerized Property
+volume = runProp "volume"
+
+-- | Work dir inside the container.
+workdir :: String -> Containerized Property
+workdir = runProp "workdir"
+
+-- | Memory limit for container.
+--Format: <number><optional unit>, where unit = b, k, m or g
+memory :: String -> Containerized Property
+memory = runProp "memory"
+
-- | A container is identified by its name, and the host
-- on which it's deployed.
data ContainerId = ContainerId HostName ContainerName
deriving (Eq, Read, Show)
+-- | 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)
+
+getRunParams :: [Containerized a] -> [RunParam]
+getRunParams l = concatMap get l
+ where
+ get (Containerized ps _) = ps
+
+fromContainerized :: forall a. [Containerized a] -> [a]
+fromContainerized l = map get l
+ where
+ get (Containerized _ a) = a
+
+ident2id :: ContainerIdent -> ContainerId
+ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn
+
toContainerId :: String -> Maybe ContainerId
toContainerId s = case separate (== '.') s of
(cn, hn)
@@ -75,48 +165,14 @@ toContainerId s = case separate (== '.') s of
fromContainerId :: ContainerId -> String
fromContainerId (ContainerId hn cn) = cn++"."++hn
-data Container = Container Image [Containerized Property]
-
containerFrom :: Image -> [Containerized Property] -> Container
containerFrom = Container
-containerProperties
- :: (HostName -> ContainerName -> Maybe (Container))
- -> (HostName -> Maybe [Property])
-containerProperties findcontainer = \h -> case toContainerId h of
- Nothing -> Nothing
- Just cid@(ContainerId hn cn) ->
- case findcontainer hn cn of
- Nothing -> Nothing
- Just (Container _ cprops) ->
- Just $ map (containerDesc cid) $
- fromContainerized cprops
-
containerDesc :: ContainerId -> Property -> Property
containerDesc cid p = p `describe` desc
where
desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
--- | 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.
-docked
- :: (HostName -> ContainerName -> Maybe (Container))
- -> HostName
- -> ContainerName
- -> Property
-docked findcontainer hn cn =
- case findcontainer hn cn of
- Nothing -> containerDesc cid $ Property "" $ do
- warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
- return FailedChange
- Just (Container image containerprops) ->
- provisionContainer cid
- `requires`
- runningContainer cid image containerprops
- where
- cid = ContainerId hn cn
-
runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do
l <- listContainers RunningContainers
@@ -126,12 +182,14 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
if (ident2id <$> runningident) == Just (ident2id ident)
then return NoChange
else do
+ clearProvisionedFlag cid
void $ stopContainer cid
oldimage <- fromMaybe image <$> commitContainer cid
removeContainer cid
go oldimage
else do
- whenM (elem cid <$> listContainers AllContainers) $
+ whenM (elem cid <$> listContainers AllContainers) $ do
+ clearProvisionedFlag cid
removeContainer cid
go image
where
@@ -159,44 +217,33 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
, return FailedChange
)
--- | 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)
-
-ident2id :: ContainerIdent -> ContainerId
-ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn
-
--- | 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
-
-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.
-- The string should be the container's ContainerId.
--
-- 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.
+--
+-- When the system reboots, docker restarts the container, and this is run
+-- again. So, to make the necessary services get started on boot, this needs
+-- to provision the container then. However, if the container is already
+-- being provisioned by the calling propellor, it would be redundant and
+-- problimatic to also provisoon it here.
+--
+-- The solution is a flag file. If the flag file exists, then the container
+-- was already provisioned. So, it must be a reboot, and time to provision
+-- again. If the flag file doesn't exist, don't provision here.
chain :: String -> IO ()
chain s = case readish s of
Nothing -> error $ "Invalid ContainerId: " ++ s
Just cid -> do
changeWorkingDirectory localdir
writeFile propellorIdent . show =<< readIdentFile cid
+ -- Run boot provisioning before starting simpleSh,
+ -- to avoid ever provisioning twice at the same time.
+ whenM (checkProvisionedFlag cid) $
+ unlessM (boolSystem "./propellor" [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
+ warningMessage "Boot provision failed!"
void $ async $ simpleSh $ namedPipe cid
forever $ do
void $ ifM (inPath "bash")
@@ -213,8 +260,11 @@ chain s = case readish s of
-- being run. So, retry connections to the client for up to
-- 1 minute.
provisionContainer :: ContainerId -> Property
-provisionContainer cid = containerDesc cid $ Property "provision" $
- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing)
+provisionContainer cid = containerDesc cid $ Property "provision" $ do
+ r <- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing)
+ when (r /= FailedChange) $
+ setProvisionedFlag cid
+ return r
where
params = ["--continue", show $ Chain $ fromContainerId cid]
@@ -273,43 +323,36 @@ runProp field val =
where
param = field++"="++val
--- | Lift a Property to run inside the container.
-inside1 :: Property -> Containerized Property
-inside1 = Containerized []
-
-inside :: [Property] -> Containerized Property
-inside = Containerized [] . combineProperties "provision"
+-- | 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"
--- | Set custom dns server for container.
-dns :: String -> Containerized Property
-dns = runProp "dns"
+-- | Named pipe used for communication with the container.
+namedPipe :: ContainerId -> FilePath
+namedPipe cid = "docker/" ++ fromContainerId cid
--- | Set container host name.
-hostname :: String -> Containerized Property
-hostname = runProp "hostname"
+provisionedFlag :: ContainerId -> FilePath
+provisionedFlag cid = "docker/" ++ fromContainerId cid ++ ".provisioned"
--- | Set name for container. (Normally done automatically.)
-name :: String -> Containerized Property
-name = runProp "name"
+clearProvisionedFlag :: ContainerId -> IO ()
+clearProvisionedFlag = nukeFile . provisionedFlag
--- | Publish a container's port to the host
--- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
-publish :: String -> Containerized Property
-publish = runProp "publish"
+setProvisionedFlag :: ContainerId -> IO ()
+setProvisionedFlag cid = do
+ createDirectoryIfMissing True (takeDirectory (provisionedFlag cid))
+ writeFile (provisionedFlag cid) "1"
--- | Username or UID for container.
-user :: String -> Containerized Property
-user = runProp "user"
+checkProvisionedFlag :: ContainerId -> IO Bool
+checkProvisionedFlag = doesFileExist . provisionedFlag
--- | Bind mount a volume
-volume :: String -> Containerized Property
-volume = runProp "volume"
+identFile :: ContainerId -> FilePath
+identFile cid = "docker/" ++ fromContainerId cid ++ ".ident"
--- | Work dir inside the container.
-workdir :: String -> Containerized Property
-workdir = runProp "workdir"
+readIdentFile :: ContainerId -> IO ContainerIdent
+readIdentFile cid = fromMaybe (error "bad ident in identFile")
+ . readish <$> readFile (identFile cid)
--- | Memory limit for container.
---Format: <number><optional unit>, where unit = b, k, m or g
-memory :: String -> Containerized Property
-memory = runProp "memory"
+dockercmd :: String
+dockercmd = "docker.io"