From efa32839757e7fab14b94a1032741677b076d67e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:05:25 -0400 Subject: [PATCH] reformat --- src/Propellor/CmdLine.hs | 87 ++++++++++++++++++++-------------------- 1 file changed, 44 insertions(+), 43 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 0d7fdd4..707c595 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -197,54 +197,55 @@ spin hn hst = do void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] void $ boolSystem "git" [Param "push"] cacheparams <- toCommand <$> sshCachingParams hn - go cacheparams =<< hostprivdata + comm cacheparams =<< hostprivdata unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $ error $ "remote propellor failed (running: " ++ runcmd ++")" where hostprivdata = show . filterPrivData hst <$> decryptPrivData - go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do - let loop = do - status <- getMarked fromh statusMarker - case readish =<< status of - Just NeedRepoUrl -> do - sendMarked toh repoUrlMarker - =<< (fromMaybe "" <$> getRepoUrl) - loop - Just NeedPrivData -> do - sendprivdata toh privdata - loop - Just NeedGitPush -> void $ actionMessage "Git update" $ do - sendMarked toh gitPushMarker "" - let p = (proc "git" ["upload-pack", "."]) - { std_in = UseHandle fromh - , std_out = UseHandle toh - } - (Nothing, Nothing, Nothing, h) <- createProcess p - r <- waitForProcess h - -- no more protocol possible after - -- git push - hClose fromh - hClose toh - return (r == ExitSuccess) - Just NeedGitClone -> do - hClose toh - hClose fromh - sendGitClone hn - go cacheparams privdata - -- Ready is only sent by old versions of - -- propellor. They expect to get privdata, - -- and then no more protocol communication. - Just Ready -> do - sendprivdata toh privdata - hClose toh - - -- Display remaining output. - void $ tryIO $ forever $ - showremote =<< hGetLine fromh - hClose fromh - Nothing -> return () - loop + comm cacheparams privdata = + withBothHandles createProcessSuccess + (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) + (comm' cacheparams privdata) + comm' cacheparams privdata (toh, fromh) = loop + where + loop = dispatch =<< (maybe Nothing readish <$> getMarked fromh statusMarker) + dispatch (Just NeedRepoUrl) = do + sendMarked toh repoUrlMarker + =<< (fromMaybe "" <$> getRepoUrl) + loop + dispatch (Just NeedPrivData) = do + sendprivdata toh privdata + loop + dispatch (Just NeedGitPush) = do + void $ actionMessage ("Sending git update to " ++ hn) $ do + sendMarked toh gitPushMarker "" + let p = (proc "git" ["upload-pack", "."]) + { std_in = UseHandle fromh + , std_out = UseHandle toh + } + (Nothing, Nothing, Nothing, h) <- createProcess p + r <- waitForProcess h + -- no more protocol possible after git push + hClose fromh + hClose toh + return (r == ExitSuccess) + dispatch (Just NeedGitClone) = do + hClose toh + hClose fromh + sendGitClone hn + comm cacheparams privdata + -- Ready is only sent by old versions of + -- propellor. They expect to get privdata, + -- and then no more protocol communication. + dispatch (Just Ready) = do + sendprivdata toh privdata + hClose toh + -- Display remaining output. + void $ tryIO $ forever $ + showremote =<< hGetLine fromh + hClose fromh + dispatch Nothing = return () user = "root@"++hn