fork a process to feed git hash-object

This is another workaround for bug #624389. I hope it will fix
http://git-annex.branchable.com/bugs/problem_with_upgrade_v2_-__62___v3/
This commit is contained in:
Joey Hess 2011-07-05 13:26:59 -04:00
parent bddbb66ea4
commit 44e973dd09

View file

@ -27,6 +27,8 @@ import Data.Maybe
import Data.List
import System.IO
import System.IO.Binary
import System.Posix.Process
import System.Exit
import qualified Data.ByteString.Char8 as B
import Types.BranchState
@ -329,12 +331,19 @@ stageJournalFiles = do
let paths = map (dir </>) fs
-- inject all the journal files directly into git
-- in one quick command
(h, s) <- Git.pipeWriteRead g [Param "hash-object",
Param "-w", Param "--stdin-paths"] $ unlines paths
(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $
Git.gitCommandLine g [Param "hash-object", Param "-w", Param "--stdin-paths"]
_ <- forkProcess $ do
hPutStr toh $ unlines paths
hClose toh
exitSuccess
hClose toh
s <- hGetContents fromh
-- update the index, also in just one command
Git.UnionMerge.update_index g $
index_lines (lines s) $ map fileJournal fs
forceSuccess h
hClose fromh
forceSuccess pid
mapM_ removeFile paths
index_lines shas fs = map genline $ zip shas fs
genline (sha, file) = Git.UnionMerge.update_index_line sha file