propellor spin

This commit is contained in:
Joey Hess 2014-11-22 15:48:17 -04:00
parent 435ba8ca41
commit 395f311e1e
Failed to extract signature
2 changed files with 20 additions and 17 deletions

View File

@ -196,10 +196,10 @@ spin target relay hst = do
, "fi"
]
runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show cmd) ]
cmd = if isNothing relay
then "--continue " ++ shellEscape (show (SimpleRun target))
else "--spin " ++ shellEscape target
then SimpleRun target
else Spin target relay
runparams = catMaybes
[ if isJust relay then Just "-A" else Nothing
, Just "-t"

View File

@ -66,51 +66,54 @@ updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO (
updateServer target relay hst connect = connect go
where
hn = fromMaybe target relay
relaying = relay == Just target
go (toh, fromh) = do
let loop = go (toh, fromh)
let restart = updateServer hn relay hst connect
let done = return ()
v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
case v of
(Just NeedRepoUrl) -> do
sendRepoUrl toh
loop
(Just NeedPrivData) -> do
sendPrivData hn hst toh relay
sendPrivData hn hst toh relaying
loop
(Just NeedGitPush) -> do
sendGitUpdate hn fromh toh
-- no more protocol possible after git push
hClose fromh
hClose toh
(Just NeedGitClone) -> do
hClose toh
hClose fromh
sendGitClone hn
updateServer hn relay hst connect
restart
(Just NeedPrecompiled) -> do
hClose toh
hClose fromh
sendPrecompiled hn
updateServer hn relay hst connect
Nothing -> return ()
restart
(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 -> Maybe HostName -> IO ()
sendPrivData hn hst toh target = do
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
| isNothing target =
show . filterPrivData hst <$> decryptPrivData
| otherwise = do
| relaying = do
let f = privDataRelay hn
d <- readFileStrictAnyEncoding f
nukeFile f
return d
| otherwise = show . filterPrivData hst <$> decryptPrivData
sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
sendGitUpdate hn fromh toh =