597 lines
20 KiB
Haskell
597 lines
20 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
-- | Docker support for propellor
|
|
--
|
|
-- The existance of a docker container is just another Property of a system,
|
|
-- which propellor can set up. See config.hs for an example.
|
|
|
|
module Propellor.Property.Docker (
|
|
-- * Host properties
|
|
installed,
|
|
configured,
|
|
container,
|
|
docked,
|
|
memoryLimited,
|
|
garbageCollected,
|
|
tweaked,
|
|
Image,
|
|
ContainerName,
|
|
Container,
|
|
-- * Container configuration
|
|
dns,
|
|
hostname,
|
|
publish,
|
|
expose,
|
|
user,
|
|
volume,
|
|
volumes_from,
|
|
workdir,
|
|
memory,
|
|
cpuShares,
|
|
link,
|
|
ContainerAlias,
|
|
restartAlways,
|
|
restartOnFailure,
|
|
restartNever,
|
|
-- * Internal use
|
|
init,
|
|
chain,
|
|
) where
|
|
|
|
import Propellor hiding (init)
|
|
import Propellor.Types.Docker
|
|
import Propellor.Types.CmdLine
|
|
import qualified Propellor.Property.File as File
|
|
import qualified Propellor.Property.Apt as Apt
|
|
import qualified Propellor.Shim as Shim
|
|
import Utility.SafeCommand
|
|
import Utility.Path
|
|
import Utility.ThreadScheduler
|
|
|
|
import Control.Concurrent.Async hiding (link)
|
|
import System.Posix.Directory
|
|
import System.Posix.Process
|
|
import Prelude hiding (init)
|
|
import Data.List hiding (init)
|
|
import Data.List.Utils
|
|
import qualified Data.Map as M
|
|
|
|
installed :: Property NoInfo
|
|
installed = Apt.installed ["docker.io"]
|
|
|
|
-- | Configures docker with an authentication file, so that images can be
|
|
-- pushed to index.docker.io. Optional.
|
|
configured :: Property HasInfo
|
|
configured = prop `requires` installed
|
|
where
|
|
prop = withPrivData src anyContext $ \getcfg ->
|
|
property "docker configured" $ getcfg $ \cfg -> ensureProperty $
|
|
"/root/.dockercfg" `File.hasContent` (lines cfg)
|
|
src = PrivDataSourceFileFromCommand DockerAuthentication
|
|
"/root/.dockercfg" "docker login"
|
|
|
|
-- | A short descriptive name for a container.
|
|
-- Should not contain whitespace or other unusual characters,
|
|
-- only [a-zA-Z0-9_-] are allowed
|
|
type ContainerName = String
|
|
|
|
-- | A docker container.
|
|
data Container = Container Image Host
|
|
|
|
instance PropAccum Container where
|
|
(Container i h) & p = Container i (h & p)
|
|
(Container i h) &^ p = Container i (h &^ p)
|
|
getProperties (Container _ h) = hostProperties h
|
|
|
|
-- | Defines a Container with a given name, image, and properties.
|
|
-- Properties can be added to configure the Container.
|
|
--
|
|
-- > container "web-server" "debian"
|
|
-- > & publish "80:80"
|
|
-- > & Apt.installed {"apache2"]
|
|
-- > & ...
|
|
container :: ContainerName -> Image -> Container
|
|
container cn image = Container image (Host cn [] info)
|
|
where
|
|
info = dockerInfo mempty
|
|
|
|
-- | 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.
|
|
--
|
|
-- When the container's Properties include DNS info, such as a CNAME,
|
|
-- that is propigated to the Info of the Host it's docked in.
|
|
--
|
|
-- Reverting this property ensures that the container is stopped and
|
|
-- removed.
|
|
docked :: Container -> RevertableProperty
|
|
docked ctr@(Container _ h) =
|
|
(propigateContainerInfo ctr (go "docked" setup))
|
|
<!>
|
|
(go "undocked" teardown)
|
|
where
|
|
cn = hostName h
|
|
|
|
go desc a = property (desc ++ " " ++ cn) $ do
|
|
hn <- asks hostName
|
|
let cid = ContainerId hn cn
|
|
ensureProperties [a cid (mkContainerInfo cid ctr)]
|
|
|
|
setup cid (ContainerInfo image runparams) =
|
|
provisionContainer cid
|
|
`requires`
|
|
runningContainer cid image runparams
|
|
`requires`
|
|
installed
|
|
|
|
teardown cid (ContainerInfo image _runparams) =
|
|
combineProperties ("undocked " ++ fromContainerId cid)
|
|
[ stoppedContainer cid
|
|
, property ("cleaned up " ++ fromContainerId cid) $
|
|
liftIO $ report <$> mapM id
|
|
[ removeContainer cid
|
|
, removeImage image
|
|
]
|
|
]
|
|
|
|
propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo
|
|
propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'
|
|
where
|
|
p' = infoProperty
|
|
(propertyDesc p)
|
|
(propertySatisfy p)
|
|
(propertyInfo p <> dockerinfo)
|
|
(propertyChildren p)
|
|
dockerinfo = dockerInfo $
|
|
mempty { _dockerContainers = M.singleton (hostName h) h }
|
|
|
|
mkContainerInfo :: ContainerId -> Container -> ContainerInfo
|
|
mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
|
|
ContainerInfo img runparams
|
|
where
|
|
runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
|
|
(_dockerRunParams info)
|
|
info = _dockerinfo $ hostInfo h'
|
|
h' = h
|
|
-- Restart by default so container comes up on
|
|
-- boot or when docker is upgraded.
|
|
&^ restartAlways
|
|
-- Expose propellor directory inside the container.
|
|
& volume (localdir++":"++localdir)
|
|
-- Name the container in a predictable way so we
|
|
-- and the user can easily find it later. This property
|
|
-- comes last, so it cannot be overridden.
|
|
& name (fromContainerId cid)
|
|
|
|
-- | Causes *any* docker images that are not in use by running containers to
|
|
-- be deleted. And deletes any containers that propellor has set up
|
|
-- before that are not currently running. Does not delete any containers
|
|
-- that were not set up using propellor.
|
|
--
|
|
-- Generally, should come after the properties for the desired containers.
|
|
garbageCollected :: Property NoInfo
|
|
garbageCollected = propertyList "docker garbage collected"
|
|
[ gccontainers
|
|
, gcimages
|
|
]
|
|
where
|
|
gccontainers = property "docker containers garbage collected" $
|
|
liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
|
|
gcimages = property "docker images garbage collected" $ do
|
|
liftIO $ report <$> (mapM removeImage =<< listImages)
|
|
|
|
-- | Tweaks a container to work well with docker.
|
|
--
|
|
-- Currently, this consists of making pam_loginuid lines optional in
|
|
-- the pam config, to work around <https://github.com/docker/docker/issues/5663>
|
|
-- which affects docker 1.2.0.
|
|
tweaked :: Property NoInfo
|
|
tweaked = trivial $
|
|
cmdProperty "sh" ["-c", "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"]
|
|
`describe` "tweaked for docker"
|
|
|
|
-- | Configures the kernel to respect docker memory limits.
|
|
--
|
|
-- This assumes the system boots using grub 2. And that you don't need any
|
|
-- other GRUB_CMDLINE_LINUX_DEFAULT settings.
|
|
--
|
|
-- Only takes effect after reboot. (Not automated.)
|
|
memoryLimited :: Property NoInfo
|
|
memoryLimited = "/etc/default/grub" `File.containsLine` cfg
|
|
`describe` "docker memory limited"
|
|
`onChange` cmdProperty "update-grub" []
|
|
where
|
|
cmdline = "cgroup_enable=memory swapaccount=1"
|
|
cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
|
|
|
|
data ContainerInfo = ContainerInfo Image [RunParam]
|
|
|
|
-- | 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
|
|
|
|
-- | Set custom dns server for container.
|
|
dns :: String -> Property HasInfo
|
|
dns = runProp "dns"
|
|
|
|
-- | Set container host name.
|
|
hostname :: String -> Property HasInfo
|
|
hostname = runProp "hostname"
|
|
|
|
-- | Set name of container.
|
|
name :: String -> Property HasInfo
|
|
name = runProp "name"
|
|
|
|
-- | Publish a container's port to the host
|
|
-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
|
|
publish :: String -> Property HasInfo
|
|
publish = runProp "publish"
|
|
|
|
-- | Expose a container's port without publishing it.
|
|
expose :: String -> Property HasInfo
|
|
expose = runProp "expose"
|
|
|
|
-- | Username or UID for container.
|
|
user :: String -> Property HasInfo
|
|
user = runProp "user"
|
|
|
|
-- | Mount a volume
|
|
-- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
|
|
-- With just a directory, creates a volume in the container.
|
|
volume :: String -> Property HasInfo
|
|
volume = runProp "volume"
|
|
|
|
-- | Mount a volume from the specified container into the current
|
|
-- container.
|
|
volumes_from :: ContainerName -> Property HasInfo
|
|
volumes_from cn = genProp "volumes-from" $ \hn ->
|
|
fromContainerId (ContainerId hn cn)
|
|
|
|
-- | Work dir inside the container.
|
|
workdir :: String -> Property HasInfo
|
|
workdir = runProp "workdir"
|
|
|
|
-- | Memory limit for container.
|
|
-- Format: <number><optional unit>, where unit = b, k, m or g
|
|
--
|
|
-- Note: Only takes effect when the host has the memoryLimited property
|
|
-- enabled.
|
|
memory :: String -> Property HasInfo
|
|
memory = runProp "memory"
|
|
|
|
-- | CPU shares (relative weight).
|
|
--
|
|
-- By default, all containers run at the same priority, but you can tell
|
|
-- the kernel to give more CPU time to a container using this property.
|
|
cpuShares :: Int -> Property HasInfo
|
|
cpuShares = runProp "cpu-shares" . show
|
|
|
|
-- | Link with another container on the same host.
|
|
link :: ContainerName -> ContainerAlias -> Property HasInfo
|
|
link linkwith calias = genProp "link" $ \hn ->
|
|
fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias
|
|
|
|
-- | A short alias for a linked container.
|
|
-- Each container has its own alias namespace.
|
|
type ContainerAlias = String
|
|
|
|
-- | This property is enabled by default for docker containers configured by
|
|
-- propellor; as well as keeping badly behaved containers running,
|
|
-- it ensures that containers get started back up after reboot or
|
|
-- after docker is upgraded.
|
|
restartAlways :: Property HasInfo
|
|
restartAlways = runProp "restart" "always"
|
|
|
|
-- | Docker will restart the container if it exits nonzero.
|
|
-- If a number is provided, it will be restarted only up to that many
|
|
-- times.
|
|
restartOnFailure :: Maybe Int -> Property HasInfo
|
|
restartOnFailure Nothing = runProp "restart" "on-failure"
|
|
restartOnFailure (Just n) = runProp "restart" ("on-failure:" ++ show n)
|
|
|
|
-- | Makes docker not restart a container when it exits
|
|
-- Note that this includes not restarting it on boot!
|
|
restartNever :: Property HasInfo
|
|
restartNever = runProp "restart" "no"
|
|
|
|
-- | A container is identified by its name, and the host
|
|
-- on which it's deployed.
|
|
data ContainerId = ContainerId
|
|
{ containerHostName :: HostName
|
|
, containerName :: 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)
|
|
|
|
toContainerId :: String -> Maybe ContainerId
|
|
toContainerId s
|
|
| myContainerSuffix `isSuffixOf` s = case separate (== '.') (desuffix s) of
|
|
(cn, hn)
|
|
| null hn || null cn -> Nothing
|
|
| otherwise -> Just $ ContainerId hn cn
|
|
| otherwise = Nothing
|
|
where
|
|
desuffix = reverse . drop len . reverse
|
|
len = length myContainerSuffix
|
|
|
|
fromContainerId :: ContainerId -> String
|
|
fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
|
|
|
|
myContainerSuffix :: String
|
|
myContainerSuffix = ".propellor"
|
|
|
|
containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
|
|
containerDesc cid p = p `describe` desc
|
|
where
|
|
desc = "container " ++ fromContainerId cid ++ " " ++ propertyDesc p
|
|
|
|
runningContainer :: ContainerId -> Image -> [RunParam] -> Property NoInfo
|
|
runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
|
|
l <- liftIO $ listContainers RunningContainers
|
|
if cid `elem` l
|
|
then checkident =<< liftIO getrunningident
|
|
else ifM (liftIO $ elem cid <$> listContainers AllContainers)
|
|
( do
|
|
-- The container exists, but is not
|
|
-- running. Its parameters may have
|
|
-- changed, but we cannot tell without
|
|
-- starting it up first.
|
|
void $ liftIO $ startContainer cid
|
|
-- It can take a while for the container to
|
|
-- start up enough for its ident file to be
|
|
-- written, so retry for up to 60 seconds.
|
|
checkident =<< liftIO (retry 60 $ getrunningident)
|
|
, go image
|
|
)
|
|
where
|
|
ident = ContainerIdent image hn cn runps
|
|
|
|
-- Check if the ident has changed; if so the
|
|
-- parameters of the container differ and it must
|
|
-- be restarted.
|
|
checkident (Right runningident)
|
|
| runningident == Just ident = noChange
|
|
| otherwise = do
|
|
void $ liftIO $ stopContainer cid
|
|
restartcontainer
|
|
checkident (Left errmsg) = do
|
|
warningMessage errmsg
|
|
return FailedChange
|
|
|
|
restartcontainer = do
|
|
oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
|
|
void $ liftIO $ removeContainer cid
|
|
go oldimage
|
|
|
|
getrunningident = withTmpFile "dockerrunsane" $ \t h -> do
|
|
-- detect #774376 which caused docker exec to not enter
|
|
-- the container namespace, and be able to access files
|
|
-- outside
|
|
hClose h
|
|
void . checkSuccessProcess . processHandle =<<
|
|
createProcess (inContainerProcess cid []
|
|
["rm", "-f", t])
|
|
ifM (doesFileExist t)
|
|
( Right . readish <$>
|
|
readProcess' (inContainerProcess cid []
|
|
["cat", propellorIdent])
|
|
, return $ Left "docker exec failed to enter chroot properly (maybe an old kernel version?)"
|
|
)
|
|
|
|
retry :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
|
|
retry 0 _ = return (Right Nothing)
|
|
retry n a = do
|
|
v <- a
|
|
case v of
|
|
Right Nothing -> do
|
|
threadDelaySeconds (Seconds 1)
|
|
retry (n-1) a
|
|
_ -> return v
|
|
|
|
go img = do
|
|
liftIO $ do
|
|
clearProvisionedFlag cid
|
|
createDirectoryIfMissing True (takeDirectory $ identFile cid)
|
|
shim <- liftIO $ Shim.setup (localdir </> "propellor") Nothing (localdir </> shimdir cid)
|
|
liftIO $ writeFile (identFile cid) (show ident)
|
|
ensureProperty $ property "run" $ liftIO $
|
|
toResult <$> runContainer img
|
|
(runps ++ ["-i", "-d", "-t"])
|
|
[shim, "--continue", show (DockerInit (fromContainerId cid))]
|
|
|
|
-- | Called when propellor is running inside a docker container.
|
|
-- The string should be the container's ContainerId.
|
|
--
|
|
-- This process is effectively init inside the container.
|
|
-- It even needs to wait on zombie processes!
|
|
--
|
|
-- 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, when not booting up.
|
|
--
|
|
-- 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.
|
|
init :: String -> IO ()
|
|
init s = case toContainerId s of
|
|
Nothing -> error $ "Invalid ContainerId: " ++ s
|
|
Just cid -> do
|
|
changeWorkingDirectory localdir
|
|
writeFile propellorIdent . show =<< readIdentFile cid
|
|
whenM (checkProvisionedFlag cid) $ do
|
|
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
|
|
unlessM (boolSystem shim [Param "--continue", Param $ show $ toChain cid]) $
|
|
warningMessage "Boot provision failed!"
|
|
void $ async $ job reapzombies
|
|
job $ do
|
|
void $ tryIO $ ifM (inPath "bash")
|
|
( boolSystem "bash" [Param "-l"]
|
|
, boolSystem "/bin/sh" []
|
|
)
|
|
putStrLn "Container is still running. Press ^P^Q to detach."
|
|
where
|
|
job = forever . void . tryIO
|
|
reapzombies = void $ getAnyProcessStatus True False
|
|
|
|
-- | Once a container is running, propellor can be run inside
|
|
-- it to provision it.
|
|
provisionContainer :: ContainerId -> Property NoInfo
|
|
provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
|
|
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
|
|
let params = ["--continue", show $ toChain cid]
|
|
msgh <- mkMessageHandle
|
|
let p = inContainerProcess cid
|
|
(if isConsole msgh then ["-it"] else [])
|
|
(shim : params)
|
|
r <- withHandle StdoutHandle createProcessSuccess p $
|
|
processChainOutput
|
|
when (r /= FailedChange) $
|
|
setProvisionedFlag cid
|
|
return r
|
|
|
|
toChain :: ContainerId -> CmdLine
|
|
toChain cid = DockerChain (containerHostName cid) (fromContainerId cid)
|
|
|
|
chain :: [Host] -> HostName -> String -> IO ()
|
|
chain hostlist hn s = case toContainerId s of
|
|
Nothing -> errorMessage "bad container id"
|
|
Just cid -> case findHostNoAlias hostlist hn of
|
|
Nothing -> errorMessage ("cannot find host " ++ hn)
|
|
Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ _dockerinfo $ hostInfo parenthost) of
|
|
Nothing -> errorMessage ("cannot find container " ++ containerName cid ++ " docked on host " ++ hn)
|
|
Just h -> go cid h
|
|
where
|
|
go cid h = do
|
|
changeWorkingDirectory localdir
|
|
onlyProcess (provisioningLock cid) $ do
|
|
r <- runPropellor h $ ensureProperties $
|
|
map ignoreInfo $
|
|
hostProperties h
|
|
putStrLn $ "\n" ++ show r
|
|
|
|
stopContainer :: ContainerId -> IO Bool
|
|
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
|
|
|
|
startContainer :: ContainerId -> IO Bool
|
|
startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ]
|
|
|
|
stoppedContainer :: ContainerId -> Property NoInfo
|
|
stoppedContainer cid = containerDesc cid $ property desc $
|
|
ifM (liftIO $ elem cid <$> listContainers RunningContainers)
|
|
( liftIO cleanup `after` ensureProperty
|
|
(property desc $ liftIO $ toResult <$> stopContainer cid)
|
|
, return NoChange
|
|
)
|
|
where
|
|
desc = "stopped"
|
|
cleanup = do
|
|
nukeFile $ identFile cid
|
|
removeDirectoryRecursive $ shimdir cid
|
|
clearProvisionedFlag cid
|
|
|
|
removeContainer :: ContainerId -> IO Bool
|
|
removeContainer cid = catchBoolIO $
|
|
snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing
|
|
|
|
removeImage :: Image -> IO Bool
|
|
removeImage image = catchBoolIO $
|
|
snd <$> processTranscript dockercmd ["rmi", image ] Nothing
|
|
|
|
runContainer :: Image -> [RunParam] -> [String] -> IO Bool
|
|
runContainer image ps cmd = boolSystem dockercmd $ map Param $
|
|
"run" : (ps ++ image : cmd)
|
|
|
|
inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess
|
|
inContainerProcess cid ps cmd = proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd)
|
|
|
|
commitContainer :: ContainerId -> IO (Maybe Image)
|
|
commitContainer cid = catchMaybeIO $
|
|
takeWhile (/= '\n')
|
|
<$> readProcess dockercmd ["commit", fromContainerId cid]
|
|
|
|
data ContainerFilter = RunningContainers | AllContainers
|
|
deriving (Eq)
|
|
|
|
-- | Only lists propellor managed containers.
|
|
listContainers :: ContainerFilter -> IO [ContainerId]
|
|
listContainers status =
|
|
catMaybes . map toContainerId . concat . map (split ",")
|
|
. catMaybes . map (lastMaybe . words) . lines
|
|
<$> readProcess dockercmd ps
|
|
where
|
|
ps
|
|
| status == AllContainers = baseps ++ ["--all"]
|
|
| otherwise = baseps
|
|
baseps = ["ps", "--no-trunc"]
|
|
|
|
listImages :: IO [Image]
|
|
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
|
|
|
|
runProp :: String -> RunParam -> Property HasInfo
|
|
runProp field val = pureInfoProperty (param) $ dockerInfo $
|
|
mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] }
|
|
where
|
|
param = field++"="++val
|
|
|
|
genProp :: String -> (HostName -> RunParam) -> Property HasInfo
|
|
genProp field mkval = pureInfoProperty field $ dockerInfo $
|
|
mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] }
|
|
|
|
dockerInfo :: DockerInfo Host -> Info
|
|
dockerInfo i = mempty { _dockerinfo = i }
|
|
|
|
-- | 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"
|
|
|
|
provisionedFlag :: ContainerId -> FilePath
|
|
provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
|
|
|
|
clearProvisionedFlag :: ContainerId -> IO ()
|
|
clearProvisionedFlag = nukeFile . provisionedFlag
|
|
|
|
setProvisionedFlag :: ContainerId -> IO ()
|
|
setProvisionedFlag cid = do
|
|
createDirectoryIfMissing True (takeDirectory (provisionedFlag cid))
|
|
writeFile (provisionedFlag cid) "1"
|
|
|
|
checkProvisionedFlag :: ContainerId -> IO Bool
|
|
checkProvisionedFlag = doesFileExist . provisionedFlag
|
|
|
|
provisioningLock :: ContainerId -> FilePath
|
|
provisioningLock cid = "docker" </> fromContainerId cid ++ ".lock"
|
|
|
|
shimdir :: ContainerId -> FilePath
|
|
shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
|
|
|
|
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)
|
|
|
|
dockercmd :: String
|
|
dockercmd = "docker"
|
|
|
|
report :: [Bool] -> Result
|
|
report rmed
|
|
| or rmed = MadeChange
|
|
| otherwise = NoChange
|
|
|