{-# LANGUAGE CPP, BangPatterns, PatternGuards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
module Codec.Archive.Tar.Index.Internal (
TarIndex(..),
lookup,
TarIndexEntry(..),
toList,
PathComponentId(..),
TarEntryOffset,
hReadEntry,
hReadEntryHeader,
build,
IndexBuilder,
empty,
addNextEntry,
skipNextEntry,
finalise,
unfinalise,
serialise,
deserialise,
hReadEntryHeaderOrEof,
hSeekEntryOffset,
hSeekEntryContentOffset,
hSeekEndEntryOffset,
nextEntryOffset,
indexEndEntryOffset,
indexNextEntryOffset,
toComponentIds,
serialiseLBS,
serialiseSize,
) where
import Data.Typeable (Typeable)
import Codec.Archive.Tar.Types as Tar
import Codec.Archive.Tar.Read as Tar
import qualified Codec.Archive.Tar.Index.StringTable as StringTable
import Codec.Archive.Tar.Index.StringTable (StringTable, StringTableBuilder)
import qualified Codec.Archive.Tar.Index.IntTrie as IntTrie
import Codec.Archive.Tar.Index.IntTrie (IntTrie, IntTrieBuilder)
import Codec.Archive.Tar.PackAscii
import qualified System.FilePath.Posix as FilePath
import Data.Monoid (Monoid(..))
import Data.Monoid ((<>))
import Data.Word
import Data.Int
import Data.Bits
import qualified Data.Array.Unboxed as A
import Prelude hiding (lookup)
import System.IO
import Control.Exception (assert, throwIO)
import Control.DeepSeq
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Unsafe as BS
import Data.ByteString.Builder as BS
import Data.ByteString.Builder.Extra as BS (toLazyByteStringWith,
untrimmedStrategy)
data TarIndex = TarIndex
{-# UNPACK #-} !(StringTable PathComponentId)
{-# UNPACK #-} !IntTrie
{-# UNPACK #-} !TarEntryOffset
deriving (TarIndex -> TarIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TarIndex -> TarIndex -> Bool
$c/= :: TarIndex -> TarIndex -> Bool
== :: TarIndex -> TarIndex -> Bool
$c== :: TarIndex -> TarIndex -> Bool
Eq, Int -> TarIndex -> ShowS
[TarIndex] -> ShowS
TarIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TarIndex] -> ShowS
$cshowList :: [TarIndex] -> ShowS
show :: TarIndex -> String
$cshow :: TarIndex -> String
showsPrec :: Int -> TarIndex -> ShowS
$cshowsPrec :: Int -> TarIndex -> ShowS
Show, Typeable)
instance NFData TarIndex where
rnf :: TarIndex -> ()
rnf (TarIndex StringTable PathComponentId
_ IntTrie
_ Word32
_) = ()
data TarIndexEntry = TarFileEntry {-# UNPACK #-} !TarEntryOffset
| TarDir [(FilePath, TarIndexEntry)]
deriving (Int -> TarIndexEntry -> ShowS
[TarIndexEntry] -> ShowS
TarIndexEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TarIndexEntry] -> ShowS
$cshowList :: [TarIndexEntry] -> ShowS
show :: TarIndexEntry -> String
$cshow :: TarIndexEntry -> String
showsPrec :: Int -> TarIndexEntry -> ShowS
$cshowsPrec :: Int -> TarIndexEntry -> ShowS
Show, Typeable)
newtype PathComponentId = PathComponentId Int
deriving (PathComponentId -> PathComponentId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathComponentId -> PathComponentId -> Bool
$c/= :: PathComponentId -> PathComponentId -> Bool
== :: PathComponentId -> PathComponentId -> Bool
$c== :: PathComponentId -> PathComponentId -> Bool
Eq, Eq PathComponentId
PathComponentId -> PathComponentId -> Bool
PathComponentId -> PathComponentId -> Ordering
PathComponentId -> PathComponentId -> PathComponentId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathComponentId -> PathComponentId -> PathComponentId
$cmin :: PathComponentId -> PathComponentId -> PathComponentId
max :: PathComponentId -> PathComponentId -> PathComponentId
$cmax :: PathComponentId -> PathComponentId -> PathComponentId
>= :: PathComponentId -> PathComponentId -> Bool
$c>= :: PathComponentId -> PathComponentId -> Bool
> :: PathComponentId -> PathComponentId -> Bool
$c> :: PathComponentId -> PathComponentId -> Bool
<= :: PathComponentId -> PathComponentId -> Bool
$c<= :: PathComponentId -> PathComponentId -> Bool
< :: PathComponentId -> PathComponentId -> Bool
$c< :: PathComponentId -> PathComponentId -> Bool
compare :: PathComponentId -> PathComponentId -> Ordering
$ccompare :: PathComponentId -> PathComponentId -> Ordering
Ord, Int -> PathComponentId
PathComponentId -> Int
PathComponentId -> [PathComponentId]
PathComponentId -> PathComponentId
PathComponentId -> PathComponentId -> [PathComponentId]
PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromThenTo :: PathComponentId
-> PathComponentId -> PathComponentId -> [PathComponentId]
enumFromTo :: PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromTo :: PathComponentId -> PathComponentId -> [PathComponentId]
enumFromThen :: PathComponentId -> PathComponentId -> [PathComponentId]
$cenumFromThen :: PathComponentId -> PathComponentId -> [PathComponentId]
enumFrom :: PathComponentId -> [PathComponentId]
$cenumFrom :: PathComponentId -> [PathComponentId]
fromEnum :: PathComponentId -> Int
$cfromEnum :: PathComponentId -> Int
toEnum :: Int -> PathComponentId
$ctoEnum :: Int -> PathComponentId
pred :: PathComponentId -> PathComponentId
$cpred :: PathComponentId -> PathComponentId
succ :: PathComponentId -> PathComponentId
$csucc :: PathComponentId -> PathComponentId
Enum, Int -> PathComponentId -> ShowS
[PathComponentId] -> ShowS
PathComponentId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathComponentId] -> ShowS
$cshowList :: [PathComponentId] -> ShowS
show :: PathComponentId -> String
$cshow :: PathComponentId -> String
showsPrec :: Int -> PathComponentId -> ShowS
$cshowsPrec :: Int -> PathComponentId -> ShowS
Show, Typeable)
type TarEntryOffset = Word32
lookup :: TarIndex -> FilePath -> Maybe TarIndexEntry
lookup :: TarIndex -> String -> Maybe TarIndexEntry
lookup (TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
_) String
path = do
[PathComponentId]
fpath <- StringTable PathComponentId -> String -> Maybe [PathComponentId]
toComponentIds StringTable PathComponentId
pathTable String
path
TrieLookup
tentry <- IntTrie -> [Key] -> Maybe TrieLookup
IntTrie.lookup IntTrie
pathTrie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PathComponentId -> Key
pathComponentIdToKey [PathComponentId]
fpath
forall (m :: * -> *) a. Monad m => a -> m a
return (TrieLookup -> TarIndexEntry
mkIndexEntry TrieLookup
tentry)
where
mkIndexEntry :: TrieLookup -> TarIndexEntry
mkIndexEntry (IntTrie.Entry Value
offset) = Word32 -> TarIndexEntry
TarFileEntry forall a b. (a -> b) -> a -> b
$ Value -> Word32
IntTrie.unValue Value
offset
mkIndexEntry (IntTrie.Completions Completions
entries) =
[(String, TarIndexEntry)] -> TarIndexEntry
TarDir [ (StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
pathTable forall a b. (a -> b) -> a -> b
$ Key -> PathComponentId
keyToPathComponentId Key
key, TrieLookup -> TarIndexEntry
mkIndexEntry TrieLookup
entry)
| (Key
key, TrieLookup
entry) <- Completions
entries ]
toComponentIds :: StringTable PathComponentId -> FilePath -> Maybe [PathComponentId]
toComponentIds :: StringTable PathComponentId -> String -> Maybe [PathComponentId]
toComponentIds StringTable PathComponentId
table =
[PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents []
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char -> ByteString
BS.Char8.singleton Char
'.')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitDirectories
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (?callStack::CallStack) => String -> ByteString
packAscii
where
lookupComponents :: [PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents [PathComponentId]
cs' [] = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse [PathComponentId]
cs')
lookupComponents [PathComponentId]
cs' (ByteString
c:[ByteString]
cs) = case forall id. Enum id => StringTable id -> ByteString -> Maybe id
StringTable.lookup StringTable PathComponentId
table ByteString
c of
Maybe PathComponentId
Nothing -> forall a. Maybe a
Nothing
Just PathComponentId
cid -> [PathComponentId] -> [ByteString] -> Maybe [PathComponentId]
lookupComponents (PathComponentId
cidforall a. a -> [a] -> [a]
:[PathComponentId]
cs') [ByteString]
cs
fromComponentId :: StringTable PathComponentId -> PathComponentId -> FilePath
fromComponentId :: StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
table = ByteString -> String
BS.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id. Enum id => StringTable id -> id -> ByteString
StringTable.index StringTable PathComponentId
table
toList :: TarIndex -> [(FilePath, TarEntryOffset)]
toList :: TarIndex -> [(String, Word32)]
toList (TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
_) =
[ (String
path, Value -> Word32
IntTrie.unValue Value
off)
| ([Key]
cids, Value
off) <- IntTrie -> [([Key], Value)]
IntTrie.toList IntTrie
pathTrie
, let path :: String
path = [String] -> String
FilePath.joinPath (forall a b. (a -> b) -> [a] -> [b]
map (StringTable PathComponentId -> PathComponentId -> String
fromComponentId StringTable PathComponentId
pathTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> PathComponentId
keyToPathComponentId) [Key]
cids) ]
build :: Entries e -> Either e TarIndex
build :: forall e. Entries e -> Either e TarIndex
build = forall {a}.
IndexBuilder
-> GenEntries TarPath LinkTarget a -> Either a TarIndex
go IndexBuilder
empty
where
go :: IndexBuilder
-> GenEntries TarPath LinkTarget a -> Either a TarIndex
go !IndexBuilder
builder (Next GenEntry TarPath LinkTarget
e GenEntries TarPath LinkTarget a
es) = IndexBuilder
-> GenEntries TarPath LinkTarget a -> Either a TarIndex
go (GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
addNextEntry GenEntry TarPath LinkTarget
e IndexBuilder
builder) GenEntries TarPath LinkTarget a
es
go !IndexBuilder
builder GenEntries TarPath LinkTarget a
Done = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! IndexBuilder -> TarIndex
finalise IndexBuilder
builder
go !IndexBuilder
_ (Fail a
err) = forall a b. a -> Either a b
Left a
err
data IndexBuilder
= IndexBuilder !(StringTableBuilder PathComponentId)
!IntTrieBuilder
{-# UNPACK #-} !TarEntryOffset
deriving (IndexBuilder -> IndexBuilder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexBuilder -> IndexBuilder -> Bool
$c/= :: IndexBuilder -> IndexBuilder -> Bool
== :: IndexBuilder -> IndexBuilder -> Bool
$c== :: IndexBuilder -> IndexBuilder -> Bool
Eq, Int -> IndexBuilder -> ShowS
[IndexBuilder] -> ShowS
IndexBuilder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexBuilder] -> ShowS
$cshowList :: [IndexBuilder] -> ShowS
show :: IndexBuilder -> String
$cshow :: IndexBuilder -> String
showsPrec :: Int -> IndexBuilder -> ShowS
$cshowsPrec :: Int -> IndexBuilder -> ShowS
Show)
instance NFData IndexBuilder where
rnf :: IndexBuilder -> ()
rnf (IndexBuilder StringTableBuilder PathComponentId
_ IntTrieBuilder
_ Word32
_) = ()
empty :: IndexBuilder
empty :: IndexBuilder
empty = StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder forall id. StringTableBuilder id
StringTable.empty IntTrieBuilder
IntTrie.empty Word32
0
addNextEntry :: Entry -> IndexBuilder -> IndexBuilder
addNextEntry :: GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
addNextEntry GenEntry TarPath LinkTarget
entry (IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie Word32
nextOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
stbl' IntTrieBuilder
itrie'
(GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
nextOffset)
where
!entrypath :: [ByteString]
entrypath = TarPath -> [ByteString]
splitTarPath (forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath GenEntry TarPath LinkTarget
entry)
(StringTableBuilder PathComponentId
stbl', [PathComponentId]
cids) = forall id.
Enum id =>
[ByteString]
-> StringTableBuilder id -> (StringTableBuilder id, [id])
StringTable.inserts [ByteString]
entrypath StringTableBuilder PathComponentId
stbl
itrie' :: IntTrieBuilder
itrie' = [Key] -> Value -> IntTrieBuilder -> IntTrieBuilder
IntTrie.insert (forall a b. (a -> b) -> [a] -> [b]
map PathComponentId -> Key
pathComponentIdToKey [PathComponentId]
cids) (Word32 -> Value
IntTrie.Value Word32
nextOffset) IntTrieBuilder
itrie
skipNextEntry :: Entry -> IndexBuilder -> IndexBuilder
skipNextEntry :: GenEntry TarPath LinkTarget -> IndexBuilder -> IndexBuilder
skipNextEntry GenEntry TarPath LinkTarget
entry (IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie Word32
nextOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie (GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
nextOffset)
finalise :: IndexBuilder -> TarIndex
finalise :: IndexBuilder -> TarIndex
finalise (IndexBuilder StringTableBuilder PathComponentId
stbl IntTrieBuilder
itrie Word32
finalOffset) =
StringTable PathComponentId -> IntTrie -> Word32 -> TarIndex
TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
finalOffset
where
pathTable :: StringTable PathComponentId
pathTable = forall id. Enum id => StringTableBuilder id -> StringTable id
StringTable.finalise StringTableBuilder PathComponentId
stbl
pathTrie :: IntTrie
pathTrie = IntTrieBuilder -> IntTrie
IntTrie.finalise IntTrieBuilder
itrie
indexNextEntryOffset :: IndexBuilder -> TarEntryOffset
indexNextEntryOffset :: IndexBuilder -> Word32
indexNextEntryOffset (IndexBuilder StringTableBuilder PathComponentId
_ IntTrieBuilder
_ Word32
off) = Word32
off
indexEndEntryOffset :: TarIndex -> TarEntryOffset
indexEndEntryOffset :: TarIndex -> Word32
indexEndEntryOffset (TarIndex StringTable PathComponentId
_ IntTrie
_ Word32
off) = Word32
off
nextEntryOffset :: Entry -> TarEntryOffset -> TarEntryOffset
nextEntryOffset :: GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
offset =
Word32
offset
forall a. Num a => a -> a -> a
+ Word32
1
forall a. Num a => a -> a -> a
+ case forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent GenEntry TarPath LinkTarget
entry of
NormalFile ByteString
_ FileSize
size -> FileSize -> Word32
blocks FileSize
size
OtherEntryType Char
_ ByteString
_ FileSize
size -> FileSize -> Word32
blocks FileSize
size
GenEntryContent LinkTarget
_ -> Word32
0
where
blocks :: Int64 -> TarEntryOffset
blocks :: FileSize -> Word32
blocks FileSize
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileSize
1 forall a. Num a => a -> a -> a
+ (FileSize
size forall a. Num a => a -> a -> a
- FileSize
1) forall a. Integral a => a -> a -> a
`div` FileSize
512)
type FilePathBS = BS.ByteString
splitTarPath :: TarPath -> [FilePathBS]
splitTarPath :: TarPath -> [ByteString]
splitTarPath (TarPath ByteString
name ByteString
prefix) =
ByteString -> [ByteString]
splitDirectories ByteString
prefix forall a. [a] -> [a] -> [a]
++ ByteString -> [ByteString]
splitDirectories ByteString
name
splitDirectories :: FilePathBS -> [FilePathBS]
splitDirectories :: ByteString -> [ByteString]
splitDirectories ByteString
bs =
case Char -> ByteString -> [ByteString]
BS.Char8.split Char
'/' ByteString
bs of
ByteString
c:[ByteString]
cs | ByteString -> Bool
BS.null ByteString
c -> Char -> ByteString
BS.Char8.singleton Char
'/' forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
cs
[ByteString]
cs -> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
cs
unfinalise :: TarIndex -> IndexBuilder
unfinalise :: TarIndex -> IndexBuilder
unfinalise (TarIndex StringTable PathComponentId
pathTable IntTrie
pathTrie Word32
finalOffset) =
StringTableBuilder PathComponentId
-> IntTrieBuilder -> Word32 -> IndexBuilder
IndexBuilder (forall id. Enum id => StringTable id -> StringTableBuilder id
StringTable.unfinalise StringTable PathComponentId
pathTable)
(IntTrie -> IntTrieBuilder
IntTrie.unfinalise IntTrie
pathTrie)
Word32
finalOffset
hReadEntry :: Handle -> TarEntryOffset -> IO Entry
hReadEntry :: Handle -> Word32 -> IO (GenEntry TarPath LinkTarget)
hReadEntry Handle
hnd Word32
off = do
GenEntry TarPath LinkTarget
entry <- Handle -> Word32 -> IO (GenEntry TarPath LinkTarget)
hReadEntryHeader Handle
hnd Word32
off
case forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent GenEntry TarPath LinkTarget
entry of
NormalFile ByteString
_ FileSize
size -> do ByteString
body <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd (forall a b. (Integral a, Num b) => a -> b
fromIntegral FileSize
size)
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry {
entryContent :: GenEntryContent LinkTarget
entryContent = forall linkTarget.
ByteString -> FileSize -> GenEntryContent linkTarget
NormalFile ByteString
body FileSize
size
}
OtherEntryType Char
c ByteString
_ FileSize
size -> do ByteString
body <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd (forall a b. (Integral a, Num b) => a -> b
fromIntegral FileSize
size)
forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry {
entryContent :: GenEntryContent LinkTarget
entryContent = forall linkTarget.
Char -> ByteString -> FileSize -> GenEntryContent linkTarget
OtherEntryType Char
c ByteString
body FileSize
size
}
GenEntryContent LinkTarget
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry
hReadEntryHeader :: Handle -> TarEntryOffset -> IO Entry
Handle
hnd Word32
blockOff = do
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
blockOff
ByteString
header <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd Int
512
case ByteString -> Entries FormatError
Tar.read ByteString
header of
Tar.Next GenEntry TarPath LinkTarget
entry Entries FormatError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return GenEntry TarPath LinkTarget
entry
Tar.Fail FormatError
e -> forall e a. Exception e => e -> IO a
throwIO FormatError
e
Entries FormatError
Tar.Done -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hReadEntryHeader: impossible"
hSeekEntryOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryOffset :: Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
blockOff =
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
hnd SeekMode
AbsoluteSeek (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
blockOff forall a. Num a => a -> a -> a
* Integer
512)
hSeekEntryContentOffset :: Handle -> TarEntryOffset -> IO ()
hSeekEntryContentOffset :: Handle -> Word32 -> IO ()
hSeekEntryContentOffset Handle
hnd Word32
blockOff =
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd (Word32
blockOff forall a. Num a => a -> a -> a
+ Word32
1)
hReadEntryHeaderOrEof :: Handle -> TarEntryOffset
-> IO (Maybe (Entry, TarEntryOffset))
Handle
hnd Word32
blockOff = do
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
blockOff
ByteString
header <- Handle -> Int -> IO ByteString
LBS.hGet Handle
hnd Int
1024
case ByteString -> Entries FormatError
Tar.read ByteString
header of
Tar.Next GenEntry TarPath LinkTarget
entry Entries FormatError
_ -> let !blockOff' :: Word32
blockOff' = GenEntry TarPath LinkTarget -> Word32 -> Word32
nextEntryOffset GenEntry TarPath LinkTarget
entry Word32
blockOff
in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (GenEntry TarPath LinkTarget
entry, Word32
blockOff'))
Entries FormatError
Tar.Done -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Tar.Fail FormatError
e -> forall e a. Exception e => e -> IO a
throwIO FormatError
e
hSeekEndEntryOffset :: Handle -> Maybe TarIndex -> IO TarEntryOffset
hSeekEndEntryOffset :: Handle -> Maybe TarIndex -> IO Word32
hSeekEndEntryOffset Handle
hnd (Just TarIndex
index) = do
let offset :: Word32
offset = TarIndex -> Word32
indexEndEntryOffset TarIndex
index
Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
offset
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
offset
hSeekEndEntryOffset Handle
hnd Maybe TarIndex
Nothing = do
Integer
size <- Handle -> IO Integer
hFileSize Handle
hnd
if Integer
size forall a. Eq a => a -> a -> Bool
== Integer
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
else Word32 -> IO Word32
seekToEnd Word32
0
where
seekToEnd :: Word32 -> IO Word32
seekToEnd Word32
offset = do
Maybe (GenEntry TarPath LinkTarget, Word32)
mbe <- Handle
-> Word32 -> IO (Maybe (GenEntry TarPath LinkTarget, Word32))
hReadEntryHeaderOrEof Handle
hnd Word32
offset
case Maybe (GenEntry TarPath LinkTarget, Word32)
mbe of
Maybe (GenEntry TarPath LinkTarget, Word32)
Nothing -> do Handle -> Word32 -> IO ()
hSeekEntryOffset Handle
hnd Word32
offset
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
offset
Just (GenEntry TarPath LinkTarget
_, Word32
offset') -> Word32 -> IO Word32
seekToEnd Word32
offset'
serialise :: TarIndex -> BS.ByteString
serialise :: TarIndex -> ByteString
serialise = ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarIndex -> ByteString
serialiseLBS
serialiseLBS :: TarIndex -> LBS.ByteString
serialiseLBS :: TarIndex -> ByteString
serialiseLBS TarIndex
index =
AllocationStrategy -> ByteString -> Builder -> ByteString
BS.toLazyByteStringWith
(Int -> Int -> AllocationStrategy
BS.untrimmedStrategy (TarIndex -> Int
serialiseSize TarIndex
index) Int
512) ByteString
LBS.empty
(TarIndex -> Builder
serialiseBuilder TarIndex
index)
serialiseSize :: TarIndex -> Int
serialiseSize :: TarIndex -> Int
serialiseSize (TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
_) =
forall id. StringTable id -> Int
StringTable.serialiseSize StringTable PathComponentId
stringTable
forall a. Num a => a -> a -> a
+ IntTrie -> Int
IntTrie.serialiseSize IntTrie
intTrie
forall a. Num a => a -> a -> a
+ Int
8
serialiseBuilder :: TarIndex -> BS.Builder
serialiseBuilder :: TarIndex -> Builder
serialiseBuilder (TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
finalOffset) =
Word32 -> Builder
BS.word32BE Word32
2
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BS.word32BE Word32
finalOffset
forall a. Semigroup a => a -> a -> a
<> forall id. StringTable id -> Builder
StringTable.serialise StringTable PathComponentId
stringTable
forall a. Semigroup a => a -> a -> a
<> IntTrie -> Builder
IntTrie.serialise IntTrie
intTrie
deserialise :: BS.ByteString -> Maybe (TarIndex, BS.ByteString)
deserialise :: ByteString -> Maybe (TarIndex, ByteString)
deserialise ByteString
bs
| ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
8
= forall a. Maybe a
Nothing
| let ver :: Word32
ver = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
0
, Word32
ver forall a. Eq a => a -> a -> Bool
== Word32
1
= do let !finalOffset :: Word32
finalOffset = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
4
(StringTable PathComponentId
stringTable, ByteString
bs') <- forall id. ByteString -> Maybe (StringTable id, ByteString)
StringTable.deserialiseV1 (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
(IntTrie
intTrie, ByteString
bs'') <- ByteString -> Maybe (IntTrie, ByteString)
IntTrie.deserialise ByteString
bs'
forall (m :: * -> *) a. Monad m => a -> m a
return (StringTable PathComponentId -> IntTrie -> Word32 -> TarIndex
TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
finalOffset, ByteString
bs'')
| let ver :: Word32
ver = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
0
, Word32
ver forall a. Eq a => a -> a -> Bool
== Word32
2
= do let !finalOffset :: Word32
finalOffset = ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
4
(StringTable PathComponentId
stringTable, ByteString
bs') <- forall id. ByteString -> Maybe (StringTable id, ByteString)
StringTable.deserialiseV2 (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
(IntTrie
intTrie, ByteString
bs'') <- ByteString -> Maybe (IntTrie, ByteString)
IntTrie.deserialise ByteString
bs'
forall (m :: * -> *) a. Monad m => a -> m a
return (StringTable PathComponentId -> IntTrie -> Word32 -> TarIndex
TarIndex StringTable PathComponentId
stringTable IntTrie
intTrie Word32
finalOffset, ByteString
bs'')
| Bool
otherwise = forall a. Maybe a
Nothing
readWord32BE :: BS.ByteString -> Int -> Word32
readWord32BE :: ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
i =
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
BS.length ByteString
bs forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
0)) forall a. Bits a => a -> Int -> a
`shiftL` Int
24
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
1)) forall a. Bits a => a -> Int -> a
`shiftL` Int
16
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
2)) forall a. Bits a => a -> Int -> a
`shiftL` Int
8
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
3))
toStrict :: LBS.ByteString -> BS.ByteString
toStrict :: ByteString -> ByteString
toStrict = ByteString -> ByteString
LBS.toStrict
pathComponentIdToKey :: PathComponentId -> IntTrie.Key
pathComponentIdToKey :: PathComponentId -> Key
pathComponentIdToKey (PathComponentId Int
n) = Word32 -> Key
IntTrie.Key (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
keyToPathComponentId :: IntTrie.Key -> PathComponentId
keyToPathComponentId :: Key -> PathComponentId
keyToPathComponentId (IntTrie.Key Word32
n) = Int -> PathComponentId
PathComponentId (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)