From 239581c75901c3305eaa9298cf41de28a57bd099 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 20:17:46 -0400 Subject: [PATCH] reorg --- propellor.cabal | 2 +- src/Propellor/CmdLine.hs | 61 +------------------------ src/Propellor/{Server.hs => Spin.hs} | 67 +++++++++++++++++++++++++--- 3 files changed, 63 insertions(+), 67 deletions(-) rename src/Propellor/{Server.hs => Spin.hs} (74%) diff --git a/propellor.cabal b/propellor.cabal index 9fe7a26..20aba22 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -121,7 +121,7 @@ Library Other-Modules: Propellor.Git Propellor.Gpg - Propellor.Server + Propellor.Spin Propellor.Ssh Propellor.PrivData.Paths Propellor.Protocol diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 5c051d1..f5cfc78 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -10,11 +10,9 @@ import System.PosixCompat import qualified Network.BSD import Propellor -import Propellor.Protocol import Propellor.Gpg import Propellor.Git -import Propellor.Ssh -import Propellor.Server +import Propellor.Spin import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Shim as Shim @@ -155,63 +153,6 @@ updateFirst' cmdline next = ifM fetchOrigin , next ) -spin :: HostName -> Maybe HostName -> Host -> IO () -spin target relay hst = do - unless relaying $ do - void $ actionMessage "Git commit" $ - gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] - -- 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 $ actionMessage "Push to central git repository" $ - boolSystem "git" [Param "push"] - - cacheparams <- if viarelay - then pure ["-A"] - else toCommand <$> sshCachingParams hn - when viarelay $ - void $ boolSystem "ssh-add" [] - - -- Install, or update the remote propellor. - updateServer target relay hst $ withBothHandles createProcessSuccess - (proc "ssh" $ cacheparams ++ [user, updatecmd]) - - -- And now we can run it. - unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $ - error $ "remote propellor failed" - where - hn = fromMaybe target relay - user = "root@"++hn - - relaying = relay == Just target - viarelay = isJust relay && not relaying - - mkcmd = shellWrap . intercalate " ; " - - updatecmd = mkcmd - [ "if [ ! -d " ++ localdir ++ "/.git ]" - , "then (" ++ intercalate " && " - [ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi" - , "echo " ++ toMarked statusMarker (show NeedGitClone) - ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled) - , "else " ++ intercalate " && " - [ "cd " ++ localdir - , "if ! test -x ./propellor; then make deps build; fi" - , if viarelay - then "./propellor --continue " ++ - shellEscape (show (Update (Just target))) - -- Still using --boot for back-compat... - else "./propellor --boot " ++ target - ] - , "fi" - ] - - runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ] - cmd = if viarelay - then "--serialized " ++ shellEscape (show (Spin target (Just target))) - else "--continue " ++ shellEscape (show (SimpleRun target)) - hostname :: String -> IO HostName hostname s | "." `isInfixOf` s = pure s diff --git a/src/Propellor/Server.hs b/src/Propellor/Spin.hs similarity index 74% rename from src/Propellor/Server.hs rename to src/Propellor/Spin.hs index 77f7208..8baf4fd 100644 --- a/src/Propellor/Server.hs +++ b/src/Propellor/Spin.hs @@ -1,10 +1,6 @@ --- When propellor --spin is running, the local host acts as a server, --- which connects to the remote host's propellor and responds to its --- requests. - -module Propellor.Server ( +module Propellor.Spin ( + spin, update, - updateServer, gitPushHelper ) where @@ -22,10 +18,68 @@ import Propellor.Protocol import Propellor.PrivData.Paths import Propellor.Git import Propellor.Ssh +import Propellor.Gpg import qualified Propellor.Shim as Shim import Utility.FileMode import Utility.SafeCommand +spin :: HostName -> Maybe HostName -> Host -> IO () +spin target relay hst = do + unless relaying $ do + void $ actionMessage "Git commit" $ + gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] + -- 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 $ actionMessage "Push to central git repository" $ + boolSystem "git" [Param "push"] + + cacheparams <- if viarelay + then pure ["-A"] + else toCommand <$> sshCachingParams hn + when viarelay $ + void $ boolSystem "ssh-add" [] + + -- Install, or update the remote propellor. + updateServer target relay hst $ withBothHandles createProcessSuccess + (proc "ssh" $ cacheparams ++ [user, updatecmd]) + + -- And now we can run it. + unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $ + error $ "remote propellor failed" + where + hn = fromMaybe target relay + user = "root@"++hn + + relaying = relay == Just target + viarelay = isJust relay && not relaying + + mkcmd = shellWrap . intercalate " ; " + + updatecmd = mkcmd + [ "if [ ! -d " ++ localdir ++ "/.git ]" + , "then (" ++ intercalate " && " + [ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi" + , "echo " ++ toMarked statusMarker (show NeedGitClone) + ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled) + , "else " ++ intercalate " && " + [ "cd " ++ localdir + , "if ! test -x ./propellor; then make deps build; fi" + , if viarelay + then "./propellor --continue " ++ + shellEscape (show (Update (Just target))) + -- Still using --boot for back-compat... + else "./propellor --boot " ++ target + ] + , "fi" + ] + + runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ] + cmd = if viarelay + then "--serialized " ++ shellEscape (show (Spin target (Just target))) + else "--continue " ++ shellEscape (show (SimpleRun target)) + -- Update the privdata, repo url, and git repo over the ssh -- connection, talking to the user's local propellor instance which is -- running the updateServer @@ -177,6 +231,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor unpackcmd = shellWrap $ intercalate " && " [ "cd " ++ takeDirectory remotetarball + , "rm -rf " ++ localdir , "tar xzf " ++ remotetarball , "rm -f " ++ remotetarball ]