diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Propellor/CmdLine.hs | 26 | ||||
| -rw-r--r-- | src/Propellor/Engine.hs | 15 | ||||
| -rw-r--r-- | src/Propellor/Property/Docker.hs | 28 | ||||
| -rw-r--r-- | src/Propellor/Types.hs | 4 |
4 files changed, 43 insertions, 30 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index e41ab39d..d9a95de2 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -7,8 +7,6 @@ import System.Environment (getArgs) import Data.List import System.Exit import System.PosixCompat -import Control.Exception (bracket) -import System.Posix.IO import Propellor import Propellor.Protocol @@ -86,10 +84,8 @@ defaultMain hostlist = do go _ (Edit field context) = editPrivData field context go _ ListFields = listPrivDataFields hostlist go _ (AddKey keyid) = addKey keyid - go _ (Chain hn) = withhost hn $ \h -> do - r <- runPropellor h $ ensureProperties $ hostProperties h - putStrLn $ "\n" ++ show r - go _ (Docker hn) = Docker.chain hn + go _ (DockerChain hn s) = withhost hn $ Docker.chain s + go _ (DockerInit hn) = Docker.init hn go _ (GitPush fin fout) = gitPushHelper fin fout go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline @@ -97,27 +93,17 @@ defaultMain hostlist = do go False cmdline@(SimpleRun hn) = buildFirst cmdline $ go False (Run hn) go False (Run hn) = ifM ((==) 0 <$> getRealUserID) - ( onlyProcess $ withhost hn mainProperties + ( onlyprocess $ withhost hn mainProperties , go True (Spin hn) ) go False (Update _) = do forceConsole - onlyProcess update + onlyprocess update withhost :: HostName -> (Host -> IO ()) -> IO () withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn) - -onlyProcess :: IO a -> IO a -onlyProcess a = bracket lock unlock (const a) - where - lock = do - l <- createFile lockfile stdFileMode - setLock l (WriteLock, AbsoluteSeek, 0, 0) - `catchIO` const alreadyrunning - return l - unlock = closeFd - alreadyrunning = error "Propellor is already running on this host!" - lockfile = localdir </> ".lock" + + onlyprocess = onlyProcess (localdir </> ".lock") unknownhost :: HostName -> [Host] -> IO a unknownhost h hosts = errorMessage $ unlines diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index a3fc0f30..3fa9ffc0 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -8,11 +8,15 @@ import Data.Monoid import Control.Applicative import System.Console.ANSI import "mtl" Control.Monad.Reader +import Control.Exception (bracket) +import System.PosixCompat +import System.Posix.IO import Propellor.Types import Propellor.Message import Propellor.Exception import Propellor.Info +import Utility.Exception runPropellor :: Host -> Propellor a -> IO a runPropellor host a = runReaderT (runWithHost a) host @@ -47,3 +51,14 @@ fromHost l hn getter = case findHost l hn of Nothing -> return Nothing Just h -> liftIO $ Just <$> runReaderT (runWithHost getter) h + +onlyProcess :: FilePath -> IO a -> IO a +onlyProcess lockfile a = bracket lock unlock (const a) + where + lock = do + l <- createFile lockfile stdFileMode + setLock l (WriteLock, AbsoluteSeek, 0, 0) + `catchIO` const alreadyrunning + return l + unlock = closeFd + alreadyrunning = error "Propellor is already running on this host!" diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 64276e87..7b559a50 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -33,10 +33,11 @@ module Propellor.Property.Docker ( restartOnFailure, restartNever, -- * Internal use + init, chain, ) where -import Propellor +import Propellor hiding (init) import Propellor.Types.Info import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt @@ -48,7 +49,8 @@ import Utility.ThreadScheduler import Control.Concurrent.Async hiding (link) import System.Posix.Directory import System.Posix.Process -import Data.List +import Prelude hiding (init) +import Data.List hiding (init) import Data.List.Utils import qualified Data.Set as S @@ -391,7 +393,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope liftIO $ writeFile (identFile cid) (show ident) ensureProperty $ boolProperty "run" $ runContainer img (runps ++ ["-i", "-d", "-t"]) - [shim, "--continue", show (Docker (fromContainerId cid))] + [shim, "--continue", show (DockerInit (fromContainerId cid))] -- | Called when propellor is running inside a docker container. -- The string should be the container's ContainerId. @@ -406,20 +408,20 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope -- 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. +-- 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. -chain :: String -> IO () -chain s = case toContainerId s of +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 $ Chain (containerHostName cid)]) $ + unlessM (boolSystem shim [Param "--continue", Param $ show $ DockerChain (containerHostName cid) (fromContainerId cid)]) $ warningMessage "Boot provision failed!" void $ async $ job reapzombies job $ do @@ -437,7 +439,7 @@ chain s = case toContainerId s of provisionContainer :: ContainerId -> Property provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid) - let params = ["--continue", show $ Chain (containerHostName cid)] + let params = ["--continue", show $ DockerChain (containerHostName cid) (fromContainerId cid)] msgh <- mkMessageHandle let p = inContainerProcess cid [ if isConsole msgh then "-it" else "-i" ] @@ -458,6 +460,13 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d hFlush stdout processoutput (Just s) h +chain :: String -> Host -> IO () +chain s h = case toContainerId s of + Just cid -> onlyProcess (provisioningLock cid) $ do + r <- runPropellor h $ ensureProperties $ hostProperties h + putStrLn $ "\n" ++ show r + Nothing -> error "bad container id" + stopContainer :: ContainerId -> IO Bool stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ] @@ -549,6 +558,9 @@ setProvisionedFlag cid = do 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" diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 00da7495..75b3c2ab 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -145,8 +145,8 @@ data CmdLine | ListFields | AddKey String | Continue CmdLine - | Chain HostName | Update HostName - | Docker HostName + | DockerInit HostName + | DockerChain HostName String | GitPush Fd Fd deriving (Read, Show, Eq) |