improve git cat-file code

Now it reads the size specified, rather than using the sentinal hack to
determine EOF.

It still depends on error messages to handle files that are not present.
This commit is contained in:
Joey Hess 2011-06-29 22:19:40 -04:00
parent e1c18ddec4
commit 899ecbfba1

View file

@ -17,7 +17,7 @@ module Branch (
name name
) where ) where
import Control.Monad (unless, liftM) import Control.Monad (when, unless, liftM)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import System.FilePath import System.FilePath
import System.Directory import System.Directory
@ -26,6 +26,9 @@ import System.Cmd.Utils
import Data.Maybe import Data.Maybe
import Data.List import Data.List
import System.IO import System.IO
import System.IO.Unsafe
import Foreign
import Data.Char
import Types.BranchState import Types.BranchState
import qualified GitRepo as Git import qualified GitRepo as Git
@ -239,32 +242,39 @@ catFile file = do
g <- Annex.gitRepo g <- Annex.gitRepo
let cmd = Git.gitCommandLine g let cmd = Git.gitCommandLine g
[Param "cat-file", Param "--batch"] [Param "cat-file", Param "--batch"]
let gitcmd = join " " $ "git" : toCommand cmd let gitcmd = join " " ("git" : toCommand cmd)
(_, from, to) <- liftIO $ hPipeBoth "sh" (_, from, to) <- liftIO $ hPipeBoth "sh"
-- want stderr on stdin for sentinal, and -- want stderr on stdin to handle error messages
-- to ignore other error messages ["-c", "LANG=C exec " ++ gitcmd ++ " 2>&1"]
["-c", gitcmd ++ " 2>&1"]
setState state { catFileHandles = Just (from, to) } setState state { catFileHandles = Just (from, to) }
ask (from, to) ask (from, to)
ask (from, to) = do ask (from, to) = liftIO $ do
_ <- liftIO $ do let want = fullname ++ ":" ++ file
hPutStr to $ hPutStrLn to want
fullname ++ ":" ++ file ++ "\n" ++
sentinal ++ "\n"
hFlush to hFlush to
return . unlines =<< readContent from [] header <- hGetLine from
readContent from ls = do if header == want ++ " missing"
l <- liftIO $ hGetLine from then return ""
if l == sentinal_line else do
-- first line is blob info, let [_sha, _type, size] = words header
-- or maybe an error message let bytes = read size
then return $ drop 1 $ reverse ls fp <- mallocForeignPtrBytes (fromIntegral bytes)
else readContent from (l:ls) len <- withForeignPtr fp $ \buf -> hGetBuf from buf (fromIntegral bytes)
-- To find the end of a catted file, ask for a sentinal when (len /= bytes) $
-- value that is always missing, and look for the error error "short read from git cat-file"
-- message. Utterly nasty, probably will break one day. content <- lazySlurp fp 0 len
sentinal = ":" c <- hGetChar from
sentinal_line = sentinal ++ " missing" when (c /= '\n') $
error "missing newline from git cat-file"
return content
lazySlurp :: ForeignPtr Word8 -> Int -> Int -> IO String
lazySlurp fp ix len
| ix == len = return []
| otherwise = do
c <- withForeignPtr fp $ \p -> peekElemOff p ix
cs <- unsafeInterleaveIO (lazySlurp fp (ix+1) len)
return $ chr (fromIntegral c) : cs
{- Lists all files on the branch. There may be duplicates in the list. -} {- Lists all files on the branch. There may be duplicates in the list. -}
files :: Annex [FilePath] files :: Annex [FilePath]