summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/CmdLine.hs26
-rw-r--r--src/Propellor/Engine.hs15
-rw-r--r--src/Propellor/Property/Docker.hs28
-rw-r--r--src/Propellor/Types.hs4
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)