From 82d50a57968c73adaa4feb1a245d93403c72ce09 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 00:19:11 -0400
Subject: Avoid outputting color setting sequences when not run on a terminal.

Currently TERM is checked for every message. Could be memoized, but it
would add complexity, and typical propellor output is not going to be more
than a few hundred messages, and likely this will be swamped by the actual
work.
---
 src/Propellor/Message.hs | 63 ++++++++++++++++++++++++++++++++++--------------
 1 file changed, 45 insertions(+), 18 deletions(-)

(limited to 'src/Propellor/Message.hs')

diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index afbed1ca..99e9ba2c 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -6,8 +6,26 @@ 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.Env
+import Utility.Monad
+
+data MessageHandle
+	= ConsoleMessageHandle
+	| TextMessageHandle
+
+mkMessageHandle :: IO MessageHandle
+mkMessageHandle = ifM (isJust <$> getEnv "TERM")
+	( return ConsoleMessageHandle
+	, return TextMessageHandle
+	)
+
+whenConsole :: MessageHandle -> IO () -> IO ()
+whenConsole ConsoleMessageHandle a = a
+whenConsole _ _ = return ()
 
 -- | Shows a message while performing an action, with a colored status
 -- display.
@@ -21,46 +39,55 @@ actionMessageOn = actionMessage' . Just
 
 actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
 actionMessage' mhn desc a = do
-	liftIO $ do
+	h <- liftIO mkMessageHandle
+	liftIO $ whenConsole h $ do
 		setTitle $ "propellor: " ++ desc
 		hFlush stdout
 
 	r <- a
 
 	liftIO $ do
-		setTitle "propellor: running"
-		showhn mhn
+		whenConsole h $
+			setTitle "propellor: running"
+		showhn h mhn
 		putStr $ desc ++ " ... "
 		let (msg, intensity, color) = getActionResult r
-		colorLine intensity color msg
+		colorLine h intensity color msg
 		hFlush stdout
 
 	return r
   where
-	showhn Nothing = return ()
-	showhn (Just hn) = do
-		setSGR [SetColor Foreground Dull Cyan]
+	showhn _ Nothing = return ()
+	showhn h (Just hn) = do
+		whenConsole h $
+			setSGR [SetColor Foreground Dull Cyan]
 		putStr (hn ++ " ")
-		setSGR []
+		whenConsole h $
+			setSGR []
 
 warningMessage :: MonadIO m => String -> m ()
-warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
+warningMessage s = liftIO $ do
+	h <- mkMessageHandle
+	colorLine h Vivid Magenta $ "** warning: " ++ s
 
-colorLine :: ColorIntensity -> Color -> String -> IO ()
-colorLine intensity color msg = do
-	setSGR [SetColor Foreground intensity color]
+errorMessage :: MonadIO m => String -> m a
+errorMessage s = liftIO $ do
+	h <- mkMessageHandle
+	colorLine h Vivid Red $ "** error: " ++ s
+	error "Cannot continue!"
+
+colorLine :: MessageHandle -> ColorIntensity -> Color -> String -> IO ()
+colorLine h intensity color msg = do
+	whenConsole h $
+		setSGR [SetColor Foreground intensity color]
 	putStr msg
-	setSGR []
+	whenConsole h $
+		setSGR []
 	-- Note this comes after the color is reset, so that
 	-- the color set and reset happen in the same line.
 	putStrLn ""
 	hFlush stdout
 
-errorMessage :: String -> IO a
-errorMessage s = do
-	liftIO $ colorLine Vivid Red $ "** error: " ++ s
-	error "Cannot continue!"
-
 -- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
 debug :: [String] -> IO ()
 debug = debugM "propellor" . unwords
-- 
cgit v1.3-2-g0d8e


From e6ff8bfc475de337831df1768c6b51eb5f2fb325 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 00:28:46 -0400
Subject: can't rely on TERM; use hIsTerminalDevice

This calls an ioctl, I don't think it's very expensive.
---
 src/Propellor/Message.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

(limited to 'src/Propellor/Message.hs')

diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 99e9ba2c..23af5182 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -6,7 +6,6 @@ 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
@@ -18,7 +17,7 @@ data MessageHandle
 	| TextMessageHandle
 
 mkMessageHandle :: IO MessageHandle
-mkMessageHandle = ifM (isJust <$> getEnv "TERM")
+mkMessageHandle = ifM (hIsTerminalDevice stdout)
 	( return ConsoleMessageHandle
 	, return TextMessageHandle
 	)
-- 
cgit v1.3-2-g0d8e


From 340c8d1060d3c5b460c3c19ae7ae0406bb5ec6b1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 00:30:19 -0400
Subject: propellor spin

---
 src/Propellor/Message.hs | 2 --
 1 file changed, 2 deletions(-)

(limited to 'src/Propellor/Message.hs')

diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 23af5182..e184a59e 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -6,10 +6,8 @@ import System.Console.ANSI
 import System.IO
 import System.Log.Logger
 import "mtl" Control.Monad.Reader
-import Control.Applicative
 
 import Propellor.Types
-import Utility.Env
 import Utility.Monad
 
 data MessageHandle
-- 
cgit v1.3-2-g0d8e


From 1a906048511cf606b15d28c2f151ef8e1d848a50 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 00:41:06 -0400
Subject: ssh won't allocate a tty; work around

stdin is not a terminal, drat ssh

I don't much like this workaround
---
 src/Propellor/CmdLine.hs | 4 ++--
 src/Propellor/Message.hs | 8 +++++++-
 2 files changed, 9 insertions(+), 3 deletions(-)

(limited to 'src/Propellor/Message.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index d6c85c08..21c4d95e 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -189,7 +189,7 @@ spin hn hst = do
   where
 	hostprivdata = show . filterPrivData hst <$> decryptPrivData
 
-	go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ ["-t", user, bootstrapcmd]) $ \(toh, fromh) -> do
+	go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
 		let finish = do
 			senddata toh "privdata" privDataMarker privdata
 			hClose toh
@@ -303,6 +303,7 @@ boot h = do
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal) $
 		fromMarked privDataMarker reply
+	forceConsoleMode
 	mainProperties h
 
 getUrl :: IO String
@@ -364,4 +365,3 @@ sshCachingParams hn = do
 					[ Param "localhost" ]
 				nukeFile f
 	tenminutes = 600
-sshCachingParams hn = return []
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index e184a59e..3671e05b 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -6,20 +6,26 @@ import System.Console.ANSI
 import System.IO
 import System.Log.Logger
 import "mtl" Control.Monad.Reader
+import Control.Applicative
+import Data.Maybe
 
 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 "TERM"))
 	( return ConsoleMessageHandle
 	, return TextMessageHandle
 	)
 
+forceConsoleMode :: IO ()
+forceConsoleMode = void $ setEnv "TERM" "vt100" False
+
 whenConsole :: MessageHandle -> IO () -> IO ()
 whenConsole ConsoleMessageHandle a = a
 whenConsole _ _ = return ()
-- 
cgit v1.3-2-g0d8e


From 40f6d06f1a65b3a12adb853ab924e1181b0855b2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 01:01:50 -0400
Subject: Run remote propellor --spin with a controlling terminal.

Avoids need for hack to make ansi colors work, but also things like apt-get
and wget process bars will be displayed.
---
 debian/changelog         |  1 +
 src/Propellor/CmdLine.hs | 21 +++++++++++++--------
 src/Propellor/Message.hs |  8 +-------
 src/Propellor/Types.hs   |  2 +-
 4 files changed, 16 insertions(+), 16 deletions(-)

(limited to 'src/Propellor/Message.hs')

diff --git a/debian/changelog b/debian/changelog
index b0d5f7e1..1778338c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,7 @@ propellor (0.9.3) UNRELEASED; urgency=medium
   * DigitalOcean.distroKernel property now reboots into the distribution
     kernel when necessary.
   * Avoid outputting color setting sequences when not run on a terminal.
+  * Run remote propellor --spin with a controlling terminal.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 10 Nov 2014 11:15:27 -0400
 
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 21c4d95e..3a354098 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -41,7 +41,7 @@ processCmdLine = go =<< getArgs
   where
 	go ("--help":_) = usage
 	go ("--spin":h:[]) = return $ Spin h
-	go ("--boot":h:[]) = return $ Boot h
+	go ("--sync":[]) = return $ Sync
 	go ("--add-key":k:[]) = return $ AddKey k
 	go ("--set":f:c:[]) = withprivfield f c Set
 	go ("--dump":f:c:[]) = withprivfield f c Dump
@@ -91,7 +91,7 @@ defaultMain hostlist = do
 		( onlyProcess $ withhost hn mainProperties
 		, go True (Spin hn)
 		)
-	go False (Boot hn) = onlyProcess $ withhost hn boot
+	go False Sync = onlyProcess sync
 
 	withhost :: HostName -> (Host -> IO ()) -> IO ()
 	withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
@@ -186,6 +186,8 @@ spin hn hst = do
 	void $ boolSystem "git" [Param "push"]
 	cacheparams <- toCommand <$> sshCachingParams hn
 	go cacheparams url =<< hostprivdata
+	unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, spincmd]))) $
+		error "remote propellor failed"
   where
 	hostprivdata = show . filterPrivData hst <$> decryptPrivData
 
@@ -209,7 +211,9 @@ spin hn hst = do
 	
 	user = "root@"++hn
 
-	bootstrapcmd = shellWrap $ intercalate " ; "
+	mkcmd = shellWrap . intercalate " ; "
+
+	bootstrapcmd = mkcmd
 		[ "if [ ! -d " ++ localdir ++ " ]"
 		, "then " ++ intercalate " && "
 			[ "apt-get update"
@@ -219,11 +223,14 @@ spin hn hst = do
 		, "else " ++ intercalate " && "
 			[ "cd " ++ localdir
 			, "if ! test -x ./propellor; then make deps build; fi"
-			, "./propellor --boot " ++ hn
+			, "./propellor --sync"
 			]
 		, "fi"
 		]
 
+	spincmd = mkcmd
+		[ "cd " ++ localdir ++ " && ./propellor --spin " ++ hn ]
+
 	getstatus :: Handle -> IO BootStrapStatus
 	getstatus h = do
 		l <- hGetLine h
@@ -295,16 +302,14 @@ fromMarked marker s
 	len = length marker
 	matches = filter (marker `isPrefixOf`) $ lines s
 
-boot :: Host -> IO ()
-boot h = do
+sync :: IO ()
+sync = do
 	sendMarked stdout statusMarker $ show Ready
 	reply <- hGetContentsStrict stdin
 
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal) $
 		fromMarked privDataMarker reply
-	forceConsoleMode
-	mainProperties h
 
 getUrl :: IO String
 getUrl = maybe nourl return =<< getM get urls
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 3671e05b..e184a59e 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -6,26 +6,20 @@ import System.Console.ANSI
 import System.IO
 import System.Log.Logger
 import "mtl" Control.Monad.Reader
-import Control.Applicative
-import Data.Maybe
 
 import Propellor.Types
 import Utility.Monad
-import Utility.Env
 
 data MessageHandle
 	= ConsoleMessageHandle
 	| TextMessageHandle
 
 mkMessageHandle :: IO MessageHandle
-mkMessageHandle = ifM (hIsTerminalDevice stdout <||> (isJust <$> getEnv "TERM"))
+mkMessageHandle = ifM (hIsTerminalDevice stdout)
 	( return ConsoleMessageHandle
 	, return TextMessageHandle
 	)
 
-forceConsoleMode :: IO ()
-forceConsoleMode = void $ setEnv "TERM" "vt100" False
-
 whenConsole :: MessageHandle -> IO () -> IO ()
 whenConsole ConsoleMessageHandle a = a
 whenConsole _ _ = return ()
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index b606cef2..b3636eb4 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -137,7 +137,6 @@ instance ActionResult Result where
 data CmdLine
 	= Run HostName
 	| Spin HostName
-	| Boot HostName
 	| Set PrivDataField Context
 	| Dump PrivDataField Context
 	| Edit PrivDataField Context
@@ -145,5 +144,6 @@ data CmdLine
 	| AddKey String
 	| Continue CmdLine
 	| Chain HostName
+	| Sync
 	| Docker HostName
 	deriving (Read, Show, Eq)
-- 
cgit v1.3-2-g0d8e