fix memory leak when staging the journal
The list of files had to be retained until the end so it could be deleted. Also, a list of update-index lines was generated and only then fed into it. Now everything streams in constant space.
This commit is contained in:
parent
cdd6cdbb67
commit
7ebd98d8d8
4 changed files with 52 additions and 42 deletions
|
@ -1,6 +1,6 @@
|
|||
{- git hash-object interface
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -11,23 +11,32 @@ import Common
|
|||
import Git
|
||||
import Git.Command
|
||||
|
||||
{- Injects a set of files into git, returning the shas of the objects
|
||||
- and an IO action to call once the the shas have been used. -}
|
||||
hashFiles :: [FilePath] -> Repo -> IO ([Sha], IO ())
|
||||
hashFiles paths repo = do
|
||||
(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object repo
|
||||
type HashObjectHandle = (PipeHandle, Handle, Handle)
|
||||
|
||||
{- Starts git hash-object and returns a handle. -}
|
||||
hashObjectStart :: Repo -> IO HashObjectHandle
|
||||
hashObjectStart repo = do
|
||||
r@(_, _, toh) <- hPipeBoth "git" $
|
||||
toCommand $ gitCommandLine params repo
|
||||
fileEncoding toh
|
||||
_ <- forkProcess (feeder toh)
|
||||
hClose toh
|
||||
shas <- map Ref . lines <$> hGetContents fromh
|
||||
return (shas, ender fromh pid)
|
||||
return r
|
||||
where
|
||||
git_hash_object = gitCommandLine
|
||||
[Param "hash-object", Param "-w", Param "--stdin-paths"]
|
||||
feeder toh = do
|
||||
hPutStr toh $ unlines paths
|
||||
hClose toh
|
||||
exitSuccess
|
||||
ender fromh pid = do
|
||||
hClose fromh
|
||||
forceSuccess pid
|
||||
params =
|
||||
[ Param "hash-object"
|
||||
, Param "-w"
|
||||
, Param "--stdin-paths"
|
||||
]
|
||||
|
||||
{- Stops git hash-object. -}
|
||||
hashObjectStop :: HashObjectHandle -> IO ()
|
||||
hashObjectStop (pid, from, to) = do
|
||||
hClose to
|
||||
hClose from
|
||||
forceSuccess pid
|
||||
|
||||
{- Injects a file into git, returning the shas of the objects. -}
|
||||
hashFile :: HashObjectHandle -> FilePath -> IO Sha
|
||||
hashFile (_, from, to) file = do
|
||||
hPutStrLn to file
|
||||
hFlush to
|
||||
Ref <$> hGetLine from
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue