summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-20 14:45:11 -0400
committerJoey Hess2015-10-20 15:28:52 -0400
commit4e5048727e7316d4101be19d4f1e42d72d008adb (patch)
tree85b3282bf12d68e3af8e847cef535008bc575a05
parent4c0b1f6e643882f43ac936b6bfdee78593ebc1d5 (diff)
privdata propigation for Spin.controller
Controlling host inherits the privdata for the host it spins, and sends it along to that host.
-rw-r--r--config-joey.hs1
-rw-r--r--src/Propellor/CmdLine.hs5
-rw-r--r--src/Propellor/PrivData.hs6
-rw-r--r--src/Propellor/Property/Spin.hs22
-rw-r--r--src/Propellor/Spin.hs76
5 files changed, 72 insertions, 38 deletions
diff --git a/config-joey.hs b/config-joey.hs
index e973d35e..d6dce396 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -75,6 +75,7 @@ testvm = host "testvm.kitenet.net"
darkstar :: Host
darkstar = host "darkstar.kitenet.net"
& ipv6 "2001:4830:1600:187::2"
+ & Spin.controllerFor clam
& Aiccu.hasConfig "T18376" "JHZ2-SIXXS"
& Apt.buildDep ["git-annex"] `period` Daily
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 =