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:
parent
e1c18ddec4
commit
899ecbfba1
1 changed files with 34 additions and 24 deletions
56
Branch.hs
56
Branch.hs
|
@ -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]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue