diff options
Diffstat (limited to 'src/Propellor/Property/Docker.hs')
| -rw-r--r-- | src/Propellor/Property/Docker.hs | 37 |
1 files changed, 12 insertions, 25 deletions
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 676d323a..5cf60ff9 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -41,7 +41,7 @@ module Propellor.Property.Docker ( import Propellor hiding (init) import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt -import qualified Propellor.Property.Docker.Shim as Shim +import qualified Propellor.Shim as Shim import Utility.SafeCommand import Utility.Path import Utility.ThreadScheduler @@ -52,7 +52,6 @@ import System.Posix.Process import Prelude hiding (init) import Data.List hiding (init) import Data.List.Utils -import qualified Data.Set as S import qualified Data.Map as M installed :: Property @@ -78,8 +77,10 @@ data Container = Container Image Host instance Hostlike Container where (Container i h) & p = Container i (h & p) (Container i h) &^ p = Container i (h &^ p) + getHost (Container _ h) = h --- | Builds a Container with a given name, image, and properties. +-- | 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" @@ -100,11 +101,9 @@ container cn image = Container image (Host cn [] info) -- -- Reverting this property ensures that the container is stopped and -- removed. -docked - :: Container - -> RevertableProperty +docked :: Container -> RevertableProperty docked ctr@(Container _ h) = RevertableProperty - (propigateInfo ctr (go "docked" setup)) + (propigateContainerInfo ctr (go "docked" setup)) (go "undocked" teardown) where cn = hostName h @@ -131,14 +130,12 @@ docked ctr@(Container _ h) = RevertableProperty ] ] -propigateInfo :: Container -> Property -> Property -propigateInfo (Container _ h@(Host hn _ containerinfo)) p = - combineProperties (propertyDesc p) $ p' : dnsprops ++ privprops +propigateContainerInfo :: Container -> Property -> Property +propigateContainerInfo ctr@(Container _ h) p = + propigateInfo ctr p (<> dockerinfo) where - p' = p { propertyInfo = propertyInfo p <> dockerinfo } - dockerinfo = dockerInfo $ mempty { _dockerContainers = M.singleton hn h } - dnsprops = map addDNS (S.toList $ _dns containerinfo) - privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo) + dockerinfo = dockerInfo $ + mempty { _dockerContainers = M.singleton (hostName h) h } mkContainerInfo :: ContainerId -> Container -> ContainerInfo mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = @@ -435,20 +432,10 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d [ if isConsole msgh then "-it" else "-i" ] (shim : params) r <- withHandle StdoutHandle createProcessSuccess p $ - processoutput Nothing + processChainOutput when (r /= FailedChange) $ setProvisionedFlag cid return r - where - processoutput lastline h = do - v <- catchMaybeIO (hGetLine h) - case v of - Nothing -> pure $ fromMaybe FailedChange $ - readish =<< lastline - Just s -> do - maybe noop putStrLn lastline - hFlush stdout - processoutput (Just s) h toChain :: ContainerId -> CmdLine toChain cid = DockerChain (containerHostName cid) (fromContainerId cid) |
