From 745f42c1499749345c32736342959584587c9b57 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 20 Oct 2015 23:33:19 -0400 Subject: simplify privdata propigation to spin from controller --- src/Propellor/CmdLine.hs | 3 +- src/Propellor/Property/ControlHeir.hs | 19 +++++---- src/Propellor/Spin.hs | 77 ++++++++++++++++------------------- 3 files changed, 46 insertions(+), 53 deletions(-) (limited to 'src') 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 = -- cgit v1.2.3