From 4a0cac113cf999a58a60f7db7a11d5b0ad623699 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:53:42 -0400 Subject: [PATCH] fix color display when running propellor inside docker --- src/Propellor/CmdLine.hs | 6 ++++-- src/Propellor/Message.hs | 12 +++++++++++- src/Propellor/Property/Docker.hs | 6 +++--- src/Propellor/Types.hs | 2 +- 4 files changed, 19 insertions(+), 7 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index e7da0a8..a79a582 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -55,7 +55,8 @@ processCmdLine = go =<< getArgs go ("--continue":s:[]) = case readish s of Just cmdline -> return $ Continue cmdline Nothing -> errorMessage "--continue serialization failure" - go ("--chain":h:[]) = return $ Chain h + go ("--chain":h:[]) = return $ Chain h False + go ("--chain":h:b:[]) = return $ Chain h (Prelude.read b) go ("--docker":h:[]) = return $ Docker h go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout) go (h:[]) @@ -86,7 +87,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 + go _ (Chain hn isconsole) = withhost hn $ \h -> do + when isconsole forceConsole r <- runPropellor h $ ensureProperties $ hostProperties h putStrLn $ "\n" ++ show r go _ (Docker hn) = Docker.chain hn diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index e184a59..639171c 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -6,20 +6,30 @@ import System.Console.ANSI import System.IO import System.Log.Logger import "mtl" Control.Monad.Reader +import Data.Maybe +import Control.Applicative import Propellor.Types import Utility.Monad +import Utility.Env data MessageHandle = ConsoleMessageHandle | TextMessageHandle mkMessageHandle :: IO MessageHandle -mkMessageHandle = ifM (hIsTerminalDevice stdout) +mkMessageHandle = ifM (hIsTerminalDevice stdout <||> (isJust <$> getEnv "PROPELLOR_CONSOLE")) ( return ConsoleMessageHandle , return TextMessageHandle ) +forceConsole :: IO () +forceConsole = void $ setEnv "PROPELLOR_CONSOLE" "1" True + +isConsole :: MessageHandle -> Bool +isConsole ConsoleMessageHandle = True +isConsole _ = False + whenConsole :: MessageHandle -> IO () -> IO () whenConsole ConsoleMessageHandle a = a whenConsole _ _ = return () diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 5a7a084..d005592 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -416,7 +416,7 @@ chain s = case toContainerId s of -- to avoid ever provisioning twice at the same time. 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 $ Chain (containerHostName cid) False]) $ warningMessage "Boot provision failed!" void $ async $ job reapzombies void $ async $ job $ simpleSh $ namedPipe cid @@ -440,13 +440,13 @@ 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) + msgh <- mkMessageHandle + let params = ["--continue", show $ Chain (containerHostName cid) (isConsole msgh)] r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) when (r /= FailedChange) $ setProvisionedFlag cid return r where - params = ["--continue", show $ Chain $ containerHostName cid] - go lastline (v:rest) = case v of StdoutLine s -> do maybe noop putStrLn lastline diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 72ccd22..f70eee6 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -144,7 +144,7 @@ data CmdLine | ListFields | AddKey String | Continue CmdLine - | Chain HostName + | Chain HostName Bool | Boot HostName | Docker HostName | GitPush Fd Fd