summaryrefslogtreecommitdiff
path: root/src/Propellor/CmdLine.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-18 20:19:50 -0400
committerJoey Hess2014-11-18 20:19:50 -0400
commitbe1287d5f957528f71b7798d57bfedb7f30c5ced (patch)
tree6cacc2069b11c055fc509af8f7ee9b7068b55564 /src/Propellor/CmdLine.hs
parentd4a4f0193e30aee1ed37ceab7a85760510ac0d1f (diff)
refactor
Diffstat (limited to 'src/Propellor/CmdLine.hs')
-rw-r--r--src/Propellor/CmdLine.hs48
1 files changed, 24 insertions, 24 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 91bf2b6f..3cb6715e 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -208,6 +208,30 @@ spin hn hst = do
runcmd = mkcmd
[ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show (SimpleRun hn)) ]
+-- Update the privdata, repo url, and git repo over the ssh
+-- connection from the client that ran propellor --spin.
+update :: IO ()
+update = do
+ req NeedRepoUrl repoUrlMarker setRepoUrl
+ makePrivDataDir
+ req NeedPrivData privDataMarker $
+ writeFileProtected privDataLocal
+ req NeedGitPush gitPushMarker $ \_ -> do
+ hin <- dup stdInput
+ hout <- dup stdOutput
+ hClose stdin
+ hClose stdout
+ unlessM (boolSystem "git" (pullparams hin hout)) $
+ errorMessage "git pull from client failed"
+ where
+ pullparams hin hout =
+ [ Param "pull"
+ , Param "--progress"
+ , Param "--upload-pack"
+ , Param $ "./propellor --continue " ++ show (GitPush hin hout)
+ , Param "."
+ ]
+
comm :: HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
comm hn hst connect = connect go
where
@@ -275,30 +299,6 @@ sendGitClone hn = void $ actionMessage ("Cloning git repository to " ++ hn) $ do
, "rm -f " ++ remotebundle
]
--- Update the privdata, repo url, and git repo over the ssh
--- connection from the client that ran propellor --spin.
-update :: IO ()
-update = do
- req NeedRepoUrl repoUrlMarker setRepoUrl
- makePrivDataDir
- req NeedPrivData privDataMarker $
- writeFileProtected privDataLocal
- req NeedGitPush gitPushMarker $ \_ -> do
- hin <- dup stdInput
- hout <- dup stdOutput
- hClose stdin
- hClose stdout
- unlessM (boolSystem "git" (pullparams hin hout)) $
- errorMessage "git pull from client failed"
- where
- pullparams hin hout =
- [ Param "pull"
- , Param "--progress"
- , Param "--upload-pack"
- , Param $ "./propellor --continue " ++ show (GitPush hin hout)
- , Param "."
- ]
-
-- Shim for git push over the propellor ssh channel.
-- Reads from stdin and sends it to hout;
-- reads from hin and sends it to stdout.