summaryrefslogtreecommitdiff
path: root/src/Propellor/Server.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-22 12:57:07 -0400
committerJoey Hess2014-11-22 12:57:07 -0400
commitfd3335e40e3c938f1fbf53287e37aaf76b8c69df (patch)
tree8dfce3db28314e3316ff19089a0309b8268dd29e /src/Propellor/Server.hs
parent61945b4ff3af42369665a18817ed57ff92c898ca (diff)
--via implemented
Diffstat (limited to 'src/Propellor/Server.hs')
-rw-r--r--src/Propellor/Server.hs22
1 files changed, 15 insertions, 7 deletions
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index 19a2c901..e2d6552f 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -29,13 +29,16 @@ import Utility.SafeCommand
-- 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
-update :: IO ()
-update = do
+update :: Maybe HostName -> IO ()
+update forhost = do
whenM hasOrigin $
req NeedRepoUrl repoUrlMarker setRepoUrl
+
makePrivDataDir
+ createDirectoryIfMissing True (takeDirectory privfile)
req NeedPrivData privDataMarker $
- writeFileProtected privDataLocal
+ writeFileProtected privfile
+
whenM hasOrigin $
req NeedGitPush gitPushMarker $ \_ -> do
hin <- dup stdInput
@@ -52,12 +55,17 @@ update = do
, Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout
, Param "."
]
+
+ -- When --spin --relay is run, get a privdata file
+ -- to be relayed to the target host.
+ privfile = maybe privDataLocal privDataRelay forhost
-- The connect action should ssh to the remote host and run the provided
-- calback action.
-updateServer :: HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
-updateServer hn hst connect = connect go
+updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
+updateServer target relay hst connect = connect go
where
+ hn = fromMaybe target relay
go (toh, fromh) = do
let loop = go (toh, fromh)
v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
@@ -77,12 +85,12 @@ updateServer hn hst connect = connect go
hClose toh
hClose fromh
sendGitClone hn
- updateServer hn hst connect
+ updateServer hn relay hst connect
(Just NeedPrecompiled) -> do
hClose toh
hClose fromh
sendPrecompiled hn
- updateServer hn hst connect
+ updateServer hn relay hst connect
Nothing -> return ()
sendRepoUrl :: Handle -> IO ()