module Data.Git.Storage.PackIndex
( PackIndexHeader(..)
, PackIndex(..)
, packIndexOpen
, packIndexClose
, withPackIndex
, packIndexEnumerate
, packIndexHeaderGetNbWithPrefix
, packIndexGetReferenceLocation
, packIndexGetReferencesWithPrefix
, packIndexReadHeader
, packIndexRead
, packIndexGetHeader
) where
import Control.Applicative ((<$>))
import Control.Monad
import Filesystem
import Filesystem.Path
import Filesystem.Path.Rules
import Data.List
import Data.Bits
import Data.Word
import Data.String
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
import qualified Data.Attoparsec as A
import Data.Git.Internal
import Data.Git.Storage.FileReader
import Data.Git.Path
import Data.Git.Ref
import Prelude hiding (FilePath)
data PackIndexHeader = PackIndexHeader !Word32 !(Vector Word32)
deriving (Show,Eq)
data PackIndex = PackIndex
{ packIndexSha1s :: Vector Ref
, packIndexCRCs :: Vector Word32
, packIndexPackoffs :: Vector Word32
, packIndexPackChecksum :: Ref
, packIndexChecksum :: Ref
}
packIndexEnumerate repoPath = map onlyHash . filter isPackFile . map (encodeString posix . filename) <$> listDirectory (repoPath </> "objects" </> "pack")
where
isPackFile x = ".idx" `isSuffixOf` x && "pack-" `isPrefixOf` x
onlyHash = fromHexString . takebut 4 . drop 5
takebut n l = take (length l n) l
packIndexOpen :: FilePath -> Ref -> IO FileReader
packIndexOpen repoPath indexRef = openFile (indexPath repoPath indexRef) ReadMode >>= fileReaderNew False
packIndexClose :: FileReader -> IO ()
packIndexClose = fileReaderClose
withPackIndex repoPath indexRef = withFileReader (indexPath repoPath indexRef)
packIndexHeaderGetSize :: PackIndexHeader -> Word32
packIndexHeaderGetSize (PackIndexHeader _ indexes) = indexes ! 255
packIndexHeaderByteSize :: Int
packIndexHeaderByteSize = 2*4 + 256*4
packIndexHeaderGetNbWithPrefix :: PackIndexHeader -> Int -> Word32
packIndexHeaderGetNbWithPrefix (PackIndexHeader _ indexes) n
| n < 0 || n > 255 = 0
| n == 0 = indexes ! 0
| otherwise = (indexes ! n) (indexes ! (n1))
packIndexHeaderFoldRef :: PackIndexHeader -> FileReader -> Int -> (a -> Word32 -> Ref -> (a, Bool)) -> a -> IO a
packIndexHeaderFoldRef idxHdr@(PackIndexHeader _ indexes) fr refprefix f initAcc
| nb == 0 = return initAcc
| otherwise = do
let spos = (indexes ! refprefix) nb
fileReaderSeek fr (fromIntegral (sha1Offset + spos * 20))
loop nb initAcc
where
loop 0 acc = return acc
loop n acc = do
b <- fromBinary <$> fileReaderGetBS 20 fr
let (!nacc, terminate) = f acc (nbn) b
if terminate
then return nacc
else loop (n1) nacc
nb = packIndexHeaderGetNbWithPrefix idxHdr refprefix
(sha1Offset,_,_) = packIndexOffsets idxHdr
packIndexGetReferenceLocation :: PackIndexHeader -> FileReader -> Ref -> IO (Maybe Word64)
packIndexGetReferenceLocation idxHdr@(PackIndexHeader _ indexes) fr ref = do
mrpos <- packIndexHeaderFoldRef idxHdr fr refprefix f Nothing
case mrpos of
Nothing -> return Nothing
Just rpos -> do
let spos = (indexes ! refprefix) nb
fileReaderSeek fr (fromIntegral (packOffset + 4 * (spos+rpos)))
Just . fromIntegral . be32 <$> fileReaderGetBS 4 fr
where
f acc rpos rref = if ref == rref then (Just rpos,True) else (acc,False)
refprefix = refPrefix ref
nb = packIndexHeaderGetNbWithPrefix idxHdr refprefix
(_,_,packOffset) = packIndexOffsets idxHdr
packIndexGetReferencesWithPrefix :: PackIndexHeader -> FileReader -> String -> IO [Ref]
packIndexGetReferencesWithPrefix idxHdr fr prefix =
packIndexHeaderFoldRef idxHdr fr refprefix f []
where
f acc _ ref = case cmpPrefix prefix ref of
GT -> (acc ,False)
EQ -> (ref:acc,False)
LT -> (acc ,True)
refprefix = read ("0x" ++ take 2 prefix)
packIndexOffsets idx = (packIndexSha1sOffset, packIndexCRCsOffset, packIndexPackOffOffset)
where
packIndexPackOffOffset = packIndexCRCsOffset + crcsTableSz
packIndexCRCsOffset = packIndexSha1sOffset + sha1TableSz
packIndexSha1sOffset = fromIntegral packIndexHeaderByteSize
crcsTableSz = 4 * sz
sha1TableSz = 20 * sz
sz = packIndexHeaderGetSize idx
parsePackIndexHeader = do
magic <- be32 <$> A.take 4
when (magic /= 0xff744f63) $ error "wrong magic number for packIndex"
ver <- be32 <$> A.take 4
when (ver /= 2) $ error "unsupported packIndex version"
fanouts <- V.replicateM 256 (be32 <$> A.take 4)
return $ PackIndexHeader ver fanouts
packIndexReadHeader :: FileReader -> IO PackIndexHeader
packIndexReadHeader fr = fileReaderSeek fr 0 >> fileReaderParse fr parsePackIndexHeader
packIndexGetHeader :: FilePath -> Ref -> IO PackIndexHeader
packIndexGetHeader repoPath indexRef = withPackIndex repoPath indexRef $ packIndexReadHeader
packIndexRead repoPath indexRef = do
withPackIndex repoPath indexRef $ \fr -> do
idx <- fileReaderParse fr parsePackIndexHeader
liftM2 (,) (return idx) (fileReaderParse fr (parsePackIndex $ packIndexHeaderGetSize idx))
where parsePackIndex sz = do
sha1s <- V.replicateM (fromIntegral sz) (fromBinary <$> A.take 20)
crcs <- V.replicateM (fromIntegral sz) (be32 <$> A.take 4)
packoffs <- V.replicateM (fromIntegral sz) (be32 <$> A.take 4)
let nbLarge = length $ filter (== True) $ map (\packoff -> packoff `testBit` 31) $ V.toList packoffs
largeoffs <- replicateM nbLarge (A.take 4)
packfileChecksum <- fromBinary <$> A.take 20
idxfileChecksum <- fromBinary <$> A.take 20
return (sha1s, crcs, packoffs, largeoffs, packfileChecksum, idxfileChecksum)