diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-18 15:30:26 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-18 18:00:24 -0400 |
commit | d1da9cf221aeea5c7ac8a313a18b559791a04f12 (patch) | |
tree | fe8d7e42efb89441d14ab8d5d71bb8f0f007330b /Remote/Git.hs | |
parent | fc5652c811a9a644bb8964b3b8c13df24f2ec7c7 (diff) |
switch from System.Cmd.Utils to System.Process
Test suite now passes with -threaded!
I traced back all the hangs with -threaded to System.Cmd.Utils. It seems
it's just crappy/unsafe/outdated, and should not be used. System.Process
seems to be the cool new thing, so converted all the code to use it
instead.
In the process, --debug stopped printing commands it runs. I may try to
bring that back later.
Note that even SafeSystem was switched to use System.Process. Since that
was a modified version of code from System.Cmd.Utils, it needed to be
converted too. I also got rid of nearly all calls to forkProcess,
and all calls to executeFile, which I'm also doubtful about working
well with -threaded.
Diffstat (limited to 'Remote/Git.hs')
-rw-r--r-- | Remote/Git.hs | 14 |
1 files changed, 9 insertions, 5 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index d80f580fc..a9a6d6004 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -9,6 +9,7 @@ module Remote.Git (remote, repoAvail) where import qualified Data.Map as M import Control.Exception.Extensible +import System.Process import Common.Annex import Utility.CopyFile @@ -126,17 +127,20 @@ tryGitConfigRead r safely a = either (const $ return r) return =<< liftIO (try a :: IO (Either SomeException Git.Repo)) - pipedconfig cmd params = safely $ - pOpen ReadFromPipe cmd (toCommand params) $ - Git.Config.hRead r + pipedconfig cmd params = safely $ do + (_, Just h, _, pid) <- + createProcess (proc cmd $ toCommand params) + { std_out = CreatePipe } + r' <- Git.Config.hRead r h + forceSuccessProcess pid cmd $ toCommand params + return r' geturlconfig headers = do s <- Url.get (Git.repoLocation r ++ "/config") headers withTempFile "git-annex.tmp" $ \tmpfile h -> do hPutStr h s hClose h - pOpen ReadFromPipe "git" ["config", "--null", "--list", "--file", tmpfile] $ - Git.Config.hRead r + pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile] store = observe $ \r' -> do g <- gitRepo |