diff --git a/config-joey.hs b/config-joey.hs index ee0c54a..7d48aee 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" diff --git a/debian/changelog b/debian/changelog index 3858ac2..2e5a8bb 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 @@ -7,6 +13,8 @@ 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. + * Run remote propellor --spin with a controlling terminal. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 diff --git a/doc/README.mdwn b/doc/README.mdwn index a0742f7..29e5fbb 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,18 @@ 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 * * * *"` - - 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! +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 0000000..98fe9bf --- /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 fb174cb..7edf25d 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 diff --git a/propellor.cabal b/propellor.cabal index 8e552f2..0a01ada 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 c3b792d..e7da0a8 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -11,8 +11,12 @@ 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 System.Process (std_in, std_out) import Propellor +import Propellor.Protocol import Propellor.PrivData.Paths import Propellor.Gpg import qualified Propellor.Property.Docker as Docker @@ -42,6 +46,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 @@ -52,6 +57,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 @@ -84,6 +90,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 @@ -91,7 +98,7 @@ defaultMain hostlist = do ( onlyProcess $ withhost hn mainProperties , go True (Spin hn) ) - go False (Boot hn) = onlyProcess $ withhost hn boot + go False (Boot _) = onlyProcess boot withhost :: HostName -> (Host -> IO ()) -> IO () withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn) @@ -135,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 @@ -179,37 +189,74 @@ 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"] + -- 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 - go cacheparams url =<< 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 url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do - let finish = do - senddata toh "privdata" privDataMarker privdata + 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 - status <- getstatus fromh `catchIO` (const $ errorMessage "protocol error (perhaps the remote propellor failed to run?)") - case status of - Ready -> finish - NeedGitClone -> do - hClose toh - hClose fromh - sendGitClone hn url - go cacheparams url privdata + dispatch Nothing = return () user = "root@"++hn - bootstrapcmd = shellWrap $ intercalate " ; " + mkcmd = shellWrap . intercalate " ; " + + bootstrapcmd = mkcmd [ "if [ ! -d " ++ localdir ++ " ]" , "then " ++ intercalate " && " [ "apt-get update" @@ -224,24 +271,19 @@ spin hn hst = do , "fi" ] - 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 - + runcmd = mkcmd + [ "cd " ++ localdir ++ " && ./propellor --run " ++ hn ] + showremote s = putStrLn s - senddata 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. -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 @@ -257,59 +299,71 @@ 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 - -- has not 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 :: Host -> IO () -boot h = do - sendMarked stdout statusMarker $ show Ready - reply <- hGetContentsStrict stdin - +-- 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 + req NeedRepoUrl repoUrlMarker setRepoUrl makePrivDataDir - maybe noop (writeFileProtected privDataLocal) $ - fromMarked privDataMarker reply - mainProperties h + req NeedPrivData privDataMarker $ + writeFileProtected privDataLocal + req NeedGitPush gitPushMarker $ \_ -> do + hin <- dup stdInput + 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" -getUrl :: IO String -getUrl = maybe nourl return =<< getM get urls +-- Shim for git push over the propellor ssh channel. +-- 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 hout + connect stdin h + tostdout = do + h <- fdToHandle hin + connect h stdout + connect fromh toh = do + hSetBinaryMode fromh True + hSetBinaryMode toh True + b <- B.hGetSome fromh 40960 + 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 + rs <- lines <$> readProcess "git" ["remote"] + return $ "origin" `elem` rs + +setRepoUrl :: String -> IO () +setRepoUrl "" = return () +setRepoUrl url = do + 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 + 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') @@ -321,8 +375,7 @@ getUrl = maybe nourl return =<< getM get urls checkDebugMode :: IO () checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" where - go (Just s) - | s == "1" = do + go (Just "1") = do f <- setFormatter <$> streamHandler stderr DEBUG <*> pure (simpleLogFormatter "[$time] $msg") diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index afbed1c..e184a59 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -8,6 +8,21 @@ import System.Log.Logger import "mtl" Control.Monad.Reader import Propellor.Types +import Utility.Monad + +data MessageHandle + = ConsoleMessageHandle + | TextMessageHandle + +mkMessageHandle :: IO MessageHandle +mkMessageHandle = ifM (hIsTerminalDevice stdout) + ( 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 +36,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 diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs new file mode 100644 index 0000000..99afb31 --- /dev/null +++ b/src/Propellor/Protocol.hs @@ -0,0 +1,57 @@ +-- | 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 be ignored. + +module Propellor.Protocol where + +import Data.List + +import Propellor + +data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush + deriving (Read, Show, Eq) + +type Marker = String +type Marked = String + +statusMarker :: Marker +statusMarker = "STATUS" + +privDataMarker :: String +privDataMarker = "PRIVDATA " + +repoUrlMarker :: String +repoUrlMarker = "REPOURL " + +gitPushMarker :: String +gitPushMarker = "GITPUSH" + +toMarked :: Marker -> String -> String +toMarked = (++) + +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 has been output, and the marker needs to + -- come at the start of a line. + hPutStrLn h ("\n" ++ toMarked marker s) + hFlush h + +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 -> 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 diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index b606cef..72ccd22 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 @@ -137,7 +138,6 @@ instance ActionResult Result where data CmdLine = Run HostName | Spin HostName - | Boot HostName | Set PrivDataField Context | Dump PrivDataField Context | Edit PrivDataField Context @@ -145,5 +145,7 @@ data CmdLine | AddKey String | Continue CmdLine | Chain HostName + | Boot HostName | Docker HostName + | GitPush Fd Fd deriving (Read, Show, Eq)