diff options
| -rw-r--r-- | Assistant/XMPP/Git.hs | 38 |
1 files changed, 26 insertions, 12 deletions
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 37535d01c..f7ae64c8d 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -16,7 +16,7 @@ import Assistant.MakeRemote import Assistant.Sync import Annex.UUID import Config -import Git.Types +import Git import Git.Command import Locations.UserConfig import qualified Types.Remote as Remote @@ -25,6 +25,7 @@ import Network.Protocol.XMPP import qualified Data.Text as T import System.Posix.Env import System.Posix.Types +import System.Process (std_in, std_out, std_err) import Control.Concurrent import qualified Data.ByteString as B @@ -172,15 +173,28 @@ xmppReceivePack :: Assistant Bool xmppReceivePack = do feeder <- asIO1 toxmpp reader <- asIO1 fromxmpp - ok <- liftIO $ do - (Just inh, Just outh, _, pid) <- createProcess $ p - { std_in = CreatePipe - , std_out = CreatePipe - , std_err = Inherit - } - - liftIO $ mapM_ killThread [t1, t2] + controller <- asIO1 controlxmpp + repodir <- liftAnnex $ fromRepo repoPath + let p = (proc "git" ["receive-pack", repodir]) + { std_in = CreatePipe + , std_out = CreatePipe + , std_err = Inherit + } + liftIO $ do + (Just inh, Just outh, _, pid) <- createProcess p + feedertid <- forkIO $ feeder outh + void $ reader inh + code <- waitForProcess pid + void $ controller code + killThread feedertid + return $ code == ExitSuccess where - p = proc "git" params - toxmpp = - fromxmpp = + toxmpp outh = do + b <- liftIO $ B.hGetSome outh 1024 + if B.null b + then return () -- EOF + else do + error "TODO feed b to xmpp" + toxmpp outh + fromxmpp _inh = error "TODO feed xmpp to inh" + controlxmpp _code = error "TODO propigate exit code" |