From 4e5048727e7316d4101be19d4f1e42d72d008adb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 20 Oct 2015 14:45:11 -0400 Subject: privdata propigation for Spin.controller Controlling host inherits the privdata for the host it spins, and sends it along to that host. --- src/Propellor/CmdLine.hs | 5 +-- src/Propellor/PrivData.hs | 6 +++- src/Propellor/Property/Spin.hs | 22 ++++++++---- src/Propellor/Spin.hs | 76 ++++++++++++++++++++++++++---------------- 4 files changed, 71 insertions(+), 38 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index e0830693..a0be167e 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -117,9 +117,10 @@ defaultMain hostlist = do go _ Merge = mergeSpin go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline - go False (Spin hs r) = do + go False (Spin hs mrelay) = do commitSpin - forM_ hs $ \hn -> withhost hn $ spin hn r + forM_ hs $ \hn -> withhost hn $ + spin (maybe RegularSpin RelaySpin 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/PrivData.hs b/src/Propellor/PrivData.hs index fd790878..070070f0 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -16,6 +16,7 @@ module Propellor.PrivData ( listPrivDataFields, makePrivDataDir, decryptPrivData, + readPrivData, PrivMap, PrivInfo, forceHostContext, @@ -248,7 +249,10 @@ modifyPrivData' f = do return r decryptPrivData :: IO PrivMap -decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile +decryptPrivData = readPrivData <$> gpgDecrypt privDataFile + +readPrivData :: String -> PrivMap +readPrivData = fromMaybe M.empty . readish makePrivDataDir :: IO () makePrivDataDir = createDirectoryIfMissing False privDataDir diff --git a/src/Propellor/Property/Spin.hs b/src/Propellor/Property/Spin.hs index 5f857ef4..d719f86d 100644 --- a/src/Propellor/Property/Spin.hs +++ b/src/Propellor/Property/Spin.hs @@ -8,7 +8,8 @@ module Propellor.Property.Spin ( ) where import Propellor.Base -import Propellor.Spin (spin) +import Propellor.Spin (spin, SpinMode(..)) +import Propellor.PrivData import Propellor.Types.Info import qualified Propellor.Property.Ssh as Ssh @@ -19,7 +20,7 @@ class Spinnable t where toSpin :: t -> Property HasInfo instance Spinnable Host where - toSpin h = infoProperty desc go (mkControllingInfo h) [] + toSpin h = infoProperty desc go (mkControllingInfo h <> privinfo) [] `requires` Ssh.knownHost [h] (hostName h) (User "root") where desc = cdesc (hostName h) @@ -33,11 +34,18 @@ instance Spinnable Host where , hostName h ] else do - liftIO $ spin (hostName h) Nothing h - -- Don't know if the spin made a change to the - -- remote host or not, but in any case, the + 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. + privinfo = addInfo mempty $ + forceHostContext (hostName h) $ + getInfo (hostInfo h) -- | Each Host in the list is spinned in turn. Does not stop on spin -- failure; does propagate overall success/failure. @@ -55,7 +63,7 @@ instance Spinnable [Host] where -- The controller needs to be able to ssh to the hosts it controls, -- and run propellor, as root. The controller is automatically configured -- with `Propellor.Property.Ssh.knownHost` to know the host keys of the --- hosts that it will ssh to. It's up to you to use `controllerKey` +-- hosts that it will ssh to. It's up to you to use `controllerKeys` -- and `controlledBy` to set up the ssh keys that will let the controller -- log into the hosts it controls. -- @@ -101,6 +109,8 @@ instance Spinnable [Host] where -- -- Chains of controllers are supported; host A can control host B which -- controls host C. Loops of controllers are automatically prevented. +-- +-- Note that a controller can see all PrivInfo of the hosts it controls. controllerFor :: Spinnable h => h -> Property HasInfo controllerFor h = toSpin h `requires` Ssh.installed diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index ecefbf6e..587a7f76 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -1,5 +1,6 @@ module Propellor.Spin ( commitSpin, + SpinMode(..), spin, update, gitPushHelper, @@ -40,20 +41,26 @@ commitSpin = do void $ actionMessage "Push to central git repository" $ boolSystem "git" [Param "push"] -spin :: HostName -> Maybe HostName -> Host -> IO () -spin target relay hst = do +data SpinMode + = RegularSpin + | RelaySpin HostName + | ControllingSpin + deriving (Eq) + +spin :: SpinMode -> HostName -> Host -> IO () +spin spinmode target hst = do cacheparams <- if viarelay then pure ["-A"] else toCommand <$> sshCachingParams hn when viarelay $ void $ boolSystem "ssh-add" [] - sshtarget <- ("root@" ++) <$> case relay of - Just r -> pure r - Nothing -> getSshTarget target hst + sshtarget <- ("root@" ++) <$> case spinmode of + RelaySpin r -> pure r + _ -> getSshTarget target hst -- Install, or update the remote propellor. - updateServer target relay hst + updateServer target spinmode hst (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd]) (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd]) @@ -61,10 +68,14 @@ spin target relay hst = do unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $ error "remote propellor failed" where - hn = fromMaybe target relay + hn = case spinmode of + RelaySpin h -> h + _ -> target - relaying = relay == Just target - viarelay = isJust relay && not relaying + relaying = spinmode == RelaySpin target + viarelay = not relaying && case spinmode of + RelaySpin _ -> True + _ -> False probecmd = intercalate " ; " [ "if [ ! -d " ++ localdir ++ "/.git ]" @@ -169,20 +180,22 @@ update forhost = do updateServer :: HostName - -> Maybe HostName + -> SpinMode -> Host -> CreateProcess -> CreateProcess -> IO () -updateServer target relay hst connect haveprecompiled = +updateServer target spinmode hst connect haveprecompiled = withIOHandles createProcessSuccess connect go where - hn = fromMaybe target relay - relaying = relay == Just target + hn = case spinmode of + RelaySpin h -> h + _ -> target + relaying = spinmode == RelaySpin target go (toh, fromh) = do let loop = go (toh, fromh) - let restart = updateServer hn relay hst connect haveprecompiled + let restart = updateServer hn spinmode hst connect haveprecompiled let done = return () v <- maybe Nothing readish <$> getMarked fromh statusMarker case v of @@ -190,7 +203,7 @@ updateServer target relay hst connect haveprecompiled = sendRepoUrl toh loop (Just NeedPrivData) -> do - sendPrivData hn hst toh relaying + sendPrivData hn toh =<< getprivdata loop (Just NeedGitClone) -> do hClose toh @@ -201,31 +214,36 @@ updateServer target relay hst connect haveprecompiled = hClose toh hClose fromh sendPrecompiled hn - updateServer hn relay hst haveprecompiled (error "loop") + updateServer hn spinmode hst haveprecompiled (error "loop") (Just NeedGitPush) -> do sendGitUpdate hn fromh toh hClose fromh hClose toh done Nothing -> done - -sendRepoUrl :: Handle -> IO () -sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl) - -sendPrivData :: HostName -> Host -> Handle -> Bool -> IO () -sendPrivData hn hst toh relaying = do - privdata <- getdata - void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do - sendMarked toh privDataMarker privdata - return True - where - getdata + getprivdata | relaying = do let f = privDataRelay hn d <- readFileStrictAnyEncoding f nukeFile f return d - | otherwise = show . filterPrivData hst <$> decryptPrivData + | 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 hn toh privdata = void $ actionMessage msg $ do + sendMarked toh privDataMarker privdata + return True + where + msg = "Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn sendGitUpdate :: HostName -> Handle -> Handle -> IO () sendGitUpdate hn fromh toh = -- cgit v1.2.3