From 8f88d45032a775e5420f67eb86c66a2a8f218a0b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 17 Nov 2014 20:21:21 -0400 Subject: propellor spin --- config-joey.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config-joey.hs b/config-joey.hs index ee0c54a8..7d48aee3 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -191,9 +191,9 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64" & JoeySites.annexWebSite "/srv/git/downloads.git" "downloads.kitenet.net" "840760dc-08f0-11e2-8c61-576b7e66acfd" - [("usbackup", "ssh://usbackup.kitenet.net/~/lib/downloads/")] + [("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")] `requires` Ssh.keyImported SshRsa "joey" (Context "downloads.kitenet.net") - `requires` Ssh.knownHost hosts "usbackup.kitenet.net" "joey" + `requires` Ssh.knownHost hosts "eubackup.kitenet.net" "joey" & JoeySites.gitAnnexDistributor & alias "tmp.kitenet.net" & JoeySites.annexWebSite "/srv/git/joey/tmp.git" -- cgit v1.2.3 -- cgit v1.2.3 From 82d50a57968c73adaa4feb1a245d93403c72ce09 Mon Sep 17 00:00:00 2001 From: Joey Hess 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. --- debian/changelog | 1 + src/Propellor/Message.hs | 63 ++++++++++++++++++++++++++++++++++-------------- 2 files changed, 46 insertions(+), 18 deletions(-) diff --git a/debian/changelog b/debian/changelog index 3858ac2f..b0d5f7e1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,7 @@ propellor (0.9.3) UNRELEASED; urgency=medium * Convert GpgKeyId to newtype. * DigitalOcean.distroKernel property now reboots into the distribution kernel when necessary. + * Avoid outputting color setting sequences when not run on a terminal. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 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.2.3 -- cgit v1.2.3 From 7b796bcb9cd9fb29404b1f00339064d6bdd6a331 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 00:22:05 -0400 Subject: enable tty over ssh --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index c3b792d1..cbbc3e9b 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 ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do + go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ ["-t", user, bootstrapcmd]) $ \(toh, fromh) -> do let finish = do senddata toh "privdata" privDataMarker privdata hClose toh -- cgit v1.2.3 -- cgit v1.2.3 From e6ff8bfc475de337831df1768c6b51eb5f2fb325 Mon Sep 17 00:00:00 2001 From: Joey Hess 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(-) 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.2.3 From 340c8d1060d3c5b460c3c19ae7ae0406bb5ec6b1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 00:30:19 -0400 Subject: propellor spin --- src/Propellor/Message.hs | 2 -- 1 file changed, 2 deletions(-) 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.2.3 -- cgit v1.2.3 From 194785b556b2712f5e56672d8915fb939de6e59a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 00:36:00 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index cbbc3e9b..d6c85c08 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -364,3 +364,4 @@ sshCachingParams hn = do [ Param "localhost" ] nukeFile f tenminutes = 600 +sshCachingParams hn = return [] -- cgit v1.2.3 From 1a906048511cf606b15d28c2f151ef8e1d848a50 Mon Sep 17 00:00:00 2001 From: Joey Hess 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(-) 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.2.3 -- cgit v1.2.3 From 40f6d06f1a65b3a12adb853ab924e1181b0855b2 Mon Sep 17 00:00:00 2001 From: Joey Hess 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(-) 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 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.2.3 -- cgit v1.2.3 From 8ea43c630215d545fca5d6aaf378ddc2853a2ebc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 01:04:41 -0400 Subject: avoid renaming --boot to --sync That broke updating existing systems, since --boot is what makes the remote propellor update itself. The hostname is no longer needed by --boot for new propellor's, but is still passed for old ones. Note that there will be a double run of propellor when upgrading via --spin, because it now runs --boot followed by --spin on the remote host, and the old --boot also satisfied all properties. --- src/Propellor/CmdLine.hs | 6 +++--- src/Propellor/Types.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 3a354098..4fd716ab 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 ("--sync":[]) = return $ Sync + go ("--boot":h:[]) = return $ Boot h 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 Sync = onlyProcess sync + go False (Boot _) = onlyProcess sync withhost :: HostName -> (Host -> IO ()) -> IO () withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn) @@ -223,7 +223,7 @@ spin hn hst = do , "else " ++ intercalate " && " [ "cd " ++ localdir , "if ! test -x ./propellor; then make deps build; fi" - , "./propellor --sync" + , "./propellor --boot " ++ hn ] , "fi" ] diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index b3636eb4..cf16099a 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -144,6 +144,6 @@ data CmdLine | AddKey String | Continue CmdLine | Chain HostName - | Sync + | Boot HostName | Docker HostName deriving (Read, Show, Eq) -- cgit v1.2.3 -- cgit v1.2.3 From 8d995b1574e25ec06a49b74a394dd41a2618e33f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 01:10:53 -0400 Subject: need to chain, not spin --- src/Propellor/CmdLine.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 4fd716ab..c31a5cbb 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -91,7 +91,7 @@ defaultMain hostlist = do ( onlyProcess $ withhost hn mainProperties , go True (Spin hn) ) - go False (Boot _) = onlyProcess sync + go False (Boot _) = onlyProcess boot withhost :: HostName -> (Host -> IO ()) -> IO () withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn) @@ -229,7 +229,7 @@ spin hn hst = do ] spincmd = mkcmd - [ "cd " ++ localdir ++ " && ./propellor --spin " ++ hn ] + [ "cd " ++ localdir ++ " && ./propellor --continue " ++ show (Chain hn) ] getstatus :: Handle -> IO BootStrapStatus getstatus h = do @@ -302,8 +302,8 @@ fromMarked marker s len = length marker matches = filter (marker `isPrefixOf`) $ lines s -sync :: IO () -sync = do +boot :: IO () +boot = do sendMarked stdout statusMarker $ show Ready reply <- hGetContentsStrict stdin -- cgit v1.2.3 -- cgit v1.2.3 From bc6b199d537c5bee3ad0822c24650e06ae5d1cd5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 01:15:34 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index c31a5cbb..6dd36f9f 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -187,7 +187,7 @@ spin hn hst = do cacheparams <- toCommand <$> sshCachingParams hn go cacheparams url =<< hostprivdata unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, spincmd]))) $ - error "remote propellor failed" + error $ "remote propellor failed (running: " ++ spincmd ++")" where hostprivdata = show . filterPrivData hst <$> decryptPrivData -- cgit v1.2.3 From a30b5a6bfd1b6f49a11f0087c8c93c237a781738 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 01:17:22 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 6dd36f9f..f3cf2f91 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -229,7 +229,7 @@ spin hn hst = do ] spincmd = mkcmd - [ "cd " ++ localdir ++ " && ./propellor --continue " ++ show (Chain hn) ] + [ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show (Chain hn)) ] getstatus :: Handle -> IO BootStrapStatus getstatus h = do -- cgit v1.2.3 From e4e2f44392f8509f38606eacc8bf827c405a46a9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 01:25:54 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index f3cf2f91..a4e45981 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -42,6 +42,7 @@ processCmdLine = go =<< getArgs go ("--help":_) = usage go ("--spin":h:[]) = return $ Spin h go ("--boot":h:[]) = return $ Boot h + go ("--run":h:[]) = return $ Run h go ("--add-key":k:[]) = return $ AddKey k go ("--set":f:c:[]) = withprivfield f c Set go ("--dump":f:c:[]) = withprivfield f c Dump @@ -186,8 +187,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 (running: " ++ spincmd ++")" + unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $ + error $ "remote propellor failed (running: " ++ runcmd ++")" where hostprivdata = show . filterPrivData hst <$> decryptPrivData @@ -228,8 +229,8 @@ spin hn hst = do , "fi" ] - spincmd = mkcmd - [ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show (Chain hn)) ] + runcmd = mkcmd + [ "cd " ++ localdir ++ " && ./propellor --run " ++ hn ] getstatus :: Handle -> IO BootStrapStatus getstatus h = do -- cgit v1.2.3 -- cgit v1.2.3 From 46076e9a37efad076125f1a8d3c4eff745f6fde9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 13:29:50 -0400 Subject: reorg and clean up bootstrap protocol --- propellor.cabal | 1 + src/Propellor/CmdLine.hs | 90 ++++++++++++++--------------------------------- src/Propellor/Protocol.hs | 47 +++++++++++++++++++++++++ 3 files changed, 74 insertions(+), 64 deletions(-) create mode 100644 src/Propellor/Protocol.hs diff --git a/propellor.cabal b/propellor.cabal index 8e552f2d..0a01ada8 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -116,6 +116,7 @@ Library Propellor.Gpg Propellor.SimpleSh Propellor.PrivData.Paths + Propellor.Protocol Propellor.Property.Docker.Shim Utility.Applicative Utility.Data diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index a4e45981..c133b7d8 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -13,6 +13,7 @@ import System.Posix.IO import Data.Time.Clock.POSIX import Propellor +import Propellor.Protocol import Propellor.PrivData.Paths import Propellor.Gpg import qualified Propellor.Property.Docker as Docker @@ -180,35 +181,37 @@ updateFirst cmdline next = do getCurrentGitSha1 :: String -> IO String getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref] +-- spin handles deploying propellor to a remote host, if it's not already +-- installed there, or updating it if it is. Once the remote propellor is +-- updated, it's run. spin :: HostName -> Host -> IO () spin hn hst = do - url <- getUrl void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] void $ boolSystem "git" [Param "push"] cacheparams <- toCommand <$> sshCachingParams hn - go cacheparams url =<< hostprivdata + go cacheparams =<< hostprivdata unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $ error $ "remote propellor failed (running: " ++ runcmd ++")" where hostprivdata = show . filterPrivData hst <$> decryptPrivData - go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do - let finish = do - senddata toh "privdata" privDataMarker privdata - hClose toh - - -- Display remaining output. - void $ tryIO $ forever $ - showremote =<< hGetLine fromh - hClose fromh - status <- getstatus fromh `catchIO` (const $ errorMessage "protocol error (perhaps the remote propellor failed to run?)") - case status of - Ready -> finish - NeedGitClone -> do + go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do + status <- getMarked fromh statusMarker + case readish =<< status of + Just Ready -> do + sendprivdata toh "privdata" privDataMarker privdata hClose toh + + -- Display remaining output. + void $ tryIO $ forever $ + showremote =<< hGetLine fromh hClose fromh - sendGitClone hn url - go cacheparams url privdata + Just NeedGitClone -> do + hClose toh + hClose fromh + sendGitClone hn =<< getUrl + go cacheparams privdata + Nothing -> error $ "protocol error; received: " ++ show status user = "root@"++hn @@ -232,17 +235,9 @@ spin hn hst = do runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor --run " ++ hn ] - getstatus :: Handle -> IO BootStrapStatus - getstatus h = do - l <- hGetLine h - case readish =<< fromMarked statusMarker l of - Nothing -> do - showremote l - getstatus h - Just status -> return status - showremote s = putStrLn s - senddata toh desc marker s = void $ + + sendprivdata toh desc marker s = void $ actionMessage ("Sending " ++ desc ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do sendMarked toh marker s return True @@ -267,50 +262,17 @@ sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) , "rm -f " ++ remotebundle , "git remote add origin " ++ url -- same as --set-upstream-to, except origin branch - -- has not been pulled yet + -- may not have been pulled yet , "git config branch."++branch++".remote origin" , "git config branch."++branch++".merge refs/heads/"++branch ] -data BootStrapStatus = Ready | NeedGitClone - deriving (Read, Show, Eq) - -type Marker = String -type Marked = String - -statusMarker :: Marker -statusMarker = "STATUS" - -privDataMarker :: String -privDataMarker = "PRIVDATA " - -toMarked :: Marker -> String -> String -toMarked marker = intercalate "\n" . map (marker ++) . lines - -sendMarked :: Handle -> Marker -> String -> IO () -sendMarked h marker s = do - -- Prefix string with newline because sometimes a - -- incomplete line is output. - hPutStrLn h ("\n" ++ toMarked marker s) - hFlush h - -fromMarked :: Marker -> Marked -> Maybe String -fromMarked marker s - | null matches = Nothing - | otherwise = Just $ intercalate "\n" $ - map (drop len) matches - where - len = length marker - matches = filter (marker `isPrefixOf`) $ lines s - boot :: IO () boot = do - sendMarked stdout statusMarker $ show Ready - reply <- hGetContentsStrict stdin - + sendMarked stdout statusMarker (show Ready) makePrivDataDir - maybe noop (writeFileProtected privDataLocal) $ - fromMarked privDataMarker reply + maybe noop (writeFileProtected privDataLocal) + =<< getMarked stdin privDataMarker getUrl :: IO String getUrl = maybe nourl return =<< getM get urls diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs new file mode 100644 index 00000000..a1643187 --- /dev/null +++ b/src/Propellor/Protocol.hs @@ -0,0 +1,47 @@ +-- | This is a simple line-based protocol used for communication between +-- a local and remote propellor. It's sent over a ssh channel, and lines of +-- the protocol can be interspersed with other, non-protocol lines +-- that should just be passed through to be displayed. + +module Propellor.Protocol where + +import Data.List + +import Propellor + +data BootStrapStatus = Ready | NeedGitClone + deriving (Read, Show, Eq) + +type Marker = String +type Marked = String + +statusMarker :: Marker +statusMarker = "STATUS" + +privDataMarker :: String +privDataMarker = "PRIVDATA " + +toMarked :: Marker -> String -> String +toMarked marker = intercalate "\n" . map (marker ++) . lines + +sendMarked :: Handle -> Marker -> String -> IO () +sendMarked h marker s = do + -- Prefix string with newline because sometimes a + -- incomplete line is output. + hPutStrLn h ("\n" ++ toMarked marker s) + hFlush h + +fromMarked :: Marker -> Marked -> Maybe String +fromMarked marker s + | marker `isPrefixOf` s = Just $ drop (length marker) s + | otherwise = Nothing + +getMarked :: Handle -> Marker -> IO (Maybe String) +getMarked h marker = go =<< catchMaybeIO (hGetLine h) + where + go Nothing = return Nothing + go (Just l) = case fromMarked marker l of + Nothing -> do + putStrLn l + getMarked h marker + Just v -> return (Just v) -- cgit v1.2.3 -- cgit v1.2.3 From 9463963d855d6a19d423598f668b8627dd669a30 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 13:32:33 -0400 Subject: reorg --- src/Propellor/Protocol.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index a1643187..669f41b6 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -24,18 +24,19 @@ privDataMarker = "PRIVDATA " toMarked :: Marker -> String -> String toMarked marker = intercalate "\n" . map (marker ++) . lines +fromMarked :: Marker -> Marked -> Maybe String +fromMarked marker s + | marker `isPrefixOf` s = Just $ drop (length marker) s + | otherwise = Nothing + sendMarked :: Handle -> Marker -> String -> IO () sendMarked h marker s = do -- Prefix string with newline because sometimes a - -- incomplete line is output. + -- incomplete line has been output, and the marker needs to + -- come at the start of a line. hPutStrLn h ("\n" ++ toMarked marker s) hFlush h -fromMarked :: Marker -> Marked -> Maybe String -fromMarked marker s - | marker `isPrefixOf` s = Just $ drop (length marker) s - | otherwise = Nothing - getMarked :: Handle -> Marker -> IO (Maybe String) getMarked h marker = go =<< catchMaybeIO (hGetLine h) where -- cgit v1.2.3 From 45f8ebf0ef0d152af3b3c77492e4a5e442e304b6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 13:59:50 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 71 ++++++++++++++++++++++++++++++----------------- src/Propellor/Protocol.hs | 5 +++- 2 files changed, 49 insertions(+), 27 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index c133b7d8..bc420dd9 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -196,22 +196,28 @@ spin hn hst = do hostprivdata = show . filterPrivData hst <$> decryptPrivData go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do - status <- getMarked fromh statusMarker - case readish =<< status of - Just Ready -> do - sendprivdata toh "privdata" privDataMarker privdata - hClose toh - - -- Display remaining output. - void $ tryIO $ forever $ - showremote =<< hGetLine fromh - hClose fromh - Just NeedGitClone -> do - hClose toh - hClose fromh - sendGitClone hn =<< getUrl - go cacheparams privdata - Nothing -> error $ "protocol error; received: " ++ show status + let comm = do + status <- getMarked fromh statusMarker + case readish =<< status of + Just RepoUrl -> do + sendMarked toh repoUrlMarker + =<< (fromMaybe "" <$> getRepoUrl) + comm + Just Ready -> do + sendprivdata toh "privdata" privDataMarker privdata + hClose toh + + -- Display remaining output. + void $ tryIO $ forever $ + showremote =<< hGetLine fromh + hClose fromh + Just NeedGitClone -> do + hClose toh + hClose fromh + sendGitClone hn + go cacheparams privdata + Nothing -> error $ "protocol error; received: " ++ show status + comm user = "root@"++hn @@ -243,8 +249,8 @@ spin hn hst = do return True -- Initial git clone, used for bootstrapping. -sendGitClone :: HostName -> String -> IO () -sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do +sendGitClone :: HostName -> IO () +sendGitClone hn = void $ actionMessage ("Pushing git repository to " ++ hn) $ do branch <- getCurrentBranch cacheparams <- sshCachingParams hn withTmpFile "propellor.git" $ \tmp _ -> allM id @@ -260,25 +266,38 @@ sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) , "git checkout -b " ++ branch , "git remote rm origin" , "rm -f " ++ remotebundle - , "git remote add origin " ++ url - -- same as --set-upstream-to, except origin branch - -- may not have been pulled yet - , "git config branch."++branch++".remote origin" - , "git config branch."++branch++".merge refs/heads/"++branch ] +-- Called "boot" for historical reasons, but what this really does is +-- update the privdata, repo url, and git repo over the ssh connection from the +-- client that ran propellor --spin. boot :: IO () boot = do + sendMarked stdout statusMarker (show RepoUrl) + maybe noop setRepoUrl + =<< getMarked stdin repoUrlMarker sendMarked stdout statusMarker (show Ready) makePrivDataDir maybe noop (writeFileProtected privDataLocal) =<< getMarked stdin privDataMarker -getUrl :: IO String -getUrl = maybe nourl return =<< getM get urls +setRepoUrl :: String -> IO () +setRepoUrl "" = return () +setRepoUrl url = do + rs <- lines <$> readProcess "git" ["remote"] + let subcmd = if "origin" `elem` rs then "set-url" else "add" + void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url] + -- same as --set-upstream-to, except origin branch + -- may not have been pulled yet + branch <- getCurrentBranch + let branchval s = "branch." ++ branch ++ "." ++ s + void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"] + void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch] + +getRepoUrl :: IO (Maybe String) +getRepoUrl = getM get urls where urls = ["remote.deploy.url", "remote.origin.url"] - nourl = errorMessage $ "Cannot find deploy url in " ++ show urls get u = do v <- catchMaybeIO $ takeWhile (/= '\n') diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index 669f41b6..4dc7e6bb 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -9,7 +9,7 @@ import Data.List import Propellor -data BootStrapStatus = Ready | NeedGitClone +data BootStrapStatus = Ready | NeedGitClone | RepoUrl deriving (Read, Show, Eq) type Marker = String @@ -21,6 +21,9 @@ statusMarker = "STATUS" privDataMarker :: String privDataMarker = "PRIVDATA " +repoUrlMarker :: String +repoUrlMarker = "REPOURL " + toMarked :: Marker -> String -> String toMarked marker = intercalate "\n" . map (marker ++) . lines -- cgit v1.2.3 From a0ea904ecb43e4fef4ea13d68d7dd41ebbdf5b54 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 14:01:13 -0400 Subject: changelog for last commit's changes --- debian/changelog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/debian/changelog b/debian/changelog index 1778338c..4a3853f8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,9 @@ propellor (0.9.3) UNRELEASED; urgency=medium kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. + * The git repo url is updated whenever propellor --spin is used, + and a central git repo does not need to be set up before using --spin + for the first time. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 -- cgit v1.2.3 From aa9aa832d216db71f363ad71a1ee13b5d8eaec5a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 14:09:18 -0400 Subject: refactor --- src/Propellor/CmdLine.hs | 41 ++++++++++++++++++++++------------------- src/Propellor/Protocol.hs | 7 ++++++- 2 files changed, 28 insertions(+), 20 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index bc420dd9..47df9f99 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -196,28 +196,34 @@ spin hn hst = do hostprivdata = show . filterPrivData hst <$> decryptPrivData go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do - let comm = do + let loop = do status <- getMarked fromh statusMarker case readish =<< status of - Just RepoUrl -> do + Just NeedRepoUrl -> do sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl) - comm + loop + Just NeedPrivData -> do + sendprivdata toh privdata + loop + Just NeedGitClone -> do + hClose toh + hClose fromh + sendGitClone hn + go cacheparams privdata + -- Ready is only sent by old versions of + -- propellor. They expect to get privdata, + -- and then no more protocol communication. Just Ready -> do - sendprivdata toh "privdata" privDataMarker privdata + sendprivdata toh privdata hClose toh -- Display remaining output. void $ tryIO $ forever $ showremote =<< hGetLine fromh hClose fromh - Just NeedGitClone -> do - hClose toh - hClose fromh - sendGitClone hn - go cacheparams privdata Nothing -> error $ "protocol error; received: " ++ show status - comm + loop user = "root@"++hn @@ -243,9 +249,9 @@ spin hn hst = do showremote s = putStrLn s - sendprivdata toh desc marker s = void $ - actionMessage ("Sending " ++ desc ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do - sendMarked toh marker s + sendprivdata toh privdata = void $ + actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do + sendMarked toh privDataMarker privdata return True -- Initial git clone, used for bootstrapping. @@ -273,13 +279,10 @@ sendGitClone hn = void $ actionMessage ("Pushing git repository to " ++ hn) $ do -- client that ran propellor --spin. boot :: IO () boot = do - sendMarked stdout statusMarker (show RepoUrl) - maybe noop setRepoUrl - =<< getMarked stdin repoUrlMarker - sendMarked stdout statusMarker (show Ready) + req NeedRepoUrl repoUrlMarker setRepoUrl makePrivDataDir - maybe noop (writeFileProtected privDataLocal) - =<< getMarked stdin privDataMarker + req NeedPrivData privDataMarker $ + writeFileProtected privDataLocal setRepoUrl :: String -> IO () setRepoUrl "" = return () diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index 4dc7e6bb..164f6db6 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -9,7 +9,7 @@ import Data.List import Propellor -data BootStrapStatus = Ready | NeedGitClone | RepoUrl +data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData deriving (Read, Show, Eq) type Marker = String @@ -49,3 +49,8 @@ getMarked h marker = go =<< catchMaybeIO (hGetLine h) putStrLn l getMarked h marker Just v -> return (Just v) + +req :: Stage -> Marker -> (String -> IO ()) -> IO () +req stage marker a = do + sendMarked stdout statusMarker (show stage) + maybe noop a =<< getMarked stdin marker -- cgit v1.2.3 -- cgit v1.2.3 From 473ce8b757c257118c023acf746ee1a6c4c7a463 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 14:13:52 -0400 Subject: Nothing means end of protocol, not protocol error --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 47df9f99..21ae1c42 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -222,7 +222,7 @@ spin hn hst = do void $ tryIO $ forever $ showremote =<< hGetLine fromh hClose fromh - Nothing -> error $ "protocol error; received: " ++ show status + Nothing -> return () loop user = "root@"++hn -- cgit v1.2.3 -- cgit v1.2.3 From bad6a8c3e641894c900f195c23092a528853c904 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:05:15 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 32 ++++++++++++++++++++++++++++++++ src/Propellor/Protocol.hs | 5 ++++- src/Propellor/Types.hs | 2 ++ 3 files changed, 38 insertions(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 21ae1c42..49c1dc4d 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -11,6 +11,8 @@ import System.PosixCompat import Control.Exception (bracket) import System.Posix.IO import Data.Time.Clock.POSIX +import Control.Concurrent.Async +import qualified Data.ByteString as B import Propellor import Propellor.Protocol @@ -54,6 +56,7 @@ processCmdLine = go =<< getArgs Nothing -> errorMessage "--continue serialization failure" go ("--chain":h:[]) = return $ Chain h go ("--docker":h:[]) = return $ Docker h + go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout) go (h:[]) | "--" `isPrefixOf` h = usage | otherwise = return $ Run h @@ -86,6 +89,7 @@ defaultMain hostlist = do r <- runPropellor h $ ensureProperties $ hostProperties h putStrLn $ "\n" ++ show r go _ (Docker hn) = Docker.chain hn + go _ (GitPush fin fout) = gitPush fin fout go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline go False (Spin hn) = withhost hn $ spin hn @@ -206,6 +210,12 @@ spin hn hst = do Just NeedPrivData -> do sendprivdata toh privdata loop + Just NeedGitPush -> do + sendMarked toh gitPushMarker "" + unlessM (boolSystem "git" [Param "send-pack", Param "--thin", Param "."]) $ + warningMessage "git send-pack failed" + -- no more protocol possible after + -- git push Just NeedGitClone -> do hClose toh hClose fromh @@ -283,6 +293,28 @@ boot = do makePrivDataDir req NeedPrivData privDataMarker $ writeFileProtected privDataLocal + req NeedGitPush gitPushMarker $ \_ -> do + hin <- dup stdInput + hClose stdin + hout <- dup stdOutput + hClose stdout + unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + warningMessage "git pull from client failed" + +-- Shim for git push over the propellor ssh channel. +-- Reads from stdin and sends it to the first fd; +-- reads from the second fd and sends it to stdout. +gitPush :: Fd -> Fd -> IO () +gitPush hin hout = do + print ("gitPush", hin, hout) + void $ fromstdin `concurrently` tostdout + where + fromstdin = do + h <- fdToHandle hin + B.getContents >>= B.hPut h + tostdout = do + h <- fdToHandle hout + B.hGetContents h >>= B.putStr setRepoUrl :: String -> IO () setRepoUrl "" = return () diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index 164f6db6..c5ebaab9 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -9,7 +9,7 @@ import Data.List import Propellor -data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData +data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush deriving (Read, Show, Eq) type Marker = String @@ -24,6 +24,9 @@ privDataMarker = "PRIVDATA " repoUrlMarker :: String repoUrlMarker = "REPOURL " +gitPushMarker :: String +gitPushMarker = "GITPUSH" + toMarked :: Marker -> String -> String toMarked marker = intercalate "\n" . map (marker ++) . lines diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index cf16099a..72ccd228 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -28,6 +28,7 @@ module Propellor.Types import Data.Monoid import Control.Applicative import System.Console.ANSI +import System.Posix.Types import "mtl" Control.Monad.Reader import "MonadCatchIO-transformers" Control.Monad.CatchIO @@ -146,4 +147,5 @@ data CmdLine | Chain HostName | Boot HostName | Docker HostName + | GitPush Fd Fd deriving (Read, Show, Eq) -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From d5091b6082a5556a2b764351072658336deecdd6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:09:13 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 49c1dc4d..ae7db849 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -211,6 +211,7 @@ spin hn hst = do sendprivdata toh privdata loop Just NeedGitPush -> do + print "NeedGitPush" sendMarked toh gitPushMarker "" unlessM (boolSystem "git" [Param "send-pack", Param "--thin", Param "."]) $ warningMessage "git send-pack failed" -- cgit v1.2.3 From dccdf0c0f08dc0ffc0e7c1853fadbe1ac0946030 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:09:35 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index ae7db849..744a97ad 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -202,6 +202,7 @@ spin hn hst = do go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do let loop = do status <- getMarked fromh statusMarker + print (">>", status) case readish =<< status of Just NeedRepoUrl -> do sendMarked toh repoUrlMarker @@ -211,7 +212,6 @@ spin hn hst = do sendprivdata toh privdata loop Just NeedGitPush -> do - print "NeedGitPush" sendMarked toh gitPushMarker "" unlessM (boolSystem "git" [Param "send-pack", Param "--thin", Param "."]) $ warningMessage "git send-pack failed" -- cgit v1.2.3 From 781e35a333d1ca930f9d94c716104c90bf28970d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:13:37 -0400 Subject: protocol is one line response, not multiline The privdata is shown, so contains no literal newlines, so that's ok. --- src/Propellor/Protocol.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index c5ebaab9..6394fc71 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -28,7 +28,7 @@ gitPushMarker :: String gitPushMarker = "GITPUSH" toMarked :: Marker -> String -> String -toMarked marker = intercalate "\n" . map (marker ++) . lines +toMarked marker = ++ fromMarked :: Marker -> Marked -> Maybe String fromMarked marker s -- cgit v1.2.3 From 9dfae00bd3949e4e23d4c24c7aa7375fdff4c9fb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:15:56 -0400 Subject: propellor spin --- src/Propellor/Protocol.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index 6394fc71..bdea7d10 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -28,7 +28,7 @@ gitPushMarker :: String gitPushMarker = "GITPUSH" toMarked :: Marker -> String -> String -toMarked marker = ++ +toMarked = (++) fromMarked :: Marker -> Marked -> Maybe String fromMarked marker s @@ -47,11 +47,13 @@ getMarked :: Handle -> Marker -> IO (Maybe String) getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing - go (Just l) = case fromMarked marker l of - Nothing -> do - putStrLn l - getMarked h marker - Just v -> return (Just v) + go (Just l) = do + hPutStrLn stderr $ show ("got ", l) + case fromMarked marker l of + Nothing -> do + putStrLn l + getMarked h marker + Just v -> return (Just v) req :: Stage -> Marker -> (String -> IO ()) -> IO () req stage marker a = do -- cgit v1.2.3 From 573c6ab4b8800e40bb749aa25eef9bc5fd2132c6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:17:12 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 3 +-- src/Propellor/Protocol.hs | 12 +++++------- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 744a97ad..95387b83 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -202,7 +202,6 @@ spin hn hst = do go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do let loop = do status <- getMarked fromh statusMarker - print (">>", status) case readish =<< status of Just NeedRepoUrl -> do sendMarked toh repoUrlMarker @@ -299,7 +298,7 @@ boot = do hClose stdin hout <- dup stdOutput hClose stdout - unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ warningMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index bdea7d10..7bbf472d 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -47,13 +47,11 @@ getMarked :: Handle -> Marker -> IO (Maybe String) getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing - go (Just l) = do - hPutStrLn stderr $ show ("got ", l) - case fromMarked marker l of - Nothing -> do - putStrLn l - getMarked h marker - Just v -> return (Just v) + go (Just l) = case fromMarked marker l of + Nothing -> do + putStrLn l + getMarked h marker + Just v -> return (Just v) req :: Stage -> Marker -> (String -> IO ()) -> IO () req stage marker a = do -- cgit v1.2.3 From 02fc9fcca9214e079e577a8c200550ca027ebeb4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:18:26 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 95387b83..1cf28d8e 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -295,8 +295,8 @@ boot = do writeFileProtected privDataLocal req NeedGitPush gitPushMarker $ \_ -> do hin <- dup stdInput - hClose stdin hout <- dup stdOutput + hClose stdin hClose stdout unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ warningMessage "git pull from client failed" -- cgit v1.2.3 -- cgit v1.2.3 From 72e8086d7e3287274f6280eaf9ddf4b8ed578470 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:20:07 -0400 Subject: updte --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 1cf28d8e..dcdc64fb 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -306,7 +306,7 @@ boot = do -- reads from the second fd and sends it to stdout. gitPush :: Fd -> Fd -> IO () gitPush hin hout = do - print ("gitPush", hin, hout) + hPutStrLn stderr $ show ("gitPush", hin, hout) void $ fromstdin `concurrently` tostdout where fromstdin = do -- cgit v1.2.3 -- cgit v1.2.3 From 6cb060b65370966b88f5927fb2396cf039d9ff82 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:23:39 -0400 Subject: problem running propellor --gitpush --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index dcdc64fb..0c092093 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -298,7 +298,7 @@ boot = do hout <- dup stdOutput hClose stdin hClose stdout - unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + unlessM (boolSystem "git" [Param "pull", Param "--upload=pack", Param $ "sh -c ./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ warningMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. -- cgit v1.2.3 -- cgit v1.2.3 From e96a66709a904a7a2e30d9e66873c1515454cdd1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:25:55 -0400 Subject: run upload-pack, not send-pack we're doing a reverse pull from the client --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 0c092093..df739e18 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -212,7 +212,7 @@ spin hn hst = do loop Just NeedGitPush -> do sendMarked toh gitPushMarker "" - unlessM (boolSystem "git" [Param "send-pack", Param "--thin", Param "."]) $ + unlessM (boolSystem "git" [Param "upload-pack", Param "."]) $ warningMessage "git send-pack failed" -- no more protocol possible after -- git push -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From 2ca292a2b470bfbea621790e1fd6f2aa7350bac0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:32:53 -0400 Subject: hook up handles --- src/Propellor/CmdLine.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index df739e18..62fd68f6 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -13,6 +13,7 @@ import System.Posix.IO import Data.Time.Clock.POSIX import Control.Concurrent.Async import qualified Data.ByteString as B +import System.Process (std_in, std_out) import Propellor import Propellor.Protocol @@ -212,7 +213,11 @@ spin hn hst = do loop Just NeedGitPush -> do sendMarked toh gitPushMarker "" - unlessM (boolSystem "git" [Param "upload-pack", Param "."]) $ + let p = (proc "git" ["upload-pack", "."]) + { std_in = UseHandle fromh + , std_out = UseHandle toh } + (Nothing, Nothing, Nothing, h) <- createProcess p + unlessM ((==) ExitSuccess <$> waitForProcess h) $ warningMessage "git send-pack failed" -- no more protocol possible after -- git push -- cgit v1.2.3 -- cgit v1.2.3 From d07edfdbebddf606feb3e602880ac47149adf888 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:34:58 -0400 Subject: temporarily always debug --- src/Propellor/CmdLine.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 62fd68f6..22e0c3f5 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -349,14 +349,13 @@ getRepoUrl = getM get urls checkDebugMode :: IO () checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" where - go (Just s) - | s == "1" = do + go _ = do f <- setFormatter <$> streamHandler stderr DEBUG <*> pure (simpleLogFormatter "[$time] $msg") updateGlobalLogger rootLoggerName $ setLevel DEBUG . setHandlers [f] - go _ = noop + -- go _ = noop -- Parameters can be passed to both ssh and scp, to enable a ssh connection -- caching socket. -- cgit v1.2.3 -- cgit v1.2.3 From 1a910f2516e466387b7cbbd3cb07aeae1c0b7bf1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:35:42 -0400 Subject: typo --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 22e0c3f5..2f41f0c6 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -303,7 +303,7 @@ boot = do hout <- dup stdOutput hClose stdin hClose stdout - unlessM (boolSystem "git" [Param "pull", Param "--upload=pack", Param $ "sh -c ./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + unlessM (boolSystem "git" [Param "pull", Param "--upload-pack", Param $ "sh -c ./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ warningMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. -- cgit v1.2.3 -- cgit v1.2.3 From b120262482e030c05ed98bbd4d935b21b9b0a163 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:37:22 -0400 Subject: fix proto --- src/Propellor/CmdLine.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 2f41f0c6..1aae33fc 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -310,9 +310,7 @@ boot = do -- Reads from stdin and sends it to the first fd; -- reads from the second fd and sends it to stdout. gitPush :: Fd -> Fd -> IO () -gitPush hin hout = do - hPutStrLn stderr $ show ("gitPush", hin, hout) - void $ fromstdin `concurrently` tostdout +gitPush hin hout = void $ fromstdin `concurrently` tostdout where fromstdin = do h <- fdToHandle hin -- cgit v1.2.3 -- cgit v1.2.3 From 32dbfd62fb81edad3cd97bbe57ce3302be8ff7d9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:38:18 -0400 Subject: disable always debug --- src/Propellor/CmdLine.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 1aae33fc..2d4ae403 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -347,13 +347,13 @@ getRepoUrl = getM get urls checkDebugMode :: IO () checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" where - go _ = do + go (Just "1") = do f <- setFormatter <$> streamHandler stderr DEBUG <*> pure (simpleLogFormatter "[$time] $msg") updateGlobalLogger rootLoggerName $ setLevel DEBUG . setHandlers [f] - -- go _ = noop + go _ = noop -- Parameters can be passed to both ssh and scp, to enable a ssh connection -- caching socket. -- cgit v1.2.3 -- cgit v1.2.3 From 75591eb2e8ebd08362d91e42038098db852333eb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:43:00 -0400 Subject: avoid pulling when there is no origin --- src/Propellor/CmdLine.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 2d4ae403..c79b2592 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -142,7 +142,10 @@ getCurrentBranch = takeWhile (/= '\n') <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"] updateFirst :: CmdLine -> IO () -> IO () -updateFirst cmdline next = do +updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next) + +updateFirst' :: CmdLine -> IO () -> IO () +updateFirst' cmdline next = do branchref <- getCurrentBranch let originbranch = "origin" branchref @@ -319,11 +322,15 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout h <- fdToHandle hout B.hGetContents h >>= B.putStr +hasOrigin :: IO Bool +hasOrigin = do + rs <- lines <$> readProcess "git" ["remote"] + return $ "origin" `elem` rs + setRepoUrl :: String -> IO () setRepoUrl "" = return () setRepoUrl url = do - rs <- lines <$> readProcess "git" ["remote"] - let subcmd = if "origin" `elem` rs then "set-url" else "add" + subcmd <- ifM hasOrigin (pure "set-url", pure "add") void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url] -- same as --set-upstream-to, except origin branch -- may not have been pulled yet -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From 18ac1234ac8a3c46e89a3403f8b50ab8d93c55f6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:49:23 -0400 Subject: fix command again --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index c79b2592..9b0d755d 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -306,7 +306,7 @@ boot = do hout <- dup stdOutput hClose stdin hClose stdout - unlessM (boolSystem "git" [Param "pull", Param "--upload-pack", Param $ "sh -c ./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + unlessM (boolSystem "git" [Param "pull", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ warningMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. -- cgit v1.2.3 -- cgit v1.2.3 From 7956fda7d528356d5aa81c2cbf402e83fde39e82 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 15:53:15 -0400 Subject: get handles right way roung --- src/Propellor/CmdLine.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 9b0d755d..a41314f5 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -310,16 +310,16 @@ boot = do warningMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. --- Reads from stdin and sends it to the first fd; --- reads from the second fd and sends it to stdout. +-- Reads from stdin and sends it to hout; +-- reads from hin and sends it to stdout. gitPush :: Fd -> Fd -> IO () gitPush hin hout = void $ fromstdin `concurrently` tostdout where fromstdin = do - h <- fdToHandle hin + h <- fdToHandle hout B.getContents >>= B.hPut h tostdout = do - h <- fdToHandle hout + h <- fdToHandle hin B.hGetContents h >>= B.putStr hasOrigin :: IO Bool -- cgit v1.2.3 -- cgit v1.2.3 From 6f93f8496f806ce1ebb5252bea53b27495ba3366 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:03:19 -0400 Subject: use lazy bytestrings so it streams --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index a41314f5..ea2fadad 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -12,7 +12,7 @@ import Control.Exception (bracket) import System.Posix.IO import Data.Time.Clock.POSIX import Control.Concurrent.Async -import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as B import System.Process (std_in, std_out) import Propellor -- cgit v1.2.3 -- cgit v1.2.3 From c1a6f81c7ef7095273c6665521ac156c82e6b687 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:10:13 -0400 Subject: better IO loop, with debugging --- src/Propellor/CmdLine.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index ea2fadad..f8d5d57d 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -12,7 +12,7 @@ import Control.Exception (bracket) import System.Posix.IO import Data.Time.Clock.POSIX import Control.Concurrent.Async -import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString as B import System.Process (std_in, std_out) import Propellor @@ -317,10 +317,17 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout where fromstdin = do h <- fdToHandle hout - B.getContents >>= B.hPut h + connect stdin h tostdout = do h <- fdToHandle hin - B.hGetContents h >>= B.putStr + connect h stdout + connect fromh toh = do + b <- B.hGetSome fromh 40960 + unless (B.null b) $ do + hPutStrLn stderr $ show ("got", fromh, b) + B.hPut toh b + hFlush toh + connect fromh toh hasOrigin :: IO Bool hasOrigin = do -- cgit v1.2.3 -- cgit v1.2.3 From 06add92bce29789eda12cd41b61fe8fde2f64ff4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:12:27 -0400 Subject: tweak --- src/Propellor/CmdLine.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index f8d5d57d..e84a220e 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -221,7 +221,7 @@ spin hn hst = do , std_out = UseHandle toh } (Nothing, Nothing, Nothing, h) <- createProcess p unlessM ((==) ExitSuccess <$> waitForProcess h) $ - warningMessage "git send-pack failed" + warningMessage "git upload-pack failed" -- no more protocol possible after -- git push Just NeedGitClone -> do @@ -324,7 +324,6 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout connect fromh toh = do b <- B.hGetSome fromh 40960 unless (B.null b) $ do - hPutStrLn stderr $ show ("got", fromh, b) B.hPut toh b hFlush toh connect fromh toh -- cgit v1.2.3 -- cgit v1.2.3 From 935e1d11fe9cfe5d177e18323be32e093698697a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:24:45 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index e84a220e..7b20574a 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -218,7 +218,8 @@ spin hn hst = do sendMarked toh gitPushMarker "" let p = (proc "git" ["upload-pack", "."]) { std_in = UseHandle fromh - , std_out = UseHandle toh } + , std_out = UseHandle toh + } (Nothing, Nothing, Nothing, h) <- createProcess p unlessM ((==) ExitSuccess <$> waitForProcess h) $ warningMessage "git upload-pack failed" -- cgit v1.2.3 From 257f9f6bb229c61a99899125ac81906125094f6a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:28:27 -0400 Subject: debug --- src/Propellor/CmdLine.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 7b20574a..293bf3a2 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -222,7 +222,7 @@ spin hn hst = do } (Nothing, Nothing, Nothing, h) <- createProcess p unlessM ((==) ExitSuccess <$> waitForProcess h) $ - warningMessage "git upload-pack failed" + errorMessage "git upload-pack failed" -- no more protocol possible after -- git push Just NeedGitClone -> do @@ -308,7 +308,7 @@ boot = do hClose stdin hClose stdout unlessM (boolSystem "git" [Param "pull", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ - warningMessage "git pull from client failed" + errorMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. -- Reads from stdin and sends it to hout; @@ -324,6 +324,7 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout connect h stdout connect fromh toh = do b <- B.hGetSome fromh 40960 + hPutStrLn stderr $ show ("from", fromh, "to", toh, b) unless (B.null b) $ do B.hPut toh b hFlush toh -- cgit v1.2.3 -- cgit v1.2.3 From c008813becfa09162d249adbb4ae47f16e329d23 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:36:34 -0400 Subject: close handles --- src/Propellor/CmdLine.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 293bf3a2..8591395d 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -325,10 +325,14 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout connect fromh toh = do b <- B.hGetSome fromh 40960 hPutStrLn stderr $ show ("from", fromh, "to", toh, b) - unless (B.null b) $ do - B.hPut toh b - hFlush toh - connect fromh toh + if B.null b + then do + hClose fromh + hClose toh + else do + B.hPut toh b + hFlush toh + connect fromh toh hasOrigin :: IO Bool hasOrigin = do -- cgit v1.2.3 -- cgit v1.2.3 From 12aa7f494869b99f6b2792dde56568daebb11726 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:45:31 -0400 Subject: set handles to binary mode --- src/Propellor/CmdLine.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 8591395d..f22abc43 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -323,6 +323,8 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout h <- fdToHandle hin connect h stdout connect fromh toh = do + hSetBinaryMode fromh True + hSetBinaryMode toh True b <- B.hGetSome fromh 40960 hPutStrLn stderr $ show ("from", fromh, "to", toh, b) if B.null b -- cgit v1.2.3 -- cgit v1.2.3 From bdbb1686df25f0055c6a0352deb7232b68f633aa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:47:41 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index f22abc43..309b3e85 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -217,10 +217,13 @@ spin hn hst = do Just NeedGitPush -> do sendMarked toh gitPushMarker "" let p = (proc "git" ["upload-pack", "."]) - { std_in = UseHandle fromh - , std_out = UseHandle toh + -- { std_in = UseHandle fromh + { std_out = UseHandle toh } (Nothing, Nothing, Nothing, h) <- createProcess p + forever $ do + b <- B.hGetSome fromh 40960 + hPutStrLn stderr $ show ("<<<", b) unlessM ((==) ExitSuccess <$> waitForProcess h) $ errorMessage "git upload-pack failed" -- no more protocol possible after -- cgit v1.2.3 From 83431b7b586ad759e843b120086735aaa0e8fc54 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:49:37 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 309b3e85..0711064d 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -216,14 +216,15 @@ spin hn hst = do loop Just NeedGitPush -> do sendMarked toh gitPushMarker "" + void $ hGetLine fromh let p = (proc "git" ["upload-pack", "."]) - -- { std_in = UseHandle fromh - { std_out = UseHandle toh + { std_in = UseHandle fromh + , std_out = UseHandle toh } (Nothing, Nothing, Nothing, h) <- createProcess p - forever $ do + {-forever $ do b <- B.hGetSome fromh 40960 - hPutStrLn stderr $ show ("<<<", b) + hPutStrLn stderr $ show ("<<<", b)-} unlessM ((==) ExitSuccess <$> waitForProcess h) $ errorMessage "git upload-pack failed" -- no more protocol possible after -- cgit v1.2.3 From 511a728b388860e1efe238a5b3dd12f914db2846 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:52:01 -0400 Subject: finally cracked it! A newline was slipping in and messing up the git protocol. --- src/Propellor/CmdLine.hs | 5 ----- src/Propellor/Protocol.hs | 6 ++---- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 0711064d..1345a298 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -216,15 +216,11 @@ spin hn hst = do loop Just NeedGitPush -> do sendMarked toh gitPushMarker "" - void $ hGetLine fromh let p = (proc "git" ["upload-pack", "."]) { std_in = UseHandle fromh , std_out = UseHandle toh } (Nothing, Nothing, Nothing, h) <- createProcess p - {-forever $ do - b <- B.hGetSome fromh 40960 - hPutStrLn stderr $ show ("<<<", b)-} unlessM ((==) ExitSuccess <$> waitForProcess h) $ errorMessage "git upload-pack failed" -- no more protocol possible after @@ -330,7 +326,6 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout hSetBinaryMode fromh True hSetBinaryMode toh True b <- B.hGetSome fromh 40960 - hPutStrLn stderr $ show ("from", fromh, "to", toh, b) if B.null b then do hClose fromh diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index 7bbf472d..99afb31f 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -1,7 +1,7 @@ -- | This is a simple line-based protocol used for communication between -- a local and remote propellor. It's sent over a ssh channel, and lines of -- the protocol can be interspersed with other, non-protocol lines --- that should just be passed through to be displayed. +-- that should be ignored. module Propellor.Protocol where @@ -48,9 +48,7 @@ getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing go (Just l) = case fromMarked marker l of - Nothing -> do - putStrLn l - getMarked h marker + Nothing -> getMarked h marker Just v -> return (Just v) req :: Stage -> Marker -> (String -> IO ()) -> IO () -- cgit v1.2.3 From fc657d62cb78b536a515ea35e5f294f453592d5c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 16:55:20 -0400 Subject: action message --- src/Propellor/CmdLine.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 1345a298..0d7fdd48 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -214,17 +214,19 @@ spin hn hst = do Just NeedPrivData -> do sendprivdata toh privdata loop - Just NeedGitPush -> do + Just NeedGitPush -> void $ actionMessage "Git update" $ do sendMarked toh gitPushMarker "" let p = (proc "git" ["upload-pack", "."]) { std_in = UseHandle fromh , std_out = UseHandle toh } (Nothing, Nothing, Nothing, h) <- createProcess p - unlessM ((==) ExitSuccess <$> waitForProcess h) $ - errorMessage "git upload-pack failed" + r <- waitForProcess h -- no more protocol possible after -- git push + hClose fromh + hClose toh + return (r == ExitSuccess) Just NeedGitClone -> do hClose toh hClose fromh -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From efa32839757e7fab14b94a1032741677b076d67e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:05:25 -0400 Subject: reformat --- src/Propellor/CmdLine.hs | 87 ++++++++++++++++++++++++------------------------ 1 file changed, 44 insertions(+), 43 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 0d7fdd48..707c5956 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -197,54 +197,55 @@ spin hn hst = do void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] void $ boolSystem "git" [Param "push"] cacheparams <- toCommand <$> sshCachingParams hn - go cacheparams =<< hostprivdata + comm cacheparams =<< hostprivdata unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $ error $ "remote propellor failed (running: " ++ runcmd ++")" where hostprivdata = show . filterPrivData hst <$> decryptPrivData - go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do - let loop = do - status <- getMarked fromh statusMarker - case readish =<< status of - Just NeedRepoUrl -> do - sendMarked toh repoUrlMarker - =<< (fromMaybe "" <$> getRepoUrl) - loop - Just NeedPrivData -> do - sendprivdata toh privdata - loop - Just NeedGitPush -> void $ actionMessage "Git update" $ do - sendMarked toh gitPushMarker "" - let p = (proc "git" ["upload-pack", "."]) - { std_in = UseHandle fromh - , std_out = UseHandle toh - } - (Nothing, Nothing, Nothing, h) <- createProcess p - r <- waitForProcess h - -- no more protocol possible after - -- git push - hClose fromh - hClose toh - return (r == ExitSuccess) - Just NeedGitClone -> do - hClose toh - hClose fromh - sendGitClone hn - go cacheparams privdata - -- Ready is only sent by old versions of - -- propellor. They expect to get privdata, - -- and then no more protocol communication. - Just Ready -> do - sendprivdata toh privdata - hClose toh - - -- Display remaining output. - void $ tryIO $ forever $ - showremote =<< hGetLine fromh - hClose fromh - Nothing -> return () - loop + comm cacheparams privdata = + withBothHandles createProcessSuccess + (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) + (comm' cacheparams privdata) + comm' cacheparams privdata (toh, fromh) = loop + where + loop = dispatch =<< (maybe Nothing readish <$> getMarked fromh statusMarker) + dispatch (Just NeedRepoUrl) = do + sendMarked toh repoUrlMarker + =<< (fromMaybe "" <$> getRepoUrl) + loop + dispatch (Just NeedPrivData) = do + sendprivdata toh privdata + loop + dispatch (Just NeedGitPush) = do + void $ actionMessage ("Sending git update to " ++ hn) $ do + sendMarked toh gitPushMarker "" + let p = (proc "git" ["upload-pack", "."]) + { std_in = UseHandle fromh + , std_out = UseHandle toh + } + (Nothing, Nothing, Nothing, h) <- createProcess p + r <- waitForProcess h + -- no more protocol possible after git push + hClose fromh + hClose toh + return (r == ExitSuccess) + dispatch (Just NeedGitClone) = do + hClose toh + hClose fromh + sendGitClone hn + comm cacheparams privdata + -- Ready is only sent by old versions of + -- propellor. They expect to get privdata, + -- and then no more protocol communication. + dispatch (Just Ready) = do + sendprivdata toh privdata + hClose toh + -- Display remaining output. + void $ tryIO $ forever $ + showremote =<< hGetLine fromh + hClose fromh + dispatch Nothing = return () user = "root@"++hn -- cgit v1.2.3 -- cgit v1.2.3 From ec9cdf5d7357c2754cf6a2fd4941e86c3fb86384 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:06:39 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 707c5956..18c88f65 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -310,7 +310,7 @@ boot = do hout <- dup stdOutput hClose stdin hClose stdout - unlessM (boolSystem "git" [Param "pull", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + unlessM (boolSystem "git" [Param "pull", Param "--progress", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ errorMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From 4f352327be32b045585cf134446613e0be625e80 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:10:10 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 18c88f65..e7da0a80 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -195,7 +195,12 @@ getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref spin :: HostName -> Host -> IO () spin hn hst = do void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] - void $ boolSystem "git" [Param "push"] + -- Push to central origin repo first, if possible. + -- The remote propellor will pull from there, which avoids + -- us needing to send stuff directly to the remote host. + whenM hasOrigin $ + void $ boolSystem "git" [Param "push"] + cacheparams <- toCommand <$> sshCachingParams hn comm cacheparams =<< hostprivdata unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $ -- cgit v1.2.3 From 7fd8150b1fca025f9763eeb4ba77df9f92d2685f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:12:17 -0400 Subject: propellor spin --- src/Propellor/CmdLine.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index e7da0a80..db7d93ae 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -315,8 +315,10 @@ boot = do hout <- dup stdOutput hClose stdin hClose stdout - unlessM (boolSystem "git" [Param "pull", Param "--progress", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ - errorMessage "git pull from client failed" + unlessM (boolSystem "git" [Param "fetch", Param "--progress", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + errorMessage "git fetch from client failed" + unlessM (boolSystem "git" [Param "merge", Param "--quiet", Param "FETCH_HEAD"]) $ + errorMessage "git merge failed" -- Shim for git push over the propellor ssh channel. -- Reads from stdin and sends it to hout; -- cgit v1.2.3 -- cgit v1.2.3 From 74e067fa7640847cb0395ab4bf17c1d01c3b9349 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:26:02 -0400 Subject: propellor spin --- debian/changelog | 9 ++++++--- doc/README.mdwn | 45 +++++++++++++++++++++++++++++++++------------ src/Propellor/CmdLine.hs | 6 ++---- 3 files changed, 41 insertions(+), 19 deletions(-) diff --git a/debian/changelog b/debian/changelog index 4a3853f8..2e5a8bbd 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,5 +1,11 @@ propellor (0.9.3) UNRELEASED; urgency=medium + * propellor --spin can now be used to update remote hosts, without + any central git repository being used. The git repository is updated + over propellor's ssh connection to the remote host. The central + git repository is still useful for running propellor from cron, + but this simplifies getting started with propellor. + * The git repo url, if any, is updated whenever propellor --spin is used. * Added prosody module, contributed by Félix Sipma. * Can be used to configure tor hidden services. Thanks, Félix Sipma. * When multiple gpg keys are added, ensure that the privdata file @@ -9,9 +15,6 @@ propellor (0.9.3) UNRELEASED; urgency=medium kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. - * The git repo url is updated whenever propellor --spin is used, - and a central git repo does not need to be set up before using --spin - for the first time. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 diff --git a/doc/README.mdwn b/doc/README.mdwn index a0742f78..47fa8e40 100644 --- a/doc/README.mdwn +++ b/doc/README.mdwn @@ -35,7 +35,7 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask ## quick start -1. Get propellor installed +1. Get propellor installed on your laptop. `cabal install propellor` or `apt-get install propellor` @@ -44,25 +44,46 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask 3. If you don't have a gpg private key already, generate one: `gpg --gen-key` 4. Run: `propellor --add-key $KEYID`, which will make propellor trust your gpg key, and will sign your `~/.propellor` repository using it. -5. Push the git repository to a central server (github or your own): - `cd ~/.propellor/; git remote add origin ssh://git.example.com/propellor.git; git push -u origin master` -6. Edit `~/.propellor/config.hs`, and add a host you want to manage. +5. Edit `~/.propellor/config.hs`, and add a host you want to manage. You can start by not adding any properties, or only a few. -7. Pick a host and run: `propellor --spin $HOST` -8. Now you have a simple propellor deployment, but it doesn't do +6. Pick a host and run: `propellor --spin $HOST` +7. Now you have a simple propellor deployment, but it doesn't do much to the host yet, besides installing propellor. So, edit `~/.propellor/config.hs` to configure the host (maybe - start with a few simple properties), and re-run step 7. + start with a few simple properties), and re-run step 6. Repeat until happy and move on to the next host. :) -9. To move beyond manually running `propellor --spin` against hosts - when you change their properties, add a property to your hosts - like: `Cron.runPropellor "30 * * * *"` - +8. Write some neat new properties and send patches! + +## adding a central git repository + +The above quick start uses propellor without any central git repository. +Instead, the git repo on a host gets updated from the repo on your laptop +whenever you run `propellor --spin $HOST`. + +A central git repository allows hosts to run propellor from cron and pick +up any updates you may have pushed. This is useful when managing several +hosts with propellor. + +You can add a central git repository to your existing propellor setup easily: + +1. Push propellor's git repository to a central server (github or your own): + `cd ~/.propellor/; git remote add origin ssh://git.example.com/propellor.git; git push -u origin master` + +2. Configure the url your hosts should use for the git repisitory, if + it differs from the url above, by setting up a remote named "deploy": + `cd ~/.propellor/; git remote add deploy git://git.example.com/propellor.git` + +2. Add a property to your hosts like: + `Cron.runPropellor "30 * * * *"` + +3. Let your hosts know about the changed configuration (including the url + to the central repository), by running `proellor --spin $HOST` for each + of your hosts. + Now they'll automatically update every 30 minutes, and you can `git commit -S` and `git push` changes that affect any number of hosts. -10. Write some neat new properties and send patches! ## debugging diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index db7d93ae..e7da0a80 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -315,10 +315,8 @@ boot = do hout <- dup stdOutput hClose stdin hClose stdout - unlessM (boolSystem "git" [Param "fetch", Param "--progress", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ - errorMessage "git fetch from client failed" - unlessM (boolSystem "git" [Param "merge", Param "--quiet", Param "FETCH_HEAD"]) $ - errorMessage "git merge failed" + unlessM (boolSystem "git" [Param "pull", Param "--progress", Param "--upload-pack", Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $ + errorMessage "git pull from client failed" -- Shim for git push over the propellor ssh channel. -- Reads from stdin and sends it to hout; -- cgit v1.2.3 From eaa460c04bfa65f566693c9262c591890d506725 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:33:08 -0400 Subject: doc updates --- doc/README.mdwn | 34 +++------------------------------- doc/centralized_git_repository.mdwn | 31 +++++++++++++++++++++++++++++++ doc/security.mdwn | 3 ++- 3 files changed, 36 insertions(+), 32 deletions(-) create mode 100644 doc/centralized_git_repository.mdwn diff --git a/doc/README.mdwn b/doc/README.mdwn index 47fa8e40..29e5fbb7 100644 --- a/doc/README.mdwn +++ b/doc/README.mdwn @@ -53,37 +53,9 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask So, edit `~/.propellor/config.hs` to configure the host (maybe start with a few simple properties), and re-run step 6. Repeat until happy and move on to the next host. :) -8. Write some neat new properties and send patches! - -## adding a central git repository - -The above quick start uses propellor without any central git repository. -Instead, the git repo on a host gets updated from the repo on your laptop -whenever you run `propellor --spin $HOST`. - -A central git repository allows hosts to run propellor from cron and pick -up any updates you may have pushed. This is useful when managing several -hosts with propellor. - -You can add a central git repository to your existing propellor setup easily: - -1. Push propellor's git repository to a central server (github or your own): - `cd ~/.propellor/; git remote add origin ssh://git.example.com/propellor.git; git push -u origin master` - -2. Configure the url your hosts should use for the git repisitory, if - it differs from the url above, by setting up a remote named "deploy": - `cd ~/.propellor/; git remote add deploy git://git.example.com/propellor.git` - -2. Add a property to your hosts like: - `Cron.runPropellor "30 * * * *"` - -3. Let your hosts know about the changed configuration (including the url - to the central repository), by running `proellor --spin $HOST` for each - of your hosts. - - Now they'll automatically update every 30 minutes, and you can - `git commit -S` and `git push` changes that affect any number of - hosts. +8. Optionally, set up a [centralized git repository](https://propellor.branchable.com/centralized_git_repository/) + so multiple hosts can be updated with a simple `git commit -S; git push` +9. Write some neat new properties and send patches! ## debugging diff --git a/doc/centralized_git_repository.mdwn b/doc/centralized_git_repository.mdwn new file mode 100644 index 00000000..98fe9bf2 --- /dev/null +++ b/doc/centralized_git_repository.mdwn @@ -0,0 +1,31 @@ +Propellor can be used without any centralized git repsitory. When +`propellor --spin $HOST` is run, propellor pushes the local git repo +directly to the host. This makes it easy to get started with propellor. + +A central git repository allows hosts to run propellor from cron and pick +up any updates you may have pushed. This is useful when managing several +hosts with propellor. + +You can add a central git repository to your existing propellor setup easily: + +1. Push propellor's git repository to a central server (github or your own): + `cd ~/.propellor/; git remote add origin ssh://git.example.com/propellor.git; git push -u origin master` + +2. Configure the url your hosts should use for the git repisitory, if + it differs from the url above, by setting up a remote named "deploy": + `cd ~/.propellor/; git remote add deploy git://git.example.com/propellor.git` + +2. Add a property to your hosts like: + `Cron.runPropellor "30 * * * *"` + +3. Let your hosts know about the changed configuration (including the url + to the central repository), by running `proellor --spin $HOST` for each + of your hosts. + +Now the hosts will automatically update every 30 minutes, and you can +`git commit -S` and `git push` changes that affect any number of +hosts. + +Note that private data, set with `propellor --set`, is gpg encrypted, and +hosts cannot decrypt it! So after updating the private data of a host, +you still need to manually run `propellor --spin $HOST` diff --git a/doc/security.mdwn b/doc/security.mdwn index 075d68ec..bcbc28ed 100644 --- a/doc/security.mdwn +++ b/doc/security.mdwn @@ -1,5 +1,6 @@ Propellor's security model is that the hosts it's used to deploy are -untrusted, and that the central git repository server is untrusted too. +untrusted, and that the central git repository server, if any, +is untrusted too. The only trusted machine is the laptop where you run `propellor --spin` to connect to a remote host. And that one only because you have a ssh key -- cgit v1.2.3