module Data.Git.Storage.Pack
( PackedObjectInfo(..)
, PackedObjectRaw
, packEnumerate
, packOpen
, packClose
, packReadHeader
, packReadMapAtOffset
, packReadAtOffset
, packReadRawAtOffset
, packEnumerateObjects
, packedObjectToObject
, packObjectFromRaw
) where
import Control.Applicative ((<$>))
import Control.Arrow (second)
import Control.Monad
import Filesystem.Path.Rules
import Filesystem.Path
import Filesystem
import Data.Bits
import Data.List
import qualified Data.ByteString.Lazy as L
import Data.Attoparsec (anyWord8)
import qualified Data.Attoparsec as A
import qualified Data.Attoparsec.Lazy as AL
import Data.Git.Internal
import Data.Git.Path
import Data.Git.Storage.Object
import Data.Git.Delta
import Data.Git.Ref
import Data.Git.Types
import Data.Git.Storage.FileReader
import Data.Word
import Prelude hiding (FilePath)
type PackedObjectRaw = (PackedObjectInfo, L.ByteString)
data PackedObjectInfo = PackedObjectInfo
{ poiType :: ObjectType
, poiOffset :: Word64
, poiSize :: Word64
, poiActualSize :: Word64
, poiExtra :: Maybe ObjectPtr
} deriving (Show,Eq)
packEnumerate repoPath = map onlyHash . filter isPackFile . map (encodeString posix . filename) <$> listDirectory (repoPath </> "objects" </> "pack")
where
isPackFile x = ".pack" `isSuffixOf` x
onlyHash = fromHexString . takebut 5 . drop 5
takebut n l = take (length l n) l
packOpen :: FilePath -> Ref -> IO FileReader
packOpen repoPath packRef = openFile (packPath repoPath packRef) ReadMode >>= fileReaderNew False
packClose :: FileReader -> IO ()
packClose = fileReaderClose
packReadHeader repoPath packRef =
withFileReader (packPath repoPath packRef) $ \filereader ->
fileReaderParse filereader parseHeader
where parseHeader = do
packMagic <- be32 <$> A.take 4
when (packMagic /= 0x5041434b) $ error "not a git packfile"
ver <- be32 <$> A.take 4
when (ver /= 2) $ error ("pack file version not supported: " ++ show ver)
be32 <$> A.take 4
packReadMapAtOffset fr offset mapData = fileReaderSeek fr offset >> getNextObject fr mapData
packReadAtOffset :: FileReader -> Word64 -> IO (Maybe Object)
packReadAtOffset fr offset = packReadMapAtOffset fr offset id
packReadRawAtOffset :: FileReader -> Word64 -> IO (PackedObjectRaw)
packReadRawAtOffset fr offset = fileReaderSeek fr offset >> getNextObjectRaw fr
packEnumerateObjects repoPath packRef entries f =
withFileReader (packPath repoPath packRef) $ \filebuffer -> do
fileReaderSeek filebuffer 12
parseNext filebuffer entries
where
parseNext :: FileReader -> Int -> IO ()
parseNext _ 0 = return ()
parseNext fr ents = getNextObjectRaw fr >>= f >> parseNext fr (ents1)
getNextObject :: FileReader -> (L.ByteString -> L.ByteString) -> IO (Maybe Object)
getNextObject fr mapData =
packedObjectToObject . second mapData <$> getNextObjectRaw fr
packedObjectToObject (PackedObjectInfo { poiType = ty, poiExtra = extra }, objData) =
packObjectFromRaw (ty, extra, objData)
packObjectFromRaw (TypeCommit, Nothing, objData) = AL.maybeResult $ AL.parse objectParseCommit objData
packObjectFromRaw (TypeTree, Nothing, objData) = AL.maybeResult $ AL.parse objectParseTree objData
packObjectFromRaw (TypeBlob, Nothing, objData) = AL.maybeResult $ AL.parse objectParseBlob objData
packObjectFromRaw (TypeTag, Nothing, objData) = AL.maybeResult $ AL.parse objectParseTag objData
packObjectFromRaw (TypeDeltaOff, Just (PtrOfs o), objData) = toObject . DeltaOfs o <$> deltaRead objData
packObjectFromRaw (TypeDeltaRef, Just (PtrRef r), objData) = toObject . DeltaRef r <$> deltaRead objData
packObjectFromRaw _ = error "can't happen unless someone change getNextObjectRaw"
getNextObjectRaw :: FileReader -> IO PackedObjectRaw
getNextObjectRaw fr = do
sobj <- fileReaderGetPos fr
(ty, size) <- fileReaderParse fr parseObjectHeader
extra <- case ty of
TypeDeltaRef -> Just . PtrRef . fromBinary <$> fileReaderGetBS 20 fr
TypeDeltaOff -> Just . PtrOfs . deltaOffFromList <$> fileReaderGetVLF fr
_ -> return Nothing
objData <- fileReaderInflateToSize fr size
eobj <- fileReaderGetPos fr
return (PackedObjectInfo ty sobj (eobj sobj) size extra, objData)
where
parseObjectHeader = do
(m, ty, sz) <- splitFirst <$> anyWord8
size <- if m then (sz +) <$> getNextSize 4 else return sz
return (ty, size)
where
getNextSize n = do
(c, sz) <- splitOther n <$> anyWord8
if c then (sz +) <$> getNextSize (n+7) else return sz
splitFirst :: Word8 -> (Bool, ObjectType, Word64)
splitFirst w = (w `testBit` 7, toEnum $ fromIntegral ((w `shiftR` 4) .&. 0x7), fromIntegral (w .&. 0xf))
splitOther n w = (w `testBit` 7, fromIntegral (w .&. 0x7f) `shiftL` n)
deltaOffFromList (x:xs) = foldl' acc (fromIntegral (x `clearBit` 7)) xs
where acc a w = ((a+1) `shiftL` 7) + fromIntegral (w `clearBit` 7)
deltaOffFromList [] = error "cannot happen"