{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| This module is about stream-processing tar archives. It is currently
not very well tested. See the documentation of 'withEntries' for an usage sample.
-}
module Data.Conduit.Tar
    ( -- * Basic functions
      tar
    , tarEntries
    , untar
    , untarRaw
    , untarWithFinalizers
    , untarWithExceptions
    , restoreFile
    , restoreFileInto
    , restoreFileIntoLenient
    , restoreFileWithErrors
    -- ** Operate on Chunks
    , untarChunks
    , untarChunksRaw
    , applyPaxChunkHeaders
    , withEntry
    , withEntries
    , withFileInfo
      -- * Helper functions
    , headerFileType
    , headerFilePath
      -- ** Creation
    , tarFilePath
    , filePathConduit
      -- * Directly on files
    , createTarball
    , writeTarball
    , extractTarball
    , extractTarballLenient
      -- * Types
    , module Data.Conduit.Tar.Types
    ) where

import           Conduit                  as C
import           Control.Exception        (assert, SomeException)
import           Control.Monad            (unless, void)
import           Control.Monad.State.Lazy (StateT, get, put)
import           Data.Bits
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as S
import           Data.ByteString.Builder
import qualified Data.ByteString.Char8    as S8
import qualified Data.ByteString.Lazy     as SL
import           Data.ByteString.Short    (ShortByteString, fromShort, toShort)
import qualified Data.ByteString.Short    as SS
import qualified Data.ByteString.Unsafe   as BU
import           Data.Foldable            (foldr')
import qualified Data.Map                 as Map
import           Data.Monoid              ((<>), mempty)
import           Data.Word                (Word8)
import           Foreign.C.Types          (CTime (..))
import           Foreign.Storable
import           System.Directory         (createDirectoryIfMissing,
                                           getCurrentDirectory)
import           System.FilePath
import           System.IO

#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative      ((<*))
#endif

import           Data.Conduit.Tar.Types
#ifdef WINDOWS
import           Data.Conduit.Tar.Windows
#else
import           Data.Conduit.Tar.Unix
#endif


headerFilePathBS :: Header -> S.ByteString
headerFilePathBS :: Header -> ByteString
headerFilePathBS Header {Word8
UserID
FileOffset
CMode
GroupID
DeviceID
EpochTime
ShortByteString
headerFileNamePrefix :: Header -> ShortByteString
headerDeviceMinor :: Header -> DeviceID
headerDeviceMajor :: Header -> DeviceID
headerGroupName :: Header -> ShortByteString
headerOwnerName :: Header -> ShortByteString
headerMagicVersion :: Header -> ShortByteString
headerLinkName :: Header -> ShortByteString
headerLinkIndicator :: Header -> Word8
headerTime :: Header -> EpochTime
headerPayloadSize :: Header -> FileOffset
headerGroupId :: Header -> GroupID
headerOwnerId :: Header -> UserID
headerFileMode :: Header -> CMode
headerFileNameSuffix :: Header -> ShortByteString
headerPayloadOffset :: Header -> FileOffset
headerOffset :: Header -> FileOffset
headerFileNamePrefix :: ShortByteString
headerDeviceMinor :: DeviceID
headerDeviceMajor :: DeviceID
headerGroupName :: ShortByteString
headerOwnerName :: ShortByteString
headerMagicVersion :: ShortByteString
headerLinkName :: ShortByteString
headerLinkIndicator :: Word8
headerTime :: EpochTime
headerPayloadSize :: FileOffset
headerGroupId :: GroupID
headerOwnerId :: UserID
headerFileMode :: CMode
headerFileNameSuffix :: ShortByteString
headerPayloadOffset :: FileOffset
headerOffset :: FileOffset
..} =
    if ShortByteString -> Bool
SS.null ShortByteString
headerFileNamePrefix
        then ShortByteString -> ByteString
fromShort ShortByteString
headerFileNameSuffix
        else [ByteString] -> ByteString
S.concat
                 [ShortByteString -> ByteString
fromShort ShortByteString
headerFileNamePrefix, ByteString
pathSeparatorS, ShortByteString -> ByteString
fromShort ShortByteString
headerFileNameSuffix]

-- | Construct a `FilePath` from `headerFileNamePrefix` and `headerFileNameSuffix`.
--
-- @since 0.1.0
headerFilePath :: Header -> FilePath
headerFilePath :: Header -> FilePath
headerFilePath = ByteString -> FilePath
decodeFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> ByteString
headerFilePathBS

-- | Get Header file type.
--
-- @since 0.1.0
headerFileType :: Header -> FileType
headerFileType :: Header -> FileType
headerFileType Header
h =
    case Header -> Word8
headerLinkIndicator Header
h of
        Word8
0  -> FileType
FTNormal
        Word8
48 -> FileType
FTNormal
        Word8
49 -> ByteString -> FileType
FTHardLink (ShortByteString -> ByteString
fromShort (Header -> ShortByteString
headerLinkName Header
h))
        Word8
50 -> ByteString -> FileType
FTSymbolicLink (ShortByteString -> ByteString
fromShort (Header -> ShortByteString
headerLinkName Header
h))
        Word8
51 -> FileType
FTCharacterSpecial
        Word8
52 -> FileType
FTBlockSpecial
        Word8
53 -> FileType
FTDirectory
        Word8
54 -> FileType
FTFifo
        Word8
x  -> Word8 -> FileType
FTOther Word8
x

parseHeader :: FileOffset -> ByteString -> Either TarException Header
parseHeader :: FileOffset -> ByteString -> Either TarException Header
parseHeader FileOffset
offset ByteString
bs = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
S.length ByteString
bs forall a. Eq a => a -> a -> Bool
== Int
512) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
IncompleteHeader FileOffset
offset
    let checksumBytes :: ByteString
checksumBytes = Int -> ByteString -> ByteString
BU.unsafeTake Int
8 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
148 ByteString
bs
        expectedChecksum :: Int
expectedChecksum = forall i. Integral i => ByteString -> i
parseOctal ByteString
checksumBytes
        actualChecksum :: Int
actualChecksum = ByteString -> Int
bsum ByteString
bs forall a. Num a => a -> a -> a
- ByteString -> Int
bsum ByteString
checksumBytes forall a. Num a => a -> a -> a
+ Int
8 forall a. Num a => a -> a -> a
* forall i. Integral i => i
space
        magicVersion :: ShortByteString
magicVersion = ByteString -> ShortByteString
toShort forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
8 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
257 ByteString
bs
        getNumber :: (Storable a, Bits a, Integral a) => Int -> Int -> a
        getNumber :: forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber = if ShortByteString
magicVersion forall a. Eq a => a -> a -> Bool
== ShortByteString
gnuTarMagicVersion then forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getHexOctal else forall a. Integral a => Int -> Int -> a
getOctal

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
actualChecksum forall a. Eq a => a -> a -> Bool
== Int
expectedChecksum) (forall a b. a -> Either a b
Left (FileOffset -> TarException
BadChecksum FileOffset
offset))
    forall (m :: * -> *) a. Monad m => a -> m a
return Header
        { headerOffset :: FileOffset
headerOffset         = FileOffset
offset
        , headerPayloadOffset :: FileOffset
headerPayloadOffset  = FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
512
        , headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = Int -> Int -> ShortByteString
getShort Int
0 Int
100
        , headerFileMode :: CMode
headerFileMode       = forall a. Integral a => Int -> Int -> a
getOctal Int
100 Int
8
        , headerOwnerId :: UserID
headerOwnerId        = forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
108 Int
8
        , headerGroupId :: GroupID
headerGroupId        = forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
116 Int
8
        , headerPayloadSize :: FileOffset
headerPayloadSize    = forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
124 Int
12
        , headerTime :: EpochTime
headerTime           = Int64 -> EpochTime
CTime forall a b. (a -> b) -> a -> b
$ forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
136 Int
12
        , headerLinkIndicator :: Word8
headerLinkIndicator  = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
156
        , headerLinkName :: ShortByteString
headerLinkName       = Int -> Int -> ShortByteString
getShort Int
157 Int
100
        , headerMagicVersion :: ShortByteString
headerMagicVersion   = ShortByteString
magicVersion
        , headerOwnerName :: ShortByteString
headerOwnerName      = Int -> Int -> ShortByteString
getShort Int
265 Int
32
        , headerGroupName :: ShortByteString
headerGroupName      = Int -> Int -> ShortByteString
getShort Int
297 Int
32
        , headerDeviceMajor :: DeviceID
headerDeviceMajor    = forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
329 Int
8
        , headerDeviceMinor :: DeviceID
headerDeviceMinor    = forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
337 Int
8
        , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = Int -> Int -> ShortByteString
getShort Int
345 Int
155
        }
  where
    bsum :: ByteString -> Int
    bsum :: ByteString -> Int
bsum = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\Int
c Word8
n -> Int
c forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Int
0

    getShort :: Int -> Int -> ShortByteString
getShort Int
off Int
len = ByteString -> ShortByteString
toShort forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
0) forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
len forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
off ByteString
bs

    getOctal :: Integral a => Int -> Int -> a
    getOctal :: forall a. Integral a => Int -> Int -> a
getOctal Int
off Int
len = forall i. Integral i => ByteString -> i
parseOctal forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
len forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
off ByteString
bs

    -- | Depending on the first bit of the first byte in the range either choose direct
    -- hex representation, or classic octal string view.
    getHexOctal :: (Storable a, Bits a, Integral a) => Int -> Int -> a
    getHexOctal :: forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getHexOctal Int
off Int
len = if ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
off forall a. Bits a => a -> a -> a
.&. Word8
0x80 forall a. Eq a => a -> a -> Bool
== Word8
0x80
                          then forall a. (Storable a, Bits a, Integral a) => ByteString -> a
fromHex forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
len forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
off ByteString
bs
                          else forall a. Integral a => Int -> Int -> a
getOctal Int
off Int
len

    parseOctal :: Integral i => ByteString -> i
    parseOctal :: forall i. Integral i => ByteString -> i
parseOctal = forall i. Integral i => i -> ByteString -> i
parseBase i
8
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile (\Word8
c -> Word8
zero forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
seven)
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (forall a. Eq a => a -> a -> Bool
== forall i. Integral i => i
space)

    seven :: Word8
seven = Word8
55

parseBase :: Integral i => i -> ByteString -> i
parseBase :: forall i. Integral i => i -> ByteString -> i
parseBase i
n = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\i
t Word8
c -> i
t forall a. Num a => a -> a -> a
* i
n forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c forall a. Num a => a -> a -> a
- Word8
zero)) i
0

space :: Integral i => i
space :: forall i. Integral i => i
space = i
0x20 -- UTF-8 ' '

zero :: Word8
zero :: Word8
zero = Word8
0x30 -- UTF-8 '0'

-- | Make sure we don't use more bytes than we can fit in the data type.
fromHex :: forall a . (Storable a, Bits a, Integral a) => ByteString -> a
fromHex :: forall a. (Storable a, Bits a, Integral a) => ByteString -> a
fromHex ByteString
str = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\ a
acc Word8
x -> (a
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) a
0 forall a b. (a -> b) -> a -> b
$
              Int -> ByteString -> ByteString
S.drop (forall a. Ord a => a -> a -> a
max Int
0 (ByteString -> Int
S.length ByteString
str forall a. Num a => a -> a -> a
- forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))) ByteString
str

-- | Convert a stream of raw bytes into a stream of 'TarChunk's, after applying
-- any pax header blocks and extended headers. This stream can further be passed
-- into 'withFileInfo' or 'withHeaders' functions. Only the \'comment\',
-- \'gid\', \'gname\', \'linkpath\', \'path\', \'size\', \'uid\' and \'uname\'
--  pax keywords are supported. For a component that produces unprocessed
-- 'TarChunk's, see 'untarChunksRaw'.
--
-- @since 0.2.1
untarChunks :: Monad m => ConduitM ByteString TarChunk m ()
untarChunks :: forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunks =
       forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunksRaw
    forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) s i o r.
Monad m =>
s -> ConduitT i o (StateT s m) r -> ConduitT i o m r
evalStateLC PaxState
initialPaxState forall (m :: * -> *).
Monad m =>
ConduitM TarChunk TarChunk (StateT PaxState m) ()
applyPaxChunkHeaders

-- | Convert a stream of raw bytes into a stream of raw 'TarChunk's. This stream
-- can further be passed into `withFileInfo` or `withHeaders` functions. For a
-- component that further processes raw 'TarChunk's to apply pax header blocks
-- and extended headers, see 'untarChunk'.
--
-- @since 0.3.3
untarChunksRaw :: Monad m => ConduitM ByteString TarChunk m ()
untarChunksRaw :: forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunksRaw =
    forall {m :: * -> *}.
Monad m =>
FileOffset -> ConduitT ByteString TarChunk m ()
loop FileOffset
0
  where
    loop :: FileOffset -> ConduitT ByteString TarChunk m ()
loop !FileOffset
offset = forall a. HasCallStack => Bool -> a -> a
assert (FileOffset
offset forall a. Integral a => a -> a -> a
`mod` FileOffset
512 forall a. Eq a => a -> a -> Bool
== FileOffset
0) forall a b. (a -> b) -> a -> b
$ do
        ByteString
bs <- forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
takeCE Int
512 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. (Monad m, Monoid a) => ConduitT a o m a
foldC
        case ByteString -> Int
S.length ByteString
bs of
            Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Int
512 | (Word8 -> Bool) -> ByteString -> Bool
S.all (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs -> do
                let offset' :: FileOffset
offset' = FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
512
                ByteString
bs' <- forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
takeCE Int
512 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. (Monad m, Monoid a) => ConduitT a o m a
foldC
                case () of
                    ()
                        | ByteString -> Int
S.length ByteString
bs' forall a. Eq a => a -> a -> Bool
/= Int
512 -> do
                            forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs'
                            forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
ShortTrailer FileOffset
offset'
                        | (Word8 -> Bool) -> ByteString -> Bool
S.all (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        | Bool
otherwise -> do
                            forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs'
                            forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
BadTrailer FileOffset
offset'
            Int
512 ->
                case FileOffset -> ByteString -> Either TarException Header
parseHeader FileOffset
offset ByteString
bs of
                    Left TarException
e -> do
                        forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
                        forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException TarException
e
                    Right Header
h -> do
                        forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ Header -> TarChunk
ChunkHeader Header
h
                        FileOffset
offset' <- forall {t} {m :: * -> *}.
(Monad m, Integral t) =>
FileOffset -> t -> ConduitT ByteString TarChunk m FileOffset
payloads (FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
512) forall a b. (a -> b) -> a -> b
$ Header -> FileOffset
headerPayloadSize Header
h
                        let expectedOffset :: FileOffset
expectedOffset = FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
512 forall a. Num a => a -> a -> a
+ Header -> FileOffset
headerPayloadSize Header
h forall a. Num a => a -> a -> a
+
                                (case FileOffset
512 forall a. Num a => a -> a -> a
- (Header -> FileOffset
headerPayloadSize Header
h forall a. Integral a => a -> a -> a
`mod` FileOffset
512) of
                                    FileOffset
512 -> FileOffset
0
                                    FileOffset
x   -> FileOffset
x)
                        forall a. HasCallStack => Bool -> a -> a
assert (FileOffset
offset' forall a. Eq a => a -> a -> Bool
== FileOffset
expectedOffset) (FileOffset -> ConduitT ByteString TarChunk m ()
loop FileOffset
offset')
            Int
_ -> do
                forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
                forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
IncompleteHeader FileOffset
offset

    payloads :: FileOffset -> t -> ConduitT ByteString TarChunk m FileOffset
payloads !FileOffset
offset t
0 = do
        let padding :: Int
padding =
                case FileOffset
offset forall a. Integral a => a -> a -> a
`mod` FileOffset
512 of
                    FileOffset
0 -> Int
0
                    FileOffset
x -> Int
512 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
x
        forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
takeCE Int
padding forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! FileOffset
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding
    payloads !FileOffset
offset !t
size = do
        Maybe ByteString
mbs <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
        case Maybe ByteString
mbs of
            Maybe ByteString
Nothing -> do
                forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException forall a b. (a -> b) -> a -> b
$ FileOffset -> ByteCount -> TarException
IncompletePayload FileOffset
offset forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral t
size
                forall (m :: * -> *) a. Monad m => a -> m a
return FileOffset
offset
            Just ByteString
bs -> do
                let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Ord a => a -> a -> a
min t
size (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)))) ByteString
bs
                forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ FileOffset -> ByteString -> TarChunk
ChunkPayload FileOffset
offset ByteString
x
                let size' :: t
size' = t
size forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
x)
                    offset' :: FileOffset
offset' = FileOffset
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
x)
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
y) (forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
y)
                FileOffset -> t -> ConduitT ByteString TarChunk m FileOffset
payloads FileOffset
offset' t
size'


-- | Process a single tar entry. See 'withEntries' for more details.
--
-- @since 0.1.0
--
withEntry :: MonadThrow m
          => (Header -> ConduitM ByteString o m r)
          -> ConduitM TarChunk o m r
withEntry :: forall (m :: * -> *) o r.
MonadThrow m =>
(Header -> ConduitM ByteString o m r) -> ConduitM TarChunk o m r
withEntry Header -> ConduitM ByteString o m r
inner = do
    Maybe TarChunk
mc <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe TarChunk
mc of
        Maybe TarChunk
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
NoMoreHeaders
        Just (ChunkHeader Header
h) -> forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Header -> ConduitM ByteString o m r
inner Header
h forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull)
        Just x :: TarChunk
x@(ChunkPayload FileOffset
offset ByteString
_bs) -> do
            forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
x
            forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
UnexpectedPayload FileOffset
offset
        Just (ChunkException TarException
e) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
e


payloadsConduit :: MonadThrow m
               => ConduitM TarChunk ByteString m ()
payloadsConduit :: forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit = do
    Maybe TarChunk
mx <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe TarChunk
mx of
        Just (ChunkPayload FileOffset
_ ByteString
bs) -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit
        Just x :: TarChunk
x@ChunkHeader {}    -> forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
x
        Just (ChunkException TarException
e)  -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
e
        Maybe TarChunk
Nothing                  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()


{-| This function handles each entry of the tar archive according to the
behaviour of the function passed as first argument.

Here is a full example function, that reads a compressed tar archive and for each entry that is a
simple file, it prints its file path and SHA256 digest. Note that this function can throw
exceptions!

> import qualified Crypto.Hash.Conduit as CH
> import qualified Data.Conduit.Tar    as CT
>
> import Conduit
> import Crypto.Hash (Digest, SHA256)
> import Control.Monad (when)
> import Data.Conduit.Zlib (ungzip)
> import Data.ByteString (ByteString)
>
> filedigests :: FilePath -> IO ()
> filedigests fp = runConduitRes (  sourceFileBS fp          -- read the raw file
>                                .| ungzip                   -- gunzip
>                                .| CT.untarChunks           -- decode the tar archive
>                                .| CT.withEntries hashentry -- process each file
>                                .| printC                   -- print the results
>                                )
>     where
>         hashentry :: Monad m => CT.Header -> Conduit ByteString m (FilePath, Digest SHA256)
>         hashentry hdr = when (CT.headerFileType hdr == CT.FTNormal) $ do
>             hash <- CH.sinkHash
>             yield (CT.headerFilePath hdr, hash)

The @hashentry@ function handles a single entry, based on its first 'Header' argument.
In this example, a 'Consumer' is used to process the whole entry.

Note that the benefits of stream processing are easily lost when working with a 'Consumer'. For
example, the following implementation would have used an unbounded amount of memory:

>         hashentry hdr = when (CT.headerFileType hdr == CT.FTNormal) $ do
>             content <- mconcat <$> sinkList
>             yield (CT.headerFilePath hdr, hash content)

@since 0.1.0
-}
withEntries :: MonadThrow m
            => (Header -> ConduitM ByteString o m ())
            -> ConduitM TarChunk o m ()
withEntries :: forall (m :: * -> *) o.
MonadThrow m =>
(Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
withEntries = forall (m :: * -> *) i o.
Monad m =>
ConduitT i o m () -> ConduitT i o m ()
peekForever forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) o r.
MonadThrow m =>
(Header -> ConduitM ByteString o m r) -> ConduitM TarChunk o m r
withEntry


-- | Extract a tarball, similarly to `withEntries`, but instead of dealing directly with tar format,
-- this conduit allows you to work directly on file abstractions `FileInfo`. For now support is
-- minimal:
--
-- * Old v7 tar format.
-- * ustar: POSIX 1003.1-1988 format
-- * and only some portions of GNU format:
--   * Larger values for `fileUserId`, `fileGroupId`, `fileSize` and `fileModTime`.
--   * 'L' type - long file names, but only up to 4096 chars to prevent DoS attack
--   * other types are simply discarded
--
-- /Note/ - Here is a really good reference for specifics of different tar formats:
-- <https://github.com/libarchive/libarchive/wiki/ManPageTar5>
--
-- @since 0.2.2
withFileInfo :: MonadThrow m
             => (FileInfo -> ConduitM ByteString o m ())
             -> ConduitM TarChunk o m ()
withFileInfo :: forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
withFileInfo FileInfo -> ConduitM ByteString o m ()
inner = ConduitT TarChunk o m ()
start
  where
    start :: ConduitT TarChunk o m ()
start = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) TarChunk -> ConduitT TarChunk o m ()
go
    go :: TarChunk -> ConduitT TarChunk o m ()
go TarChunk
x =
        case TarChunk
x of
            ChunkHeader Header
h
                | Header -> Word8
headerLinkIndicator Header
h forall a. Ord a => a -> a -> Bool
>= Word8
55 ->
                    if Header -> ShortByteString
headerMagicVersion Header
h forall a. Eq a => a -> a -> Bool
== ShortByteString
gnuTarMagicVersion
                        then forall (m :: * -> *) o.
MonadThrow m =>
Header -> ConduitM TarChunk o m (Maybe TarChunk)
handleGnuTarHeader Header
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT TarChunk o m ()
start TarChunk -> ConduitT TarChunk o m ()
go
                        else forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC
                                 (\case
                                      ChunkPayload FileOffset
_ ByteString
_ -> Bool
True
                                      TarChunk
_                -> Bool
False) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT TarChunk o m ()
start
            ChunkHeader Header
h -> do
                forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (FileInfo -> ConduitM ByteString o m ()
inner (Header -> FileInfo
fileInfoFromHeader Header
h) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull)
                ConduitT TarChunk o m ()
start
            ChunkPayload FileOffset
offset ByteString
_bs -> do
                forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
x
                forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
UnexpectedPayload FileOffset
offset
            ChunkException TarException
e -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
e


-- | Take care of custom GNU tar format.
handleGnuTarHeader :: MonadThrow m
                   => Header
                   -> ConduitM TarChunk o m (Maybe TarChunk)
handleGnuTarHeader :: forall (m :: * -> *) o.
MonadThrow m =>
Header -> ConduitM TarChunk o m (Maybe TarChunk)
handleGnuTarHeader Header
h =
    case Header -> Word8
headerLinkIndicator Header
h of
        Word8
76 -> do
            let pSize :: FileOffset
pSize = Header -> FileOffset
headerPayloadSize Header
h
            -- guard against names that are too long in order to prevent a DoS attack on unbounded
            -- file names
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileOffset
0 forall a. Ord a => a -> a -> Bool
< FileOffset
pSize Bool -> Bool -> Bool
&& FileOffset
pSize forall a. Ord a => a -> a -> Bool
<= FileOffset
4096) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                FileOffset -> Char -> FilePath -> TarException
FileTypeError (Header -> FileOffset
headerPayloadOffset Header
h) Char
'L' forall a b. (a -> b) -> a -> b
$ FilePath
"Filepath is too long: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FileOffset
pSize
            Builder
longFileNameBuilder <- forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
foldMapC ByteString -> Builder
byteString
            let longFileName :: ByteString
longFileName = ByteString -> ByteString
SL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
SL.init forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
longFileNameBuilder
            Maybe TarChunk
mcNext <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
            case Maybe TarChunk
mcNext of
                Just (ChunkHeader Header
nh) -> do
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> ByteString -> Bool
S.isPrefixOf (ShortByteString -> ByteString
fromShort (Header -> ShortByteString
headerFileNameSuffix Header
nh)) ByteString
longFileName) forall a b. (a -> b) -> a -> b
$
                        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                        FileOffset -> Char -> FilePath -> TarException
FileTypeError (Header -> FileOffset
headerPayloadOffset Header
nh) Char
'L'
                        FilePath
"Long filename doesn't match the original."
                    forall (m :: * -> *) a. Monad m => a -> m a
return
                        (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Header -> TarChunk
ChunkHeader forall a b. (a -> b) -> a -> b
$
                         Header
nh
                         { headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ByteString -> ShortByteString
toShort ByteString
longFileName
                         , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = ShortByteString
SS.empty
                         })
                Just c :: TarChunk
c@(ChunkPayload FileOffset
offset ByteString
_) -> do
                    forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
c
                    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
InvalidHeader FileOffset
offset
                Just (ChunkException TarException
exc) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
exc
                Maybe TarChunk
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
NoMoreHeaders
        Word8
83 -> do
            forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull -- discard sparse files payload
            -- TODO : Implement restoring of sparse files
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Just like 'withFileInfo', but works directly on the stream of bytes.
-- Applies pax header blocks and extended headers. However, only the
-- \'comment\', \'gid\', \'gname\', \'linkpath\', \'path\', \'size\', \'uid\'
-- and \'uname\' pax keywords are supported.
--
-- @since 0.2.0
untar :: MonadThrow m
      => (FileInfo -> ConduitM ByteString o m ())
      -> ConduitM ByteString o m ()
untar :: forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untar FileInfo -> ConduitM ByteString o m ()
inner = forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunks forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
withFileInfo FileInfo -> ConduitM ByteString o m ()
inner

-- | Like 'untar' but does not apply pax header blocks and extended headers.
--
-- @since 0.3.3
untarRaw ::
       MonadThrow m
    => (FileInfo -> ConduitM ByteString o m ())
    -> ConduitM ByteString o m ()
untarRaw :: forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untarRaw FileInfo -> ConduitM ByteString o m ()
inner = forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunksRaw forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
withFileInfo FileInfo -> ConduitM ByteString o m ()
inner

-- | Applies tar chunks that are pax header blocks and extended headers to the
-- tar chunks that follow. However, only the \'comment\', \'gid\', \'gname\',
-- \'linkpath\', \'path\', \'size\', \'uid\' and \'uname\' pax keywords are
-- supported.
applyPaxChunkHeaders ::
       Monad m
    => ConduitM TarChunk TarChunk (StateT PaxState m) ()
applyPaxChunkHeaders :: forall (m :: * -> *).
Monad m =>
ConduitM TarChunk TarChunk (StateT PaxState m) ()
applyPaxChunkHeaders = forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever forall a b. (a -> b) -> a -> b
$ \TarChunk
i -> do
    state :: PaxState
state@(PaxState PaxHeader
g PaxHeader
x) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
    let updateState :: (PaxHeader -> PaxState -> PaxState)
-> ConduitT TarChunk TarChunk (StateT PaxState m) ()
updateState PaxHeader -> PaxState -> PaxState
f = do
            PaxHeader
p <- forall (m :: * -> *).
Monad m =>
ConduitM TarChunk TarChunk (StateT PaxState m) PaxHeader
parsePax
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ PaxHeader -> PaxState -> PaxState
f PaxHeader
p PaxState
state
    case TarChunk
i of
        ChunkHeader Header
h -> case Header -> Word8
headerLinkIndicator Header
h of
            -- 'g' typeflag unique to pax header block
            Word8
0x67 -> forall {m :: * -> *}.
Monad m =>
(PaxHeader -> PaxState -> PaxState)
-> ConduitT TarChunk TarChunk (StateT PaxState m) ()
updateState PaxHeader -> PaxState -> PaxState
updateGlobal
            -- 'x' typeflag unique to pax header block
            Word8
0x78 -> forall {m :: * -> *}.
Monad m =>
(PaxHeader -> PaxState -> PaxState)
-> ConduitT TarChunk TarChunk (StateT PaxState m) ()
updateState PaxHeader -> PaxState -> PaxState
updateNext
            -- All other typeflag
            Word8
_ -> do
                forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ Header -> TarChunk
ChunkHeader forall a b. (a -> b) -> a -> b
$ PaxHeader -> Header -> Header
applyPax (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union PaxHeader
x PaxHeader
g) Header
h
                forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ PaxState -> PaxState
clearNext PaxState
state
        TarChunk
_ -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield TarChunk
i
 where
    updateGlobal :: PaxHeader -> PaxState -> PaxState
updateGlobal PaxHeader
p (PaxState PaxHeader
g PaxHeader
x) = PaxHeader -> PaxHeader -> PaxState
PaxState (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union PaxHeader
p PaxHeader
g) PaxHeader
x
    updateNext :: PaxHeader -> PaxState -> PaxState
updateNext PaxHeader
p (PaxState PaxHeader
g PaxHeader
_) = PaxHeader -> PaxHeader -> PaxState
PaxState PaxHeader
g PaxHeader
p
    clearNext :: PaxState -> PaxState
clearNext = PaxHeader -> PaxState -> PaxState
updateNext forall a. Monoid a => a
mempty

-- | Only the \'comment\', \'gid\', \'gname\', \'linkpath\',\'path\', \'size\',
-- \'uid\' and \'uname\' pax keywords are supported.
applyPax :: PaxHeader -> Header -> Header
applyPax :: PaxHeader -> Header -> Header
applyPax PaxHeader
p Header
h =
      Header -> Header
updateGid
    forall a b. (a -> b) -> a -> b
$ Header -> Header
updateGname
    forall a b. (a -> b) -> a -> b
$ Header -> Header
updateLinkpath
    forall a b. (a -> b) -> a -> b
$ Header -> Header
updatePath
    forall a b. (a -> b) -> a -> b
$ Header -> Header
updateSize
    forall a b. (a -> b) -> a -> b
$ Header -> Header
updateUid
    forall a b. (a -> b) -> a -> b
$ Header -> Header
updateUname Header
h
  where
    update ::
           ByteString
        -> (ByteString -> Header -> Header)
        -> (Header -> Header)
    update :: ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
k ByteString -> Header -> Header
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ByteString -> Header -> Header
f (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
k PaxHeader
p)
    ifValueDecimal ::
           Integral i
        => (i -> Header -> Header)
        -> ByteString
        -> (Header -> Header)
    ifValueDecimal :: forall i.
Integral i =>
(i -> Header -> Header) -> ByteString -> Header -> Header
ifValueDecimal i -> Header -> Header
f ByteString
v = if (Word8 -> Bool) -> ByteString -> Bool
S.all Word8 -> Bool
isDecimal ByteString
v
        then i -> Header -> Header
f (forall i. Integral i => ByteString -> i
parseDecimal ByteString
v)
        else forall a. a -> a
id
    -- There is no 'updateComment' because comments are ignored.
    updateGid :: Header -> Header
updateGid = ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"gid" forall a b. (a -> b) -> a -> b
$ forall i.
Integral i =>
(i -> Header -> Header) -> ByteString -> Header -> Header
ifValueDecimal forall a b. (a -> b) -> a -> b
$ \GroupID
v Header
h' -> Header
h'
        { headerGroupId :: GroupID
headerGroupId = GroupID
v }
    updateGname :: Header -> Header
updateGname = ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"gname" forall a b. (a -> b) -> a -> b
$ \ByteString
v Header
h' -> Header
h' { headerGroupName :: ShortByteString
headerGroupName = ByteString -> ShortByteString
toShort ByteString
v }
    updateLinkpath :: Header -> Header
updateLinkpath =
        ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"linkpath" forall a b. (a -> b) -> a -> b
$ \ByteString
v Header
h' -> Header
h' { headerLinkName :: ShortByteString
headerLinkName = ByteString -> ShortByteString
toShort ByteString
v }
    updatePath :: Header -> Header
updatePath = ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"path" forall a b. (a -> b) -> a -> b
$ \ByteString
v Header
h' -> Header
h'
        { headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ByteString -> ShortByteString
toShort ByteString
v, headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = forall a. Monoid a => a
mempty }
    updateSize :: Header -> Header
updateSize = ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"size" forall a b. (a -> b) -> a -> b
$ forall i.
Integral i =>
(i -> Header -> Header) -> ByteString -> Header -> Header
ifValueDecimal forall a b. (a -> b) -> a -> b
$ \FileOffset
v Header
h' -> Header
h'
        { headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
v }
    updateUid :: Header -> Header
updateUid = ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"uid" forall a b. (a -> b) -> a -> b
$ forall i.
Integral i =>
(i -> Header -> Header) -> ByteString -> Header -> Header
ifValueDecimal forall a b. (a -> b) -> a -> b
$ \UserID
v Header
h' -> Header
h'
        { headerOwnerId :: UserID
headerOwnerId = UserID
v }
    updateUname :: Header -> Header
updateUname = ByteString -> (ByteString -> Header -> Header) -> Header -> Header
update ByteString
"uname" forall a b. (a -> b) -> a -> b
$ \ByteString
v Header
h' -> Header
h' { headerOwnerName :: ShortByteString
headerOwnerName = ByteString -> ShortByteString
toShort ByteString
v }

parsePax :: Monad m => ConduitM TarChunk TarChunk (StateT PaxState m) PaxHeader
parsePax :: forall (m :: * -> *).
Monad m =>
ConduitM TarChunk TarChunk (StateT PaxState m) PaxHeader
parsePax = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (ChunkPayload FileOffset
_ ByteString
b) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> PaxHeader
paxParser ByteString
b
    Maybe TarChunk
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

-- | A pax extended header comprises one or more records. If the pax extended
-- header is empty or does not parse, yields an empty 'Pax'.
paxParser :: ByteString -> PaxHeader
paxParser :: ByteString -> PaxHeader
paxParser ByteString
b
    -- This is an error case.
    | ByteString -> Bool
S.null ByteString
b = forall a. Monoid a => a
mempty
paxParser ByteString
b = [(ByteString, ByteString)] -> ByteString -> PaxHeader
paxParser' [] ByteString
b
  where
    paxParser' :: [(ByteString, ByteString)] -> ByteString -> PaxHeader
    paxParser' :: [(ByteString, ByteString)] -> ByteString -> PaxHeader
paxParser' [(ByteString, ByteString)]
l ByteString
b0
        | ByteString -> Bool
S.null ByteString
b0 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ByteString, ByteString)]
l
    paxParser' [(ByteString, ByteString)]
l ByteString
b0 =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\((ByteString, ByteString)
pair, ByteString
b1) -> [(ByteString, ByteString)] -> ByteString -> PaxHeader
paxParser' ((ByteString, ByteString)
pairforall a. a -> [a] -> [a]
:[(ByteString, ByteString)]
l) ByteString
b1) (ByteString -> Maybe ((ByteString, ByteString), ByteString)
recordParser ByteString
b0)

-- | A record in a pax extended header has format:
--
-- "%d %s=%s\n", <length>, <keyword>, <value>
--
-- If the record does not parse @(<keyword>, <value>)@, yields 'Nothing'.
recordParser :: ByteString -> Maybe ((ByteString, ByteString), ByteString)
recordParser :: ByteString -> Maybe ((ByteString, ByteString), ByteString)
recordParser ByteString
b0 = do
    let (ByteString
nb, ByteString
b1) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.span Word8 -> Bool
isDecimal ByteString
b0
    Int
n <- forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
nb) (forall i. Integral i => ByteString -> i
parseDecimal ByteString
nb)
    ByteString
b2 <- (Word8 -> Bool) -> ByteString -> Maybe ByteString
skip Word8 -> Bool
isSpace ByteString
b1
    let (ByteString
k, ByteString
b3) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isEquals) ByteString
b2
    ByteString
b4 <- (Word8 -> Bool) -> ByteString -> Maybe ByteString
skip Word8 -> Bool
isEquals ByteString
b3
    let (ByteString
v, ByteString
b5) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
nb forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
k forall a. Num a => a -> a -> a
- Int
3) ByteString
b4
    ByteString
b6 <- (Word8 -> Bool) -> ByteString -> Maybe ByteString
skip Word8 -> Bool
isNewline ByteString
b5
    forall a. a -> Maybe a
Just ((ByteString
k, ByteString
v), ByteString
b6)
  where
    newline :: Word8
newline = Word8
0x0a -- UTF-8 '\n'
    equals :: Word8
equals = Word8
0x3d -- UTF-8 '='
    toMaybe :: Bool -> a -> Maybe a
    toMaybe :: forall a. Bool -> a -> Maybe a
toMaybe Bool
False a
_ = forall a. Maybe a
Nothing
    toMaybe Bool
True a
x = forall a. a -> Maybe a
Just a
x
    skip :: (Word8 -> Bool) -> ByteString -> Maybe ByteString
skip Word8 -> Bool
p ByteString
b = do
        (Word8
w, ByteString
b') <- ByteString -> Maybe (Word8, ByteString)
S.uncons ByteString
b
        if Word8 -> Bool
p Word8
w then forall a. a -> Maybe a
Just ByteString
b' else forall a. Maybe a
Nothing
    isSpace :: Word8 -> Bool
isSpace = (forall i. Integral i => i
space forall a. Eq a => a -> a -> Bool
==)
    isEquals :: Word8 -> Bool
isEquals = (Word8
equals forall a. Eq a => a -> a -> Bool
==)
    isNewline :: Word8 -> Bool
isNewline = (Word8
newline forall a. Eq a => a -> a -> Bool
==)

parseDecimal :: Integral i => ByteString -> i
parseDecimal :: forall i. Integral i => ByteString -> i
parseDecimal = forall i. Integral i => i -> ByteString -> i
parseBase i
10

isDecimal :: Word8 -> Bool
isDecimal :: Word8 -> Bool
isDecimal Word8
w = Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
zero Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
nine
  where
    nine :: Word8
nine = Word8
0x39 -- UTF-8 '9'

-- | Just like `untar`, except that each `FileInfo` handling function can produce a finalizing
-- action, all of which will be executed after the whole tarball has been processed in the opposite
-- order. Very useful with `restoreFile` and `restoreFileInto`, since they restore direcory
-- modification timestamps only after files have been fully written to disk.
--
-- @since 0.2.0
untarWithFinalizers ::
       (MonadThrow m, MonadIO m)
    => (FileInfo -> ConduitM ByteString (IO ()) m ())
    -> ConduitM ByteString c m ()
untarWithFinalizers :: forall (m :: * -> *) c.
(MonadThrow m, MonadIO m) =>
(FileInfo -> ConduitM ByteString (IO ()) m ())
-> ConduitM ByteString c m ()
untarWithFinalizers FileInfo -> ConduitM ByteString (IO ()) m ()
inner = do
    IO ()
finilizers <- forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untar FileInfo -> ConduitM ByteString (IO ()) m ()
inner forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
finilizers


-- | Same as `untarWithFinalizers`, but will also produce a list of any exceptions that might have
-- occured during restoration process.
--
-- @since 0.2.5
untarWithExceptions ::
       (MonadThrow m, MonadIO m)
    => (FileInfo -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> ConduitM ByteString c m [(FileInfo, [SomeException])]
untarWithExceptions :: forall (m :: * -> *) c.
(MonadThrow m, MonadIO m) =>
(FileInfo
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
untarWithExceptions FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
inner = do
    IO [(FileInfo, [SomeException])]
finalizers <- forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untar FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
inner forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
C.foldMapC (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(FileInfo, [SomeException])]
finalizers


--------------------------------------------------------------------------------
-- Create a tar file -----------------------------------------------------------
--------------------------------------------------------------------------------

gnuTarMagicVersion :: ShortByteString
gnuTarMagicVersion :: ShortByteString
gnuTarMagicVersion = ByteString -> ShortByteString
toShort (FilePath -> ByteString
S8.pack FilePath
"ustar  \NUL")

ustarMagicVersion :: ShortByteString
ustarMagicVersion :: ShortByteString
ustarMagicVersion = ByteString -> ShortByteString
toShort (FilePath -> ByteString
S8.pack FilePath
"ustar\NUL00")

blockSize :: FileOffset
blockSize :: FileOffset
blockSize = FileOffset
512

terminatorBlock :: ByteString
terminatorBlock :: ByteString
terminatorBlock = Int -> Word8 -> ByteString
S.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset
2 forall a. Num a => a -> a -> a
* FileOffset
blockSize)) Word8
0

defHeader :: FileOffset -> Header
defHeader :: FileOffset -> Header
defHeader FileOffset
offset = Header
          { headerOffset :: FileOffset
headerOffset = FileOffset
offset
          , headerPayloadOffset :: FileOffset
headerPayloadOffset = FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
512
          , headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ShortByteString
SS.empty
          , headerFileMode :: CMode
headerFileMode = CMode
0o644
          , headerOwnerId :: UserID
headerOwnerId = UserID
0
          , headerGroupId :: GroupID
headerGroupId = GroupID
0
          , headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
0
          , headerTime :: EpochTime
headerTime = EpochTime
0
          , headerLinkIndicator :: Word8
headerLinkIndicator = Word8
0
          , headerLinkName :: ShortByteString
headerLinkName = ShortByteString
SS.empty
          , headerMagicVersion :: ShortByteString
headerMagicVersion = ShortByteString
ustarMagicVersion
          , headerOwnerName :: ShortByteString
headerOwnerName = ShortByteString
"root"
          , headerGroupName :: ShortByteString
headerGroupName = ShortByteString
"root"
          , headerDeviceMajor :: DeviceID
headerDeviceMajor = DeviceID
0
          , headerDeviceMinor :: DeviceID
headerDeviceMinor = DeviceID
0
          , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = ShortByteString
SS.empty
          }


headerFromFileInfo ::
       MonadThrow m
    => FileOffset -- ^ Starting offset within the tarball. Must be multiple of 512, otherwise error.
    -> FileInfo -- ^ File info.
    -> m (Either TarCreateException Header)
headerFromFileInfo :: forall (m :: * -> *).
MonadThrow m =>
FileOffset -> FileInfo -> m (Either TarCreateException Header)
headerFromFileInfo FileOffset
offset FileInfo
fi = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileOffset
offset forall a. Integral a => a -> a -> a
`mod` FileOffset
512 forall a. Eq a => a -> a -> Bool
== FileOffset
0) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
        FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
        FilePath
"<headerFromFileInfo>: Offset must always be a multiple of 512 for file: " forall a. [a] -> [a] -> [a]
++
        FileInfo -> FilePath
getFileInfoPath FileInfo
fi
    let (ShortByteString
prefix, ShortByteString
suffix) = Int -> ByteString -> (ShortByteString, ShortByteString)
splitPathAt Int
100 forall a b. (a -> b) -> a -> b
$ FileInfo -> ByteString
filePath FileInfo
fi
    if ShortByteString -> Int
SS.length ShortByteString
prefix forall a. Ord a => a -> a -> Bool
> Int
155 Bool -> Bool -> Bool
|| ShortByteString -> Bool
SS.null ShortByteString
suffix
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FileInfo -> TarCreateException
FileNameTooLong FileInfo
fi
        else do
            (FileOffset
payloadSize, ShortByteString
linkName, Word8
linkIndicator) <-
                case FileInfo -> FileType
fileType FileInfo
fi of
                    FileType
FTNormal -> forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo -> FileOffset
fileSize FileInfo
fi, ShortByteString
SS.empty, Word8
48)
                    FTHardLink ByteString
ln -> forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
0, ByteString -> ShortByteString
toShort ByteString
ln, Word8
49)
                    FTSymbolicLink ByteString
ln -> forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
0, ByteString -> ShortByteString
toShort ByteString
ln, Word8
50)
                    FileType
FTDirectory -> forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
0, ShortByteString
SS.empty, Word8
53)
                    FileType
fty ->
                        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                        FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
                        FilePath
"<headerFromFileInfo>: Unsupported file type: " forall a. [a] -> [a] -> [a]
++
                        forall a. Show a => a -> FilePath
show FileType
fty forall a. [a] -> [a] -> [a]
++ FilePath
" for file: " forall a. [a] -> [a] -> [a]
++ FileInfo -> FilePath
getFileInfoPath FileInfo
fi
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                forall a b. b -> Either a b
Right
                    Header
                    { headerOffset :: FileOffset
headerOffset = FileOffset
offset
                    , headerPayloadOffset :: FileOffset
headerPayloadOffset = FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
512
                    , headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ShortByteString
suffix
                    , headerFileMode :: CMode
headerFileMode = FileInfo -> CMode
fileMode FileInfo
fi
                    , headerOwnerId :: UserID
headerOwnerId = FileInfo -> UserID
fileUserId FileInfo
fi
                    , headerGroupId :: GroupID
headerGroupId = FileInfo -> GroupID
fileGroupId FileInfo
fi
                    , headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
payloadSize
                    , headerTime :: EpochTime
headerTime = FileInfo -> EpochTime
fileModTime FileInfo
fi
                    , headerLinkIndicator :: Word8
headerLinkIndicator = Word8
linkIndicator
                    , headerLinkName :: ShortByteString
headerLinkName = ShortByteString
linkName
                    , headerMagicVersion :: ShortByteString
headerMagicVersion = ShortByteString
ustarMagicVersion
                    , headerOwnerName :: ShortByteString
headerOwnerName = ByteString -> ShortByteString
toShort forall a b. (a -> b) -> a -> b
$ FileInfo -> ByteString
fileUserName FileInfo
fi
                    , headerGroupName :: ShortByteString
headerGroupName = ByteString -> ShortByteString
toShort forall a b. (a -> b) -> a -> b
$ FileInfo -> ByteString
fileGroupName FileInfo
fi
                    , headerDeviceMajor :: DeviceID
headerDeviceMajor = DeviceID
0
                    , headerDeviceMinor :: DeviceID
headerDeviceMinor = DeviceID
0
                    , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = ShortByteString
prefix
                    }


-- | Split a file path at the @n@ mark from the end, while still keeping the
-- split as a valid path, i.e split at a path separator only.
splitPathAt :: Int -> ByteString -> (ShortByteString, ShortByteString)
splitPathAt :: Int -> ByteString -> (ShortByteString, ShortByteString)
splitPathAt Int
n ByteString
fp
    | ByteString -> Int
S.length ByteString
fp forall a. Ord a => a -> a -> Bool
<= Int
n = (ShortByteString
SS.empty, ByteString -> ShortByteString
toShort ByteString
fp)
    | Bool
otherwise =
        let sfp :: [ByteString]
sfp = (Char -> Bool) -> ByteString -> [ByteString]
S8.splitWith Char -> Bool
isPathSeparator ByteString
fp
            sepWith :: ByteString
-> (Int, [ByteString], [ByteString])
-> (Int, [ByteString], [ByteString])
sepWith ByteString
p (Int
tlen, [ByteString]
prefix', [ByteString]
suffix') =
                case ByteString -> Int
S.length ByteString
p forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
tlen of
                    Int
tlen'
                        | Int
tlen' forall a. Ord a => a -> a -> Bool
<= Int
n -> (Int
tlen', [ByteString]
prefix', ByteString
p forall a. a -> [a] -> [a]
: [ByteString]
suffix')
                    Int
tlen' -> (Int
tlen', ByteString
p forall a. a -> [a] -> [a]
: [ByteString]
prefix', [ByteString]
suffix')
            (Int
_, [ByteString]
prefix, [ByteString]
suffix) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ByteString
-> (Int, [ByteString], [ByteString])
-> (Int, [ByteString], [ByteString])
sepWith (Int
0, [], []) [ByteString]
sfp
            toShortPath :: [ByteString] -> ShortByteString
toShortPath = ByteString -> ShortByteString
toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
pathSeparatorS
        in ([ByteString] -> ShortByteString
toShortPath [ByteString]
prefix, [ByteString] -> ShortByteString
toShortPath [ByteString]
suffix)

packHeader :: MonadThrow m => Header -> m S.ByteString
packHeader :: forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header = do
    (ByteString
left, ByteString
right) <- forall (m :: * -> *).
MonadThrow m =>
Header -> m (ByteString, ByteString)
packHeaderNoChecksum Header
header
    let sumsl :: SL.ByteString -> Int
        sumsl :: ByteString -> Int
sumsl = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
SL.foldl' (\ !Int
acc !Word8
v -> Int
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v) Int
0
        checksum :: Int
checksum = ByteString -> Int
sumsl ByteString
left forall a. Num a => a -> a -> a
+ Int
32 forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
+ ByteString -> Int
sumsl ByteString
right
    Builder
encChecksum <-
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\(Int
_, Int
val) ->
                 forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                 FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
                 FilePath
"<packHeader>: Impossible happened - Checksum " forall a. [a] -> [a] -> [a]
++
                 forall a. Show a => a -> FilePath
show Int
val forall a. [a] -> [a] -> [a]
++ FilePath
" doesn't fit into header for file: " forall a. [a] -> [a] -> [a]
++ Header -> FilePath
headerFilePath Header
header)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal Int
8 Int
checksum
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
SL.toStrict forall a b. (a -> b) -> a -> b
$ ByteString
left forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
toLazyByteString Builder
encChecksum forall a. Semigroup a => a -> a -> a
<> ByteString
right

packHeaderNoChecksum :: MonadThrow m => Header -> m (SL.ByteString, SL.ByteString)
packHeaderNoChecksum :: forall (m :: * -> *).
MonadThrow m =>
Header -> m (ByteString, ByteString)
packHeaderNoChecksum h :: Header
h@Header {Word8
UserID
FileOffset
CMode
GroupID
DeviceID
EpochTime
ShortByteString
headerFileNamePrefix :: ShortByteString
headerDeviceMinor :: DeviceID
headerDeviceMajor :: DeviceID
headerGroupName :: ShortByteString
headerOwnerName :: ShortByteString
headerMagicVersion :: ShortByteString
headerLinkName :: ShortByteString
headerLinkIndicator :: Word8
headerTime :: EpochTime
headerPayloadSize :: FileOffset
headerGroupId :: GroupID
headerOwnerId :: UserID
headerFileMode :: CMode
headerFileNameSuffix :: ShortByteString
headerPayloadOffset :: FileOffset
headerOffset :: FileOffset
headerFileNamePrefix :: Header -> ShortByteString
headerDeviceMinor :: Header -> DeviceID
headerDeviceMajor :: Header -> DeviceID
headerGroupName :: Header -> ShortByteString
headerOwnerName :: Header -> ShortByteString
headerMagicVersion :: Header -> ShortByteString
headerLinkName :: Header -> ShortByteString
headerLinkIndicator :: Header -> Word8
headerTime :: Header -> EpochTime
headerPayloadSize :: Header -> FileOffset
headerGroupId :: Header -> GroupID
headerOwnerId :: Header -> UserID
headerFileMode :: Header -> CMode
headerFileNameSuffix :: Header -> ShortByteString
headerPayloadOffset :: Header -> FileOffset
headerOffset :: Header -> FileOffset
..} = do
    let CTime Int64
headerTime' = EpochTime
headerTime
        magic0 :: ShortByteString
magic0 = ShortByteString
headerMagicVersion
    (ShortByteString
magic1, Builder
hOwnerId) <- forall {m :: * -> *} {a}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic0 FilePath
"ownerId" Int
8 UserID
headerOwnerId
    (ShortByteString
magic2, Builder
hGroupId) <- forall {m :: * -> *} {a}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic1 FilePath
"groupId" Int
8 GroupID
headerGroupId
    (ShortByteString
magic3, Builder
hPayloadSize) <- forall {m :: * -> *} {a}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic2 FilePath
"payloadSize" Int
12 FileOffset
headerPayloadSize
    (ShortByteString
magic4, Builder
hTime) <- forall {m :: * -> *} {a}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic3 FilePath
"time" Int
12 Int64
headerTime'
    (ShortByteString
magic5, Builder
hDevMajor) <- forall {a} {m :: * -> *}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString -> FilePath -> a -> m (ShortByteString, Builder)
encodeDevice ShortByteString
magic4 FilePath
"Major" DeviceID
headerDeviceMajor
    (ShortByteString
magic6, Builder
hDevMinor) <- forall {a} {m :: * -> *}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString -> FilePath -> a -> m (ShortByteString, Builder)
encodeDevice ShortByteString
magic5 FilePath
"Minor" DeviceID
headerDeviceMinor
    Builder
hNameSuffix <- forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"nameSuffix" Int
100 ShortByteString
headerFileNameSuffix
    Builder
hFileMode <- forall {m :: * -> *} {a} {a} {a}.
(MonadThrow m, Show a, Show a) =>
FilePath -> Either (a, a) a -> m a
throwNumberEither FilePath
"fileMode" forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal Int
8 CMode
headerFileMode
    Builder
hLinkName <- forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"linkName" Int
100 ShortByteString
headerLinkName
    Builder
hMagicVersion <- forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"magicVersion" Int
8 ShortByteString
magic6
    Builder
hOwnerName <- forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"ownerName" Int
32 ShortByteString
headerOwnerName
    Builder
hGroupName <- forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"groupName" Int
32 ShortByteString
headerGroupName
    Builder
hNamePrefix <- forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"namePrefix" Int
155 ShortByteString
headerFileNamePrefix
    forall (m :: * -> *) a. Monad m => a -> m a
return
        ( Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$
          Builder
hNameSuffix forall a. Semigroup a => a -> a -> a
<>
          Builder
hFileMode forall a. Semigroup a => a -> a -> a
<>
          Builder
hOwnerId forall a. Semigroup a => a -> a -> a
<>
          Builder
hGroupId forall a. Semigroup a => a -> a -> a
<>
          Builder
hPayloadSize forall a. Semigroup a => a -> a -> a
<>
          Builder
hTime
        , Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$
          Word8 -> Builder
word8 Word8
headerLinkIndicator forall a. Semigroup a => a -> a -> a
<>
          Builder
hLinkName forall a. Semigroup a => a -> a -> a
<>
          Builder
hMagicVersion forall a. Semigroup a => a -> a -> a
<>
          Builder
hOwnerName forall a. Semigroup a => a -> a -> a
<>
          Builder
hGroupName forall a. Semigroup a => a -> a -> a
<>
          Builder
hDevMajor forall a. Semigroup a => a -> a -> a
<>
          Builder
hDevMinor forall a. Semigroup a => a -> a -> a
<>
          Builder
hNamePrefix forall a. Semigroup a => a -> a -> a
<>
          ByteString -> Builder
byteString (Int -> Word8 -> ByteString
S.replicate Int
12 Word8
0)
        )
  where
    encodeNumber :: ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic FilePath
field Int
len = forall {m :: * -> *} {a} {a} {a}.
(MonadThrow m, Show a, Show a) =>
FilePath -> Either (a, a) a -> m a
throwNumberEither FilePath
field forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}.
(Storable a, Bits a, Integral a) =>
ShortByteString
-> Either (Int, a) Builder
-> Either (Int, a) (ShortByteString, Builder)
fallbackHex ShortByteString
magic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal Int
len
    encodeDevice :: ShortByteString -> FilePath -> a -> m (ShortByteString, Builder)
encodeDevice ShortByteString
magic FilePath
_ a
0     = forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString
magic, ByteString -> Builder
byteString forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
S.replicate Int
8 Word8
0)
    encodeDevice ShortByteString
magic FilePath
m a
devid = forall {m :: * -> *} {a}.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic (FilePath
"device" forall a. [a] -> [a] -> [a]
++ FilePath
m) Int
8 a
devid
    fallbackHex :: ShortByteString
-> Either (Int, a) Builder
-> Either (Int, a) (ShortByteString, Builder)
fallbackHex ShortByteString
magic (Right Builder
enc)       = forall a b. b -> Either a b
Right (ShortByteString
magic, Builder
enc)
    fallbackHex ShortByteString
_     (Left (Int
len, a
val)) = (,) ShortByteString
gnuTarMagicVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Storable a, Bits a, Integral a) =>
Int -> a -> Either (Int, a) Builder
encodeHex Int
len a
val
    throwNumberEither :: FilePath -> Either (a, a) a -> m a
throwNumberEither FilePath
_     (Right a
v)         = forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    throwNumberEither FilePath
field (Left (a
len, a
val)) =
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
        FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
        FilePath
"<packHeaderNoChecksum>: Tar value overflow for file: " forall a. [a] -> [a] -> [a]
++
        Header -> FilePath
headerFilePath Header
h forall a. [a] -> [a] -> [a]
++
        FilePath
" (for field '" forall a. [a] -> [a] -> [a]
++ FilePath
field forall a. [a] -> [a] -> [a]
++ FilePath
"' with maxLen " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
len forall a. [a] -> [a] -> [a]
++ FilePath
"): " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
val


-- | Encode a number as hexadecimal with most significant bit set to 1. Returns Left if the value
-- doesn't fit in a ByteString of the supplied length, also prohibits negative numbers if precision
-- of value is higher than available length. Eg. length 8 can't reliably encoed negative numbers,
-- since MSB is already used for flagging Hex extension.
encodeHex :: (Storable a, Bits a, Integral a) =>
             Int -> a -> Either (Int, a) Builder
encodeHex :: forall a.
(Storable a, Bits a, Integral a) =>
Int -> a -> Either (Int, a) Builder
encodeHex !Int
len !a
val =
    if forall a. Bits a => a -> a
complement (forall a. Bits a => a -> a
complement a
0 forall a. Bits a => a -> Int -> a
`shiftL` Int
infoBits) forall a. Bits a => a -> a -> a
.&. a
val forall a. Eq a => a -> a -> Bool
== a
val Bool -> Bool -> Bool
&&
       Bool -> Bool
not (a
val forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
< forall a. Storable a => a -> Int
sizeOf a
val)
        then forall {a} {m :: * -> *}.
(Bits a, Integral a, Monad m) =>
Int -> a -> Builder -> m Builder
go Int
0 a
val forall a. Monoid a => a
mempty
        else forall a b. a -> Either a b
Left (Int
len, a
val)
  where
    len' :: Int
len' = Int
len forall a. Num a => a -> a -> a
- Int
1
    infoBits :: Int
infoBits = Int
len forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> a -> Builder -> m Builder
go !Int
n !a
cur !Builder
acc
        | Int
n forall a. Ord a => a -> a -> Bool
< Int
len' = Int -> a -> Builder -> m Builder
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) (a
cur forall a. Bits a => a -> Int -> a
`shiftR` Int
8) (Word8 -> Builder
word8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
cur forall a. Bits a => a -> a -> a
.&. a
0xFF)) forall a. Semigroup a => a -> a -> a
<> Builder
acc)
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Builder
word8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
cur forall a. Bits a => a -> a -> a
.&. a
0x7F) forall a. Bits a => a -> a -> a
.|. Word8
0x80) forall a. Semigroup a => a -> a -> a
<> Builder
acc)


-- | Encode a number in 8base padded with zeros and terminated with NUL.
encodeOctal :: (Integral a) =>
                Int -> a -> Either (Int, a) Builder
encodeOctal :: forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal !Int
len' !a
val
    | a
val forall a. Ord a => a -> a -> Bool
< a
0 = forall a b. a -> Either a b
Left (Int
len', a
val)
    | Bool
otherwise = forall {a}.
Integral a =>
Int -> a -> Builder -> Either (Int, a) Builder
go Int
0 a
val (Word8 -> Builder
word8 Word8
0)
  where
    !len :: Int
len = Int
len' forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> a -> Builder -> Either (Int, a) Builder
go !Int
n !a
cur !Builder
acc
        | a
cur forall a. Eq a => a -> a -> Bool
== a
0 =
            if Int
n forall a. Ord a => a -> a -> Bool
< Int
len
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (Int -> Word8 -> ByteString
S.replicate (Int
len forall a. Num a => a -> a -> a
- Int
n) Word8
48) forall a. Semigroup a => a -> a -> a
<> Builder
acc
                else forall (m :: * -> *) a. Monad m => a -> m a
return Builder
acc
        | Int
n forall a. Ord a => a -> a -> Bool
< Int
len =
            let !(a
q, a
r) = a
cur forall a. Integral a => a -> a -> (a, a)
`quotRem` a
8
            in Int -> a -> Builder -> Either (Int, a) Builder
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) a
q (Word8 -> Builder
word8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r forall a. Num a => a -> a -> a
+ Word8
48) forall a. Semigroup a => a -> a -> a
<> Builder
acc)
        | Bool
otherwise = forall a b. a -> Either a b
Left (Int
len', a
val)



-- | Encode a `ShortByteString` with an exact length, NUL terminating if it is
-- shorter, but throwing `TarCreationError` if it is longer.
encodeShort :: MonadThrow m => Header -> String -> Int -> ShortByteString -> m Builder
encodeShort :: forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
field !Int
len !ShortByteString
sbs
    | Int
lenShort forall a. Ord a => a -> a -> Bool
<= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ShortByteString -> Builder
shortByteString ShortByteString
sbs forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (Int -> Word8 -> ByteString
S.replicate (Int
len forall a. Num a => a -> a -> a
- Int
lenShort) Word8
0)
    | Bool
otherwise =
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
        FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
        FilePath
"<encodeShort>: Tar string value overflow for file: " forall a. [a] -> [a] -> [a]
++
        Header -> FilePath
headerFilePath Header
h forall a. [a] -> [a] -> [a]
++
        FilePath
" (for field '" forall a. [a] -> [a] -> [a]
++ FilePath
field forall a. [a] -> [a] -> [a]
++ FilePath
"' with maxLen " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
len forall a. [a] -> [a] -> [a]
++ FilePath
"): " forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
S8.unpack (ShortByteString -> ByteString
fromShort ShortByteString
sbs)
  where
    lenShort :: Int
lenShort = ShortByteString -> Int
SS.length ShortByteString
sbs


-- | Produce a ByteString chunk with NUL characters of the size needed to get up
-- to the next 512 byte mark in respect to the supplied offset and return that
-- offset incremented to that mark.
yieldNulPadding :: Monad m => FileOffset -> ConduitM i ByteString m FileOffset
yieldNulPadding :: forall (m :: * -> *) i.
Monad m =>
FileOffset -> ConduitM i ByteString m FileOffset
yieldNulPadding FileOffset
n = do
    let pad :: FileOffset
pad = FileOffset
blockSize forall a. Num a => a -> a -> a
- (FileOffset
n forall a. Integral a => a -> a -> a
`mod` FileOffset
blockSize)
    if FileOffset
pad forall a. Eq a => a -> a -> Bool
/= FileOffset
blockSize
        then forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Int -> Word8 -> ByteString
S.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
pad) Word8
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
n forall a. Num a => a -> a -> a
+ FileOffset
pad)
        else forall (m :: * -> *) a. Monad m => a -> m a
return FileOffset
n



-- | Handle tar payload, while validating its size and padding it to the full
-- block at the end.
tarPayload :: MonadThrow m =>
              FileOffset -- ^ Received payload size
           -> Header -- ^ Header for the file that we are currently receiving the payload for
           -> (FileOffset -> ConduitM (Either a ByteString) ByteString m FileOffset)
           -- ^ Continuation for after all payload has been received
           -> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload :: forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
size Header
header FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
cont
    | FileOffset
size forall a. Eq a => a -> a -> Bool
== Header -> FileOffset
headerPayloadSize Header
header = FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
cont (Header -> FileOffset
headerOffset Header
header forall a. Num a => a -> a -> a
+ FileOffset
blockSize)
    | Bool
otherwise = FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
go FileOffset
size
  where
    go :: FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
go FileOffset
prevSize = do
        Maybe (Either a ByteString)
eContent <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
        case Maybe (Either a ByteString)
eContent of
            Just h :: Either a ByteString
h@(Left a
_) -> do
                forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either a ByteString
h
                forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                    FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
                    FilePath
"<tarPayload>: Not enough payload for file: " forall a. [a] -> [a] -> [a]
++ Header -> FilePath
headerFilePath Header
header
            Just (Right ByteString
content) -> do
                let nextSize :: FileOffset
nextSize = FileOffset
prevSize forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
content)
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileOffset
nextSize forall a. Ord a => a -> a -> Bool
<= Header -> FileOffset
headerPayloadSize Header
header) forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                    FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
                    FilePath
"<tarPayload>: Too much payload (" forall a. [a] -> [a] -> [a]
++
                    forall a. Show a => a -> FilePath
show FileOffset
nextSize forall a. [a] -> [a] -> [a]
++ FilePath
") for file with size (" forall a. [a] -> [a] -> [a]
++
                    forall a. Show a => a -> FilePath
show (Header -> FileOffset
headerPayloadSize Header
header) forall a. [a] -> [a] -> [a]
++ FilePath
"): " forall a. [a] -> [a] -> [a]
++ Header -> FilePath
headerFilePath Header
header
                forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
content
                if FileOffset
nextSize forall a. Eq a => a -> a -> Bool
== Header -> FileOffset
headerPayloadSize Header
header
                    then do
                        FileOffset
paddedSize <- forall (m :: * -> *) i.
Monad m =>
FileOffset -> ConduitM i ByteString m FileOffset
yieldNulPadding FileOffset
nextSize
                        FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
cont (Header -> FileOffset
headerPayloadOffset Header
header forall a. Num a => a -> a -> a
+ FileOffset
paddedSize)
                    else FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
go FileOffset
nextSize
            Maybe (Either a ByteString)
Nothing ->
                forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                FilePath -> TarCreateException
TarCreationError FilePath
"<tarPayload>: Stream finished abruptly. Not enough payload."



tarHeader :: MonadThrow m =>
             FileOffset -> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader :: forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader FileOffset
offset = do
    Maybe (Either Header ByteString)
eContent <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe (Either Header ByteString)
eContent of
        Just (Right ByteString
bs) | ByteString -> Bool
S.null ByteString
bs -> forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader FileOffset
offset -- ignore empty content
        Just c :: Either Header ByteString
c@(Right ByteString
_) -> do
            forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either Header ByteString
c
            forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                FilePath -> TarCreateException
TarCreationError FilePath
"<tarHeader>: Received payload without a corresponding Header."
        Just (Left Header
header) -> do
            forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield
            forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
0 Header
header forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader
        Maybe (Either Header ByteString)
Nothing -> do
            forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
terminatorBlock
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FileOffset
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
terminatorBlock)



tarFileInfo :: MonadThrow m =>
               FileOffset -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo :: forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo FileOffset
offset = do
    Maybe (Either FileInfo ByteString)
eContent <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe (Either FileInfo ByteString)
eContent of
        Just (Right ByteString
bs)
            | ByteString -> Bool
S.null ByteString
bs -> forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo FileOffset
offset -- ignore empty content
        Just c :: Either FileInfo ByteString
c@(Right ByteString
_) -> do
            forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either FileInfo ByteString
c
            forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                FilePath -> TarCreateException
TarCreationError FilePath
"<tarFileInfo>: Received payload without a corresponding FileInfo."
        Just (Left FileInfo
fi) -> do
            Either TarCreateException Header
eHeader <- forall (m :: * -> *).
MonadThrow m =>
FileOffset -> FileInfo -> m (Either TarCreateException Header)
headerFromFileInfo FileOffset
offset FileInfo
fi
            case Either TarCreateException Header
eHeader of
                Left (FileNameTooLong FileInfo
_) -> do
                    let fPath :: ByteString
fPath = FileInfo -> ByteString
filePath FileInfo
fi
                        fPathLen :: FileOffset
fPathLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
fPath forall a. Num a => a -> a -> a
+ Int
1)
                        pad :: FileOffset
pad =
                            case FileOffset
fPathLen forall a. Integral a => a -> a -> a
`mod` FileOffset
blockSize of
                                FileOffset
0 -> FileOffset
0
                                FileOffset
x -> FileOffset
blockSize forall a. Num a => a -> a -> a
- FileOffset
x
                    Either TarCreateException Header
eHeader' <-
                        forall (m :: * -> *).
MonadThrow m =>
FileOffset -> FileInfo -> m (Either TarCreateException Header)
headerFromFileInfo
                            (FileOffset
offset forall a. Num a => a -> a -> a
+ FileOffset
blockSize forall a. Num a => a -> a -> a
+ FileOffset
fPathLen forall a. Num a => a -> a -> a
+ FileOffset
pad)
                            (FileInfo
fi {filePath :: ByteString
filePath = Int -> ByteString -> ByteString
S.take Int
100 ByteString
fPath})
                    Header
header <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (m :: * -> *) a. Monad m => a -> m a
return Either TarCreateException Header
eHeader'
                    ByteString
pHeader <- forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header
                    ByteString
pFileNameHeader <-
                        forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader forall a b. (a -> b) -> a -> b
$
                        (FileOffset -> Header
defHeader FileOffset
offset)
                        { headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ShortByteString
"././@LongLink"
                        , headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
fPathLen
                        , headerLinkIndicator :: Word8
headerLinkIndicator = Word8
76 -- 'L'
                        , headerMagicVersion :: ShortByteString
headerMagicVersion = ShortByteString
gnuTarMagicVersion
                        }
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
pFileNameHeader
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
fPath
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
S.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
pad forall a. Num a => a -> a -> a
+ Int
1) Word8
0
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
pHeader
                    forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
0 Header
header forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo
                Left TarCreateException
exc -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarCreateException
exc
                Right Header
header -> do
                    forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield
                    forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
0 Header
header forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo
        Maybe (Either FileInfo ByteString)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return FileOffset
offset



-- | Create a tar archive by suppying a stream of `Left` `FileInfo`s. Whenever a
-- file type is `FTNormal`, it must be immediately followed by its content as
-- `Right` `ByteString`. The produced `ByteString` is in the raw tar format and
-- is properly terminated at the end, therefore it can not be extended
-- afterwards. Returned is the total size of the bytestring as a `FileOffset`.
--
-- @since 0.2.0
tar :: MonadThrow m =>
       ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tar :: forall (m :: * -> *).
MonadThrow m =>
ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tar = do
    FileOffset
offset <- forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo FileOffset
0
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
terminatorBlock
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FileOffset
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
terminatorBlock)


-- | Just like `tar`, except gives you the ability to work at a lower `Header`
-- level, versus more user friendly `FileInfo`. A deeper understanding of tar
-- format is necessary in order to work directly with `Header`s.
--
-- @since 0.2.0
tarEntries :: MonadThrow m =>
              ConduitM (Either Header ByteString) ByteString m FileOffset
tarEntries :: forall (m :: * -> *).
MonadThrow m =>
ConduitM (Either Header ByteString) ByteString m FileOffset
tarEntries = do
    FileOffset
offset <- forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader FileOffset
0
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
terminatorBlock
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FileOffset
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
terminatorBlock)



-- | Turn a stream of file paths into a stream of `FileInfo` and file
-- content. All paths will be decended into recursively.
--
-- @since 0.2.0
filePathConduit :: (MonadThrow m, MonadResource m) =>
                   ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit :: forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit = do
    Maybe FilePath
mfp <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe FilePath
mfp of
        Just FilePath
fp -> do
            FileInfo
fi <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileInfo
getFileInfo FilePath
fp
            case FileInfo -> FileType
fileType FileInfo
fi of
                FileType
FTNormal -> do
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (forall a b. a -> Either a b
Left FileInfo
fi)
                    forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFile (FileInfo -> FilePath
getFileInfoPath FileInfo
fi) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC forall a b. b -> Either a b
Right
                FTSymbolicLink ByteString
_ -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (forall a b. a -> Either a b
Left FileInfo
fi)
                FileType
FTDirectory -> do
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (forall a b. a -> Either a b
Left FileInfo
fi)
                    forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i FilePath m ()
sourceDirectory (FileInfo -> FilePath
getFileInfoPath FileInfo
fi) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit
                FileType
fty -> do
                    forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover FilePath
fp
                    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                        FilePath -> TarCreateException
TarCreationError forall a b. (a -> b) -> a -> b
$
                        FilePath
"<filePathConduit>: Unsupported file type: " forall a. [a] -> [a] -> [a]
++
                        forall a. Show a => a -> FilePath
show FileType
fty forall a. [a] -> [a] -> [a]
++ FilePath
" for file: " forall a. [a] -> [a] -> [a]
++ FileInfo -> FilePath
getFileInfoPath FileInfo
fi
            forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit
        Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | Recursively tar all of the files and directories. There will be no
-- conversion between relative and absolute paths, so just like with GNU @tar@
-- cli tool, it may be necessary to `setCurrentDirectory` in order to get the
-- paths relative. Using `filePathConduit` directly, while modifying the
-- `filePath`, would be another approach to handling the file paths.
--
-- @since 0.2.0
tarFilePath :: (MonadThrow m, MonadResource m) => ConduitM FilePath ByteString m FileOffset
tarFilePath :: forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath ByteString m FileOffset
tarFilePath = forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
MonadThrow m =>
ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tar


-- | Uses `tarFilePath` to create a tarball, that will recursively include the
-- supplied list of all the files and directories
--
-- @since 0.2.0
createTarball :: FilePath -- ^ File name for the tarball
              -> [FilePath] -- ^ List of files and directories to include in the tarball
              -> IO ()
createTarball :: FilePath -> [FilePath] -> IO ()
createTarball FilePath
tarfp [FilePath]
dirs =
    forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [FilePath]
dirs forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath ByteString m FileOffset
tarFilePath forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
tarfp

-- | Take a list of files and paths, recursively tar them and write output into supplied handle.
--
-- @since 0.2.0
writeTarball :: Handle -- ^ Handle where created tarball will be written to
             -> [FilePath] -- ^ List of files and directories to include in the tarball
             -> IO ()
writeTarball :: Handle -> [FilePath] -> IO ()
writeTarball Handle
tarHandle [FilePath]
dirs =
    forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [FilePath]
dirs forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath ByteString m FileOffset
tarFilePath forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
sinkHandle Handle
tarHandle


-- always use forward slash, see
-- https://github.com/snoyberg/tar-conduit/issues/21
pathSeparatorS :: ByteString
pathSeparatorS :: ByteString
pathSeparatorS = ByteString
"/" -- S8.singleton pathSeparator


fileInfoFromHeader :: Header -> FileInfo
fileInfoFromHeader :: Header -> FileInfo
fileInfoFromHeader header :: Header
header@Header {Word8
UserID
FileOffset
CMode
GroupID
DeviceID
EpochTime
ShortByteString
headerFileNamePrefix :: ShortByteString
headerDeviceMinor :: DeviceID
headerDeviceMajor :: DeviceID
headerGroupName :: ShortByteString
headerOwnerName :: ShortByteString
headerMagicVersion :: ShortByteString
headerLinkName :: ShortByteString
headerLinkIndicator :: Word8
headerTime :: EpochTime
headerPayloadSize :: FileOffset
headerGroupId :: GroupID
headerOwnerId :: UserID
headerFileMode :: CMode
headerFileNameSuffix :: ShortByteString
headerPayloadOffset :: FileOffset
headerOffset :: FileOffset
headerFileNamePrefix :: Header -> ShortByteString
headerDeviceMinor :: Header -> DeviceID
headerDeviceMajor :: Header -> DeviceID
headerGroupName :: Header -> ShortByteString
headerOwnerName :: Header -> ShortByteString
headerMagicVersion :: Header -> ShortByteString
headerLinkName :: Header -> ShortByteString
headerLinkIndicator :: Header -> Word8
headerTime :: Header -> EpochTime
headerPayloadSize :: Header -> FileOffset
headerGroupId :: Header -> GroupID
headerOwnerId :: Header -> UserID
headerFileMode :: Header -> CMode
headerFileNameSuffix :: Header -> ShortByteString
headerPayloadOffset :: Header -> FileOffset
headerOffset :: Header -> FileOffset
..} =
    FileInfo
    { filePath :: ByteString
filePath = Header -> ByteString
headerFilePathBS Header
header
    , fileUserId :: UserID
fileUserId = UserID
headerOwnerId
    , fileUserName :: ByteString
fileUserName = ShortByteString -> ByteString
fromShort ShortByteString
headerOwnerName
    , fileGroupId :: GroupID
fileGroupId = GroupID
headerGroupId
    , fileGroupName :: ByteString
fileGroupName = ShortByteString -> ByteString
fromShort ShortByteString
headerGroupName
    , fileMode :: CMode
fileMode = CMode
headerFileMode
    , fileSize :: FileOffset
fileSize = FileOffset
headerPayloadSize
    , fileType :: FileType
fileType = Header -> FileType
headerFileType Header
header
    , fileModTime :: EpochTime
fileModTime = EpochTime
headerTime
    }


-- | Extract a tarball while using `restoreFileInfo` for writing files onto the file
-- system. Restoration process is cross platform and should work concistently both on Windows and
-- Posix systems.
--
-- @since 0.2.0
extractTarball :: FilePath -- ^ Filename for the tarball
               -> Maybe FilePath -- ^ Folder where tarball should be extract
                                 -- to. Default is the current path
               -> IO ()
extractTarball :: FilePath -> Maybe FilePath -> IO ()
extractTarball FilePath
tarfp Maybe FilePath
mcd = do
    FilePath
cd <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getCurrentDirectory forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mcd
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cd
    forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFileBS FilePath
tarfp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) c.
(MonadThrow m, MonadIO m) =>
(FileInfo -> ConduitM ByteString (IO ()) m ())
-> ConduitM ByteString c m ()
untarWithFinalizers (forall (m :: * -> *).
MonadResource m =>
FilePath -> FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFileInto FilePath
cd)


prependDirectory :: FilePath -> FileInfo -> FileInfo
prependDirectory :: FilePath -> FileInfo -> FileInfo
prependDirectory FilePath
cd FileInfo
fi = FileInfo
fi {filePath :: ByteString
filePath = FilePath -> ByteString
prependDir forall a b. (a -> b) -> a -> b
$ FileInfo -> FilePath
getFileInfoPath FileInfo
fi,
                             fileType :: FileType
fileType = FileType -> FileType
prependDirIfNeeded (FileInfo -> FileType
fileType FileInfo
fi)}
  where
    -- Hard links need to be interpreted based on `cd`, not just CWD, if relative,
    -- otherwise they may point to some invalid location.
    prependDirIfNeeded :: FileType -> FileType
prependDirIfNeeded (FTHardLink ByteString
p)
        | FilePath -> Bool
isRelative forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
decodeFilePath ByteString
p = ByteString -> FileType
FTHardLink (FilePath -> ByteString
prependDir forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
decodeFilePath ByteString
p)
    prependDirIfNeeded FileType
other            = FileType
other
    prependDir :: FilePath -> ByteString
prependDir FilePath
p                        = FilePath -> ByteString
encodeFilePath (FilePath
cd FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
p)


-- | Restore all files into a folder. Absolute file paths will be turned into
-- relative to the supplied folder.
restoreFileInto :: MonadResource m =>
                   FilePath -> FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFileInto :: forall (m :: * -> *).
MonadResource m =>
FilePath -> FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFileInto FilePath
cd = forall (m :: * -> *).
MonadResource m =>
FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FileInfo -> FileInfo
prependDirectory FilePath
cd

-- | Restore all files into a folder. Absolute file paths will be turned into relative to the
-- supplied folder. Yields a list with exceptions instead of throwing them.
--
-- @since 0.2.5
restoreFileIntoLenient :: MonadResource m =>
    FilePath -> FileInfo -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileIntoLenient :: forall (m :: * -> *).
MonadResource m =>
FilePath
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileIntoLenient FilePath
cd = forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FileInfo -> FileInfo
prependDirectory FilePath
cd

-- | Same as `extractTarball`, but ignores possible extraction errors. It can still throw a
-- `TarException` if the tarball is corrupt or malformed.
--
-- @since 0.2.5
extractTarballLenient :: FilePath -- ^ Filename for the tarball
                   -> Maybe FilePath -- ^ Folder where tarball should be extract
                   -- to. Default is the current path
                   -> IO [(FileInfo, [SomeException])]
extractTarballLenient :: FilePath -> Maybe FilePath -> IO [(FileInfo, [SomeException])]
extractTarballLenient FilePath
tarfp Maybe FilePath
mcd = do
    FilePath
cd <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getCurrentDirectory forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mcd
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cd
    forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFileBS FilePath
tarfp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) c.
(MonadThrow m, MonadIO m) =>
(FileInfo
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
untarWithExceptions (forall (m :: * -> *).
MonadResource m =>
FilePath
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileIntoLenient FilePath
cd)



-- | Restore files onto the file system. Produces actions that will set the modification time on the
-- directories, which can be executed after the pipeline has finished and all files have been
-- written to disk.
restoreFile :: (MonadResource m) =>
               FileInfo -> ConduitM S8.ByteString (IO ()) m ()
restoreFile :: forall (m :: * -> *).
MonadResource m =>
FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFile FileInfo
fi = forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors Bool
False FileInfo
fi forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC forall (f :: * -> *) a. Functor f => f a -> f ()
void


-- | Restore files onto the file system, much in the same way `restoreFile` does it, except with
-- ability to ignore restoring problematic files and report errors that occured as a list of
-- exceptions, which will be returned as a list when finilizer executed. If a list is empty, it
-- means, that no errors occured and a file only had a finilizer associated with it.
--
-- @since 0.2.4
restoreFileWithErrors ::
       (MonadResource m)
    => Bool -- ^ Lenient flag, results in exceptions thrown instead of collected when set to @False@.
    -> FileInfo
    -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors :: forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors = forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileInternal