cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

display improvements

This commit is contained in:
Joey Hess 2014-11-18 18:13:42 -04:00
parent 01bcf447e3
commit 18903ad30c
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Propellor/CmdLine.hs
View File

@ -100,7 +100,9 @@ defaultMain hostlist = do
( onlyProcess $ withhost hn mainProperties ( onlyProcess $ withhost hn mainProperties
, go True (Spin hn) , go True (Spin hn)
) )
go False (Boot _) = onlyProcess boot go False (Boot _) = do
forceConsole
onlyProcess boot
withhost :: HostName -> (Host -> IO ()) -> IO () withhost :: HostName -> (Host -> IO ()) -> IO ()
withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn) withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
@ -196,18 +198,18 @@ getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref
-- updated, it's run. -- updated, it's run.
spin :: HostName -> Host -> IO () spin :: HostName -> Host -> IO ()
spin hn hst = do spin hn hst = do
void $ actionMessage "git commit (signed)" $ void $ actionMessage "Git commit (signed)" $
gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
-- Push to central origin repo first, if possible. -- Push to central origin repo first, if possible.
-- The remote propellor will pull from there, which avoids -- The remote propellor will pull from there, which avoids
-- us needing to send stuff directly to the remote host. -- us needing to send stuff directly to the remote host.
whenM hasOrigin $ whenM hasOrigin $
void $ actionMessage "pushing to central git repository" $ void $ actionMessage "Push to central git repository" $
boolSystem "git" [Param "push"] boolSystem "git" [Param "push"]
cacheparams <- toCommand <$> sshCachingParams hn cacheparams <- toCommand <$> sshCachingParams hn
comm cacheparams =<< hostprivdata comm cacheparams =<< hostprivdata
unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $ unlessM (boolSystem "ssh" (map Param (cacheparams ++ [user, runcmd]))) $
error $ "remote propellor failed (running: " ++ runcmd ++")" error $ "remote propellor failed (running: " ++ runcmd ++")"
where where
hostprivdata = show . filterPrivData hst <$> decryptPrivData hostprivdata = show . filterPrivData hst <$> decryptPrivData

3
src/Propellor/Protocol.hs
View File

@ -49,7 +49,8 @@ getMarked h marker = go =<< catchMaybeIO (hGetLine h)
go Nothing = return Nothing go Nothing = return Nothing
go (Just l) = case fromMarked marker l of go (Just l) = case fromMarked marker l of
Nothing -> do Nothing -> do
hPutStrLn stderr l unless (null l) $
hPutStrLn stderr l
getMarked h marker getMarked h marker
Just v -> return (Just v) Just v -> return (Just v)