summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Propellor/CmdLine.hs3
-rw-r--r--src/Propellor/Property/ControlHeir.hs19
-rw-r--r--src/Propellor/Spin.hs77
3 files changed, 46 insertions, 53 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index a0be167e..9f798166 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -119,8 +119,7 @@ defaultMain hostlist = do
go True cmdline = updateFirst cmdline $ go False cmdline
go False (Spin hs mrelay) = do
commitSpin
- forM_ hs $ \hn -> withhost hn $
- spin (maybe RegularSpin RelaySpin mrelay) hn
+ forM_ hs $ \hn -> withhost hn $ spin mrelay hn
go False cmdline@(SimpleRun hn) = buildFirst cmdline $
go False (Run hn)
go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
diff --git a/src/Propellor/Property/ControlHeir.hs b/src/Propellor/Property/ControlHeir.hs
index c51c9b52..9fd2ce43 100644
--- a/src/Propellor/Property/ControlHeir.hs
+++ b/src/Propellor/Property/ControlHeir.hs
@@ -8,7 +8,8 @@ module Propellor.Property.ControlHeir (
) where
import Propellor.Base
-import Propellor.Spin (spin, SpinMode(..))
+import Propellor.Spin (spin')
+import Propellor.PrivData.Paths
import Propellor.Types.Info
import qualified Propellor.Property.Ssh as Ssh
@@ -170,13 +171,6 @@ controllerFor h = infoProperty desc go (mkControllingInfo h <> privinfo) []
where
desc = cdesc (hostName h)
- go = do
- liftIO $ spin ControllingSpin (hostName h) h
- -- Don't know if the spin made a change to
- -- the remote host or not, but in any case,
- -- the local host was not changed.
- noChange
-
-- Make the controlling host have all the remote host's
-- PrivData, so it can send it on to the remote host
-- when spinning it.
@@ -184,6 +178,15 @@ controllerFor h = infoProperty desc go (mkControllingInfo h <> privinfo) []
forceHostContext (hostName h) $
getInfo (hostInfo h)
+ go = do
+ pm <- liftIO $ filterPrivData h . readPrivData
+ <$> readFileStrictAnyEncoding privDataLocal
+ liftIO $ spin' (Just pm) Nothing (hostName h) h
+ -- Don't know if the spin made a change to
+ -- the remote host or not, but in any case,
+ -- the local host was not changed.
+ noChange
+
-- | Use this property to let the specified controller Host ssh in
-- and run propellor.
controlledBy :: Host -> Property NoInfo
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 587a7f76..3cdd8c98 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -1,7 +1,7 @@
module Propellor.Spin (
commitSpin,
- SpinMode(..),
spin,
+ spin',
update,
gitPushHelper,
mergeSpin,
@@ -41,41 +41,35 @@ commitSpin = do
void $ actionMessage "Push to central git repository" $
boolSystem "git" [Param "push"]
-data SpinMode
- = RegularSpin
- | RelaySpin HostName
- | ControllingSpin
- deriving (Eq)
+spin :: Maybe HostName -> HostName -> Host -> IO ()
+spin = spin' Nothing
-spin :: SpinMode -> HostName -> Host -> IO ()
-spin spinmode target hst = do
+spin' :: Maybe PrivMap -> Maybe HostName -> HostName -> Host -> IO ()
+spin' mprivdata relay target hst = do
cacheparams <- if viarelay
then pure ["-A"]
else toCommand <$> sshCachingParams hn
when viarelay $
void $ boolSystem "ssh-add" []
- sshtarget <- ("root@" ++) <$> case spinmode of
- RelaySpin r -> pure r
- _ -> getSshTarget target hst
+ sshtarget <- ("root@" ++) <$> case relay of
+ Just r -> pure r
+ Nothing -> getSshTarget target hst
-- Install, or update the remote propellor.
- updateServer target spinmode hst
+ updateServer target relay hst
(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd])
(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd])
+ getprivdata
-- And now we can run it.
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
error "remote propellor failed"
where
- hn = case spinmode of
- RelaySpin h -> h
- _ -> target
+ hn = fromMaybe target relay
- relaying = spinmode == RelaySpin target
- viarelay = not relaying && case spinmode of
- RelaySpin _ -> True
- _ -> False
+ relaying = relay == Just target
+ viarelay = isJust relay && not relaying
probecmd = intercalate " ; "
[ "if [ ! -d " ++ localdir ++ "/.git ]"
@@ -101,6 +95,17 @@ spin spinmode target hst = do
cmd = if viarelay
then "--serialized " ++ shellEscape (show (Spin [target] (Just target)))
else "--continue " ++ shellEscape (show (SimpleRun target))
+
+ getprivdata = case mprivdata of
+ Nothing
+ | relaying -> do
+ let f = privDataRelay hn
+ d <- readFileStrictAnyEncoding f
+ nukeFile f
+ return (readPrivData d)
+ | otherwise ->
+ filterPrivData hst <$> decryptPrivData
+ Just pd -> pure pd
-- Check if the Host contains an IP address that matches one of the IPs
-- in the DNS for the HostName. If so, the HostName is used as-is,
@@ -180,22 +185,20 @@ update forhost = do
updateServer
:: HostName
- -> SpinMode
+ -> Maybe HostName
-> Host
-> CreateProcess
-> CreateProcess
+ -> IO PrivMap
-> IO ()
-updateServer target spinmode hst connect haveprecompiled =
+updateServer target relay hst connect haveprecompiled getprivdata =
withIOHandles createProcessSuccess connect go
where
- hn = case spinmode of
- RelaySpin h -> h
- _ -> target
- relaying = spinmode == RelaySpin target
+ hn = fromMaybe target relay
go (toh, fromh) = do
let loop = go (toh, fromh)
- let restart = updateServer hn spinmode hst connect haveprecompiled
+ let restart = updateServer hn relay hst connect haveprecompiled getprivdata
let done = return ()
v <- maybe Nothing readish <$> getMarked fromh statusMarker
case v of
@@ -214,36 +217,24 @@ updateServer target spinmode hst connect haveprecompiled =
hClose toh
hClose fromh
sendPrecompiled hn
- updateServer hn spinmode hst haveprecompiled (error "loop")
+ updateServer hn relay hst haveprecompiled (error "loop") getprivdata
(Just NeedGitPush) -> do
sendGitUpdate hn fromh toh
hClose fromh
hClose toh
done
Nothing -> done
- getprivdata
- | relaying = do
- let f = privDataRelay hn
- d <- readFileStrictAnyEncoding f
- nukeFile f
- return d
- | otherwise = case spinmode of
- -- When one host is controlling another,
- -- the controlling host's privdata includes the
- -- privdata of the controlled host.
- ControllingSpin -> show . filterPrivData hst . readPrivData
- <$> readFileStrictAnyEncoding privDataLocal
- _ -> show . filterPrivData hst <$> decryptPrivData
sendRepoUrl :: Handle -> IO ()
sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
-sendPrivData :: HostName -> Handle -> String -> IO ()
+sendPrivData :: HostName -> Handle -> PrivMap -> IO ()
sendPrivData hn toh privdata = void $ actionMessage msg $ do
- sendMarked toh privDataMarker privdata
+ sendMarked toh privDataMarker d
return True
where
- msg = "Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn
+ msg = "Sending privdata (" ++ show (length d) ++ " bytes) to " ++ hn
+ d = show privdata
sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
sendGitUpdate hn fromh toh =