tar-conduit-0.4.1/src/0000755000000000000000000000000014445727612012736 5ustar0000000000000000tar-conduit-0.4.1/src/Data/0000755000000000000000000000000014445727612013607 5ustar0000000000000000tar-conduit-0.4.1/src/Data/Conduit/0000755000000000000000000000000014546273416015214 5ustar0000000000000000tar-conduit-0.4.1/src/Data/Conduit/Tar/0000755000000000000000000000000014464101016015723 5ustar0000000000000000tar-conduit-0.4.1/tests/0000755000000000000000000000000014546273416013311 5ustar0000000000000000tar-conduit-0.4.1/tests/files/0000755000000000000000000000000014464101016014374 5ustar0000000000000000tar-conduit-0.4.1/src/Data/Conduit/Tar.hs0000644000000000000000000013016314546273416016302 0ustar0000000000000000{-# 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 #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty) #endif 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 {..} = if SS.null headerFileNamePrefix then fromShort headerFileNameSuffix else S.concat [fromShort headerFileNamePrefix, pathSeparatorS, fromShort headerFileNameSuffix] -- | Construct a `FilePath` from `headerFileNamePrefix` and `headerFileNameSuffix`. -- -- @since 0.1.0 headerFilePath :: Header -> FilePath headerFilePath = decodeFilePath . headerFilePathBS -- | Get Header file type. -- -- @since 0.1.0 headerFileType :: Header -> FileType headerFileType h = case headerLinkIndicator h of 0 -> FTNormal 48 -> FTNormal 49 -> FTHardLink (fromShort (headerLinkName h)) 50 -> FTSymbolicLink (fromShort (headerLinkName h)) 51 -> FTCharacterSpecial 52 -> FTBlockSpecial 53 -> FTDirectory 54 -> FTFifo x -> FTOther x parseHeader :: FileOffset -> ByteString -> Either TarException Header parseHeader offset bs = do unless (S.length bs == 512) $ Left $ IncompleteHeader offset let checksumBytes = BU.unsafeTake 8 $ BU.unsafeDrop 148 bs expectedChecksum = parseOctal checksumBytes actualChecksum = bsum bs - bsum checksumBytes + 8 * space magicVersion = toShort $ BU.unsafeTake 8 $ BU.unsafeDrop 257 bs getNumber :: (Storable a, Bits a, Integral a) => Int -> Int -> a getNumber = if magicVersion == gnuTarMagicVersion then getHexOctal else getOctal unless (actualChecksum == expectedChecksum) (Left (BadChecksum offset)) return Header { headerOffset = offset , headerPayloadOffset = offset + 512 , headerFileNameSuffix = getShort 0 100 , headerFileMode = getOctal 100 8 , headerOwnerId = getNumber 108 8 , headerGroupId = getNumber 116 8 , headerPayloadSize = getNumber 124 12 , headerTime = CTime $ getNumber 136 12 , headerLinkIndicator = BU.unsafeIndex bs 156 , headerLinkName = getShort 157 100 , headerMagicVersion = magicVersion , headerOwnerName = getShort 265 32 , headerGroupName = getShort 297 32 , headerDeviceMajor = getNumber 329 8 , headerDeviceMinor = getNumber 337 8 , headerFileNamePrefix = getShort 345 155 } where bsum :: ByteString -> Int bsum = S.foldl' (\c n -> c + fromIntegral n) 0 getShort off len = toShort $ S.takeWhile (/= 0) $ BU.unsafeTake len $ BU.unsafeDrop off bs getOctal :: Integral a => Int -> Int -> a getOctal off len = parseOctal $ BU.unsafeTake len $ BU.unsafeDrop off 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 off len = if BU.unsafeIndex bs off .&. 0x80 == 0x80 then fromHex $ BU.unsafeTake len $ BU.unsafeDrop off bs else getOctal off len parseOctal :: Integral i => ByteString -> i parseOctal = parseBase 8 . S.takeWhile (\c -> zero <= c && c <= seven) . S.dropWhile (== space) seven = 55 parseBase :: Integral i => i -> ByteString -> i parseBase n = S.foldl' (\t c -> t * n + fromIntegral (c - zero)) 0 space :: Integral i => i space = 0x20 -- UTF-8 ' ' zero :: Word8 zero = 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 str = S.foldl' (\ acc x -> (acc `shiftL` 8) .|. fromIntegral x) 0 $ S.drop (max 0 (S.length str - sizeOf (undefined :: a))) 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 = untarChunksRaw .| evalStateLC initialPaxState 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 = loop 0 where loop !offset = assert (offset `mod` 512 == 0) $ do bs <- takeCE 512 .| foldC case S.length bs of 0 -> return () 512 | S.all (== 0) bs -> do let offset' = offset + 512 bs' <- takeCE 512 .| foldC case () of () | S.length bs' /= 512 -> do leftover bs' yield $ ChunkException $ ShortTrailer offset' | S.all (== 0) bs' -> return () | otherwise -> do leftover bs' yield $ ChunkException $ BadTrailer offset' 512 -> case parseHeader offset bs of Left e -> do leftover bs yield $ ChunkException e Right h -> do yield $ ChunkHeader h offset' <- payloads (offset + 512) $ headerPayloadSize h let expectedOffset = offset + 512 + headerPayloadSize h + (case 512 - (headerPayloadSize h `mod` 512) of 512 -> 0 x -> x) assert (offset' == expectedOffset) (loop offset') _ -> do leftover bs yield $ ChunkException $ IncompleteHeader offset payloads !offset 0 = do let padding = case offset `mod` 512 of 0 -> 0 x -> 512 - fromIntegral x takeCE padding .| sinkNull return $! offset + fromIntegral padding payloads !offset !size = do mbs <- await case mbs of Nothing -> do yield $ ChunkException $ IncompletePayload offset $ fromIntegral size return offset Just bs -> do let (x, y) = S.splitAt (fromIntegral (min size (fromIntegral (maxBound :: Int)))) bs yield $ ChunkPayload offset x let size' = size - fromIntegral (S.length x) offset' = offset + fromIntegral (S.length x) unless (S.null y) (leftover y) payloads offset' 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 inner = do mc <- await case mc of Nothing -> throwM NoMoreHeaders Just (ChunkHeader h) -> payloadsConduit .| (inner h <* sinkNull) Just x@(ChunkPayload offset _bs) -> do leftover x throwM $ UnexpectedPayload offset Just (ChunkException e) -> throwM e payloadsConduit :: MonadThrow m => ConduitM TarChunk ByteString m () payloadsConduit = do mx <- await case mx of Just (ChunkPayload _ bs) -> yield bs >> payloadsConduit Just x@ChunkHeader {} -> leftover x Just (ChunkException e) -> throwM e Nothing -> 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 = peekForever . 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: -- -- -- @since 0.2.2 withFileInfo :: MonadThrow m => (FileInfo -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m () withFileInfo inner = start where start = await >>= maybe (return ()) go go x = case x of ChunkHeader h | headerLinkIndicator h >= 55 -> if headerMagicVersion h == gnuTarMagicVersion then handleGnuTarHeader h >>= maybe start go else dropWhileC (\case ChunkPayload _ _ -> True _ -> False) >> start ChunkHeader h -> do payloadsConduit .| (inner (fileInfoFromHeader h) <* sinkNull) start ChunkPayload offset _bs -> do leftover x throwM $ UnexpectedPayload offset ChunkException e -> throwM e -- | Take care of custom GNU tar format. handleGnuTarHeader :: MonadThrow m => Header -> ConduitM TarChunk o m (Maybe TarChunk) handleGnuTarHeader h = case headerLinkIndicator h of 76 -> do let pSize = headerPayloadSize h -- guard against names that are too long in order to prevent a DoS attack on unbounded -- file names unless (0 < pSize && pSize <= 4096) $ throwM $ FileTypeError (headerPayloadOffset h) 'L' $ "Filepath is too long: " ++ show pSize longFileNameBuilder <- payloadsConduit .| foldMapC byteString let longFileName = SL.toStrict . SL.init . toLazyByteString $ longFileNameBuilder mcNext <- await case mcNext of Just (ChunkHeader nh) -> do unless (S.isPrefixOf (fromShort (headerFileNameSuffix nh)) longFileName) $ throwM $ FileTypeError (headerPayloadOffset nh) 'L' "Long filename doesn't match the original." return (Just $ ChunkHeader $ nh { headerFileNameSuffix = toShort longFileName , headerFileNamePrefix = SS.empty }) Just c@(ChunkPayload offset _) -> do leftover c throwM $ InvalidHeader offset Just (ChunkException exc) -> throwM exc Nothing -> throwM NoMoreHeaders 83 -> do payloadsConduit .| sinkNull -- discard sparse files payload -- TODO : Implement restoring of sparse files return Nothing _ -> return 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 inner = untarChunks .| withFileInfo 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 inner = untarChunksRaw .| withFileInfo 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 = awaitForever $ \i -> do state@(PaxState g x) <- lift get let updateState f = do p <- parsePax lift $ put $ f p state case i of ChunkHeader h -> case headerLinkIndicator h of -- 'g' typeflag unique to pax header block 0x67 -> updateState updateGlobal -- 'x' typeflag unique to pax header block 0x78 -> updateState updateNext -- All other typeflag _ -> do yield $ ChunkHeader $ applyPax (Map.union x g) h lift $ put $ clearNext state _ -> yield i where updateGlobal p (PaxState g x) = PaxState (Map.union p g) x updateNext p (PaxState g _) = PaxState g p clearNext = updateNext mempty -- | Only the \'comment\', \'gid\', \'gname\', \'linkpath\',\'path\', \'size\', -- \'uid\' and \'uname\' pax keywords are supported. applyPax :: PaxHeader -> Header -> Header applyPax p h = updateGid $ updateGname $ updateLinkpath $ updatePath $ updateSize $ updateUid $ updateUname h where update :: ByteString -> (ByteString -> Header -> Header) -> (Header -> Header) update k f = maybe id f (Map.lookup k p) ifValueDecimal :: Integral i => (i -> Header -> Header) -> ByteString -> (Header -> Header) ifValueDecimal f v = if S.all isDecimal v then f (parseDecimal v) else id -- There is no 'updateComment' because comments are ignored. updateGid = update "gid" $ ifValueDecimal $ \v h' -> h' { headerGroupId = v } updateGname = update "gname" $ \v h' -> h' { headerGroupName = toShort v } updateLinkpath = update "linkpath" $ \v h' -> h' { headerLinkName = toShort v } updatePath = update "path" $ \v h' -> h' { headerFileNameSuffix = toShort v, headerFileNamePrefix = mempty } updateSize = update "size" $ ifValueDecimal $ \v h' -> h' { headerPayloadSize = v } updateUid = update "uid" $ ifValueDecimal $ \v h' -> h' { headerOwnerId = v } updateUname = update "uname" $ \v h' -> h' { headerOwnerName = toShort v } parsePax :: Monad m => ConduitM TarChunk TarChunk (StateT PaxState m) PaxHeader parsePax = paxParser <$> combineChunkPayloads mempty where combineChunkPayloads bs = await >>= \case Nothing -> pure bs Just (ChunkPayload _ b) -> -- This uses <> (Data.ByteString.Internal.Type.append) rather than, say, -- [ByteString] (created in reverse order) and -- Data.ByteString.Internal.Type.concat on the reverse of the list. The -- reason for doing so is an expectation that, in practice, the pax -- extended header data will be received as a single chunk in the very -- great majority of cases and, when it is not, in the great majority of -- remaining cases it will be received as two sequential chunks. This is -- optimised for that expectation, rather than the receipt of the data in -- a large number of small chunks. combineChunkPayloads $ bs <> b Just other -> do leftover other pure bs -- | 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 b -- This is an error case. | S.null b = mempty paxParser b = paxParser' [] b where paxParser' :: [(ByteString, ByteString)] -> ByteString -> PaxHeader paxParser' l b0 | S.null b0 = Map.fromList l paxParser' l b0 = maybe mempty (\(pair, b1) -> paxParser' (pair:l) b1) (recordParser b0) -- | A record in a pax extended header has format: -- -- "%d %s=%s\n", , , -- -- If the record does not parse @(, )@, yields 'Nothing'. recordParser :: ByteString -> Maybe ((ByteString, ByteString), ByteString) recordParser b0 = do let (nb, b1) = S.span isDecimal b0 n <- toMaybe (not $ S.null nb) (parseDecimal nb) b2 <- skip isSpace b1 let (k, b3) = S.span (not . isEquals) b2 b4 <- skip isEquals b3 let (v, b5) = S.splitAt (n - S.length nb - S.length k - 3) b4 b6 <- skip isNewline b5 Just ((k, v), b6) where newline = 0x0a -- UTF-8 '\n' equals = 0x3d -- UTF-8 '=' toMaybe :: Bool -> a -> Maybe a toMaybe False _ = Nothing toMaybe True x = Just x skip p b = do (w, b') <- S.uncons b if p w then Just b' else Nothing isSpace = (space ==) isEquals = (equals ==) isNewline = (newline ==) parseDecimal :: Integral i => ByteString -> i parseDecimal = parseBase 10 isDecimal :: Word8 -> Bool isDecimal w = w >= zero && w <= nine where nine = 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 inner = do finilizers <- untar inner .| foldlC (>>) (return ()) liftIO 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 inner = do finalizers <- untar inner .| C.foldMapC (fmap pure) filter (not . null . snd) <$> liftIO finalizers -------------------------------------------------------------------------------- -- Create a tar file ----------------------------------------------------------- -------------------------------------------------------------------------------- gnuTarMagicVersion :: ShortByteString gnuTarMagicVersion = toShort (S8.pack "ustar \NUL") ustarMagicVersion :: ShortByteString ustarMagicVersion = toShort (S8.pack "ustar\NUL00") blockSize :: FileOffset blockSize = 512 terminatorBlock :: ByteString terminatorBlock = S.replicate (fromIntegral (2 * blockSize)) 0 defHeader :: FileOffset -> Header defHeader offset = Header { headerOffset = offset , headerPayloadOffset = offset + 512 , headerFileNameSuffix = SS.empty , headerFileMode = 0o644 , headerOwnerId = 0 , headerGroupId = 0 , headerPayloadSize = 0 , headerTime = 0 , headerLinkIndicator = 0 , headerLinkName = SS.empty , headerMagicVersion = ustarMagicVersion , headerOwnerName = "root" , headerGroupName = "root" , headerDeviceMajor = 0 , headerDeviceMinor = 0 , headerFileNamePrefix = 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 offset fi = do unless (offset `mod` 512 == 0) $ throwM $ TarCreationError $ ": Offset must always be a multiple of 512 for file: " ++ getFileInfoPath fi let (prefix, suffix) = splitPathAt 100 $ filePath fi if SS.length prefix > 155 || SS.null suffix then return $ Left $ FileNameTooLong fi else do (payloadSize, linkName, linkIndicator) <- case fileType fi of FTNormal -> return (fileSize fi, SS.empty, 48) FTHardLink ln -> return (0, toShort ln, 49) FTSymbolicLink ln -> return (0, toShort ln, 50) FTDirectory -> return (0, SS.empty, 53) fty -> throwM $ TarCreationError $ ": Unsupported file type: " ++ show fty ++ " for file: " ++ getFileInfoPath fi return $ Right Header { headerOffset = offset , headerPayloadOffset = offset + 512 , headerFileNameSuffix = suffix , headerFileMode = fileMode fi , headerOwnerId = fileUserId fi , headerGroupId = fileGroupId fi , headerPayloadSize = payloadSize , headerTime = fileModTime fi , headerLinkIndicator = linkIndicator , headerLinkName = linkName , headerMagicVersion = ustarMagicVersion , headerOwnerName = toShort $ fileUserName fi , headerGroupName = toShort $ fileGroupName fi , headerDeviceMajor = 0 , headerDeviceMinor = 0 , headerFileNamePrefix = 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 n fp | S.length fp <= n = (SS.empty, toShort fp) | otherwise = let sfp = S8.splitWith isPathSeparator fp sepWith p (tlen, prefix', suffix') = case S.length p + 1 + tlen of tlen' | tlen' <= n -> (tlen', prefix', p : suffix') tlen' -> (tlen', p : prefix', suffix') (_, prefix, suffix) = foldr' sepWith (0, [], []) sfp toShortPath = toShort . S8.intercalate pathSeparatorS in (toShortPath prefix, toShortPath suffix) packHeader :: MonadThrow m => Header -> m S.ByteString packHeader header = do (left, right) <- packHeaderNoChecksum header let sumsl :: SL.ByteString -> Int sumsl = SL.foldl' (\ !acc !v -> acc + fromIntegral v) 0 checksum = sumsl left + 32 * 8 + sumsl right encChecksum <- either (\(_, val) -> throwM $ TarCreationError $ ": Impossible happened - Checksum " ++ show val ++ " doesn't fit into header for file: " ++ headerFilePath header) return $ encodeOctal 8 checksum return $ SL.toStrict $ left <> toLazyByteString encChecksum <> right packHeaderNoChecksum :: MonadThrow m => Header -> m (SL.ByteString, SL.ByteString) packHeaderNoChecksum h@Header {..} = do let CTime headerTime' = headerTime magic0 = headerMagicVersion (magic1, hOwnerId) <- encodeNumber magic0 "ownerId" 8 headerOwnerId (magic2, hGroupId) <- encodeNumber magic1 "groupId" 8 headerGroupId (magic3, hPayloadSize) <- encodeNumber magic2 "payloadSize" 12 headerPayloadSize (magic4, hTime) <- encodeNumber magic3 "time" 12 headerTime' (magic5, hDevMajor) <- encodeDevice magic4 "Major" headerDeviceMajor (magic6, hDevMinor) <- encodeDevice magic5 "Minor" headerDeviceMinor hNameSuffix <- encodeShort h "nameSuffix" 100 headerFileNameSuffix hFileMode <- throwNumberEither "fileMode" $ encodeOctal 8 headerFileMode hLinkName <- encodeShort h "linkName" 100 headerLinkName hMagicVersion <- encodeShort h "magicVersion" 8 magic6 hOwnerName <- encodeShort h "ownerName" 32 headerOwnerName hGroupName <- encodeShort h "groupName" 32 headerGroupName hNamePrefix <- encodeShort h "namePrefix" 155 headerFileNamePrefix return ( toLazyByteString $ hNameSuffix <> hFileMode <> hOwnerId <> hGroupId <> hPayloadSize <> hTime , toLazyByteString $ word8 headerLinkIndicator <> hLinkName <> hMagicVersion <> hOwnerName <> hGroupName <> hDevMajor <> hDevMinor <> hNamePrefix <> byteString (S.replicate 12 0) ) where encodeNumber magic field len = throwNumberEither field . fallbackHex magic . encodeOctal len encodeDevice magic _ 0 = return (magic, byteString $ S.replicate 8 0) encodeDevice magic m devid = encodeNumber magic ("device" ++ m) 8 devid fallbackHex magic (Right enc) = Right (magic, enc) fallbackHex _ (Left (len, val)) = (,) gnuTarMagicVersion <$> encodeHex len val throwNumberEither _ (Right v) = return v throwNumberEither field (Left (len, val)) = throwM $ TarCreationError $ ": Tar value overflow for file: " ++ headerFilePath h ++ " (for field '" ++ field ++ "' with maxLen " ++ show len ++ "): " ++ show 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 !len !val = if complement (complement 0 `shiftL` infoBits) .&. val == val && not (val < 0 && len < sizeOf val) then go 0 val mempty else Left (len, val) where len' = len - 1 infoBits = len * 8 - 1 go !n !cur !acc | n < len' = go (n + 1) (cur `shiftR` 8) (word8 (fromIntegral (cur .&. 0xFF)) <> acc) | otherwise = return (word8 (fromIntegral (cur .&. 0x7F) .|. 0x80) <> acc) -- | Encode a number in 8base padded with zeros and terminated with NUL. encodeOctal :: (Integral a) => Int -> a -> Either (Int, a) Builder encodeOctal !len' !val | val < 0 = Left (len', val) | otherwise = go 0 val (word8 0) where !len = len' - 1 go !n !cur !acc | cur == 0 = if n < len then return $ byteString (S.replicate (len - n) 48) <> acc else return acc | n < len = let !(q, r) = cur `quotRem` 8 in go (n + 1) q (word8 (fromIntegral r + 48) <> acc) | otherwise = Left (len', 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 h field !len !sbs | lenShort <= len = return $ shortByteString sbs <> byteString (S.replicate (len - lenShort) 0) | otherwise = throwM $ TarCreationError $ ": Tar string value overflow for file: " ++ headerFilePath h ++ " (for field '" ++ field ++ "' with maxLen " ++ show len ++ "): " ++ S8.unpack (fromShort sbs) where lenShort = SS.length 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 n = do let pad = blockSize - (n `mod` blockSize) if pad /= blockSize then yield (S.replicate (fromIntegral pad) 0) >> return (n + pad) else return 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 size header cont | size == headerPayloadSize header = cont (headerOffset header + blockSize) | otherwise = go size where go prevSize = do eContent <- await case eContent of Just h@(Left _) -> do leftover h throwM $ TarCreationError $ ": Not enough payload for file: " ++ headerFilePath header Just (Right content) -> do let nextSize = prevSize + fromIntegral (S.length content) unless (nextSize <= headerPayloadSize header) $ throwM $ TarCreationError $ ": Too much payload (" ++ show nextSize ++ ") for file with size (" ++ show (headerPayloadSize header) ++ "): " ++ headerFilePath header yield content if nextSize == headerPayloadSize header then do paddedSize <- yieldNulPadding nextSize cont (headerPayloadOffset header + paddedSize) else go nextSize Nothing -> throwM $ TarCreationError ": Stream finished abruptly. Not enough payload." tarHeader :: MonadThrow m => FileOffset -> ConduitM (Either Header ByteString) ByteString m FileOffset tarHeader offset = do eContent <- await case eContent of Just (Right bs) | S.null bs -> tarHeader offset -- ignore empty content Just c@(Right _) -> do leftover c throwM $ TarCreationError ": Received payload without a corresponding Header." Just (Left header) -> do packHeader header >>= yield tarPayload 0 header tarHeader Nothing -> do yield terminatorBlock return $ offset + fromIntegral (S.length terminatorBlock) tarFileInfo :: MonadThrow m => FileOffset -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset tarFileInfo offset = do eContent <- await case eContent of Just (Right bs) | S.null bs -> tarFileInfo offset -- ignore empty content Just c@(Right _) -> do leftover c throwM $ TarCreationError ": Received payload without a corresponding FileInfo." Just (Left fi) -> do eHeader <- headerFromFileInfo offset fi case eHeader of Left (FileNameTooLong _) -> do let fPath = filePath fi fPathLen = fromIntegral (S.length fPath + 1) pad = case fPathLen `mod` blockSize of 0 -> 0 x -> blockSize - x eHeader' <- headerFromFileInfo (offset + blockSize + fPathLen + pad) (fi {filePath = S.take 100 fPath}) header <- either throwM return eHeader' pHeader <- packHeader header pFileNameHeader <- packHeader $ (defHeader offset) { headerFileNameSuffix = "././@LongLink" , headerPayloadSize = fPathLen , headerLinkIndicator = 76 -- 'L' , headerMagicVersion = gnuTarMagicVersion } yield pFileNameHeader yield fPath yield $ S.replicate (fromIntegral pad + 1) 0 yield pHeader tarPayload 0 header tarFileInfo Left exc -> throwM exc Right header -> do packHeader header >>= yield tarPayload 0 header tarFileInfo Nothing -> return 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 = do offset <- tarFileInfo 0 yield terminatorBlock return $ offset + fromIntegral (S.length 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 = do offset <- tarHeader 0 yield terminatorBlock return $ offset + fromIntegral (S.length 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 = do mfp <- await case mfp of Just fp -> do fi <- liftIO $ getFileInfo fp case fileType fi of FTNormal -> do yield (Left fi) sourceFile (getFileInfoPath fi) .| mapC Right FTSymbolicLink _ -> yield (Left fi) FTDirectory -> do yield (Left fi) sourceDirectory (getFileInfoPath fi) .| filePathConduit fty -> do leftover fp throwM $ TarCreationError $ ": Unsupported file type: " ++ show fty ++ " for file: " ++ getFileInfoPath fi filePathConduit Nothing -> 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 = filePathConduit .| 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 tarfp dirs = runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkFile 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 tarHandle dirs = runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkHandle tarHandle -- always use forward slash, see -- https://github.com/snoyberg/tar-conduit/issues/21 pathSeparatorS :: ByteString pathSeparatorS = "/" -- S8.singleton pathSeparator fileInfoFromHeader :: Header -> FileInfo fileInfoFromHeader header@Header {..} = FileInfo { filePath = headerFilePathBS header , fileUserId = headerOwnerId , fileUserName = fromShort headerOwnerName , fileGroupId = headerGroupId , fileGroupName = fromShort headerGroupName , fileMode = headerFileMode , fileSize = headerPayloadSize , fileType = headerFileType header , fileModTime = 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 tarfp mcd = do cd <- maybe getCurrentDirectory return mcd createDirectoryIfMissing True cd runConduitRes $ sourceFileBS tarfp .| untarWithFinalizers (restoreFileInto cd) prependDirectory :: FilePath -> FileInfo -> FileInfo prependDirectory cd fi = fi {filePath = prependDir $ getFileInfoPath fi, fileType = prependDirIfNeeded (fileType 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 (FTHardLink p) | isRelative $ decodeFilePath p = FTHardLink (prependDir $ decodeFilePath p) prependDirIfNeeded other = other prependDir p = encodeFilePath (cd makeRelative "/" 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 cd = restoreFile . prependDirectory 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 cd = restoreFileWithErrors True . prependDirectory 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 tarfp mcd = do cd <- maybe getCurrentDirectory return mcd createDirectoryIfMissing True cd runConduitRes $ sourceFileBS tarfp .| untarWithExceptions (restoreFileIntoLenient 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 fi = restoreFileWithErrors False fi .| mapC 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 = restoreFileInternal tar-conduit-0.4.1/src/Data/Conduit/Tar/Types.hs0000644000000000000000000001162214464101016017365 0ustar0000000000000000{-# LANGUAGE CPP #-} #if WINDOWS {-# LANGUAGE GeneralizedNewtypeDeriving #-} #endif -- | Module contains all the types necessary for tarball processing. module Data.Conduit.Tar.Types ( Header(..) , PaxHeader , PaxState (..) , initialPaxState , TarChunk(..) , TarException(..) , TarCreateException(..) , FileType(..) , FileInfo(..) , FileOffset , ByteCount , UserID , GroupID , DeviceID , EpochTime , CUid(..) , CGid(..) , encodeFilePath , decodeFilePath , getFileInfoPath ) where import Control.Exception (Exception) import Data.ByteString (ByteString) import Data.ByteString.Short (ShortByteString) import Data.Word import System.Posix.Types import qualified Data.ByteString.Char8 as S8 import Data.Map (Map) import Data.Text as T import Data.Text.Encoding as T import Data.Text.Encoding.Error as T #if WINDOWS import Data.Bits import Foreign.Storable newtype CUid = CUid Word32 deriving ( Bounded , Enum , Eq , Integral , Num , Ord , Read , Real , Show , Bits , Storable ) newtype CGid = CGid Word32 deriving ( Bounded , Enum , Eq , Integral , Num , Ord , Read , Real , Show , Bits , Storable ) type UserID = CUid type GroupID = CGid #endif data FileType = FTNormal | FTHardLink !ByteString | FTSymbolicLink !ByteString | FTCharacterSpecial | FTBlockSpecial | FTDirectory | FTFifo | FTOther !Word8 deriving (Show, Eq) data FileInfo = FileInfo { filePath :: !ByteString -- ^ File path. , fileUserId :: !UserID -- ^ Unix user id. , fileUserName :: !ByteString -- ^ Unix user name. , fileGroupId :: !GroupID -- ^ Unix group id. , fileGroupName :: !ByteString -- ^ Unix group name. , fileMode :: !FileMode -- ^ Unix file permissions , fileSize :: !FileOffset -- ^ File size , fileType :: !FileType -- ^ File type. `FTNormal`, `FTHardLink` (@since 0.3.0), -- `FTSymbolicLink` and `FTDirectory` are the only ones supported -- for now , fileModTime :: !EpochTime -- ^ File modification timestamp } deriving (Show, Eq) data Header = Header { headerOffset :: !FileOffset , headerPayloadOffset :: !FileOffset , headerFileNameSuffix :: !ShortByteString , headerFileMode :: !CMode , headerOwnerId :: !UserID , headerGroupId :: !GroupID , headerPayloadSize :: !FileOffset , headerTime :: !EpochTime , headerLinkIndicator :: !Word8 , headerLinkName :: !ShortByteString , headerMagicVersion :: !ShortByteString , headerOwnerName :: !ShortByteString , headerGroupName :: !ShortByteString , headerDeviceMajor :: !DeviceID , headerDeviceMinor :: !DeviceID , headerFileNamePrefix :: !ShortByteString } deriving Show -- | Type synonym representing a pax extended header. type PaxHeader = Map ByteString ByteString -- | Type representing states (global, next file) given pax extended headers. data PaxState = PaxState PaxHeader PaxHeader -- | The initial state before applying any pax extended headers. initialPaxState :: PaxState initialPaxState = PaxState mempty mempty data TarChunk = ChunkHeader Header | ChunkPayload !FileOffset !ByteString | ChunkException TarException deriving Show -- | This the the exception type that is used in this module. -- -- More constructors are susceptible to be added without bumping the major -- version of this module. data TarException = NoMoreHeaders | UnexpectedPayload !FileOffset | IncompleteHeader !FileOffset | IncompletePayload !FileOffset !ByteCount | ShortTrailer !FileOffset | BadTrailer !FileOffset | InvalidHeader !FileOffset | BadChecksum !FileOffset | FileTypeError !FileOffset !Char !String | UnsupportedType !FileType deriving Show instance Exception TarException data TarCreateException = FileNameTooLong !FileInfo | TarCreationError !String deriving Show instance Exception TarCreateException -- | Convert `FilePath` into a UTF-8 encoded `ByteString` encodeFilePath :: FilePath -> S8.ByteString encodeFilePath = T.encodeUtf8 . T.pack -- | Convert UTF-8 encoded `ByteString` back into the `FilePath`. decodeFilePath :: S8.ByteString -> FilePath decodeFilePath = T.unpack . T.decodeUtf8With T.lenientDecode -- | Get the `FilePath`. getFileInfoPath :: FileInfo -> FilePath getFileInfoPath = decodeFilePath . filePath tar-conduit-0.4.1/src/Data/Conduit/Tar/Windows.hs0000644000000000000000000000610514445727612017732 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Data.Conduit.Tar.Windows ( getFileInfo , restoreFileInternal ) where import Conduit import Control.Monad (when, unless) import Control.Exception.Safe (tryAny, SomeException, toException) import Data.Bits import qualified Data.ByteString.Char8 as S8 import Data.Conduit.Tar.Types import Data.Either (partitionEithers) import Data.Time.Clock.POSIX import Foreign.C.Types (CTime (..)) import qualified System.Directory as Dir import qualified System.PosixCompat.Files as Posix import qualified System.FilePath as FilePath getFileInfo :: FilePath -> IO FileInfo getFileInfo fp = do fs <- Posix.getSymbolicLinkStatus fp let uid = fromIntegral $ Posix.fileOwner fs gid = fromIntegral $ Posix.fileGroup fs (fType, fSize) <- case () of () | Posix.isRegularFile fs -> return (FTNormal, Posix.fileSize fs) | Posix.isDirectory fs -> return (FTDirectory, 0) | otherwise -> error $ "Unsupported file type: " ++ fp return FileInfo { filePath = encodeFilePath fp , fileUserId = uid , fileUserName = "" , fileGroupId = gid , fileGroupName = "" , fileMode = Posix.fileMode fs .&. 0o7777 , fileSize = fSize , fileType = fType , fileModTime = Posix.modificationTime fs } -- | See 'Data.Conduit.Tar.restoreFileWithErrors' for documentation restoreFileInternal :: (MonadResource m) => Bool -> FileInfo -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m () restoreFileInternal lenient fi@FileInfo {..} = do let fpStr = decodeFilePath filePath tryAnyCond action = if lenient then tryAny action else fmap Right action CTime modTimeEpoch = fileModTime modTime = posixSecondsToUTCTime (fromIntegral modTimeEpoch) restoreTimeAndMode = do eExc1 <- tryAnyCond $ Dir.setModificationTime fpStr modTime eExc2 <- tryAnyCond $ Posix.setFileMode fpStr fileMode return $! fst $ partitionEithers [eExc1, eExc2] case fileType of FTDirectory -> do excs <- liftIO $ do Dir.createDirectoryIfMissing True fpStr restoreTimeAndMode yield $ do eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>= (`when` Dir.setModificationTime fpStr modTime)) return (fi, either ((excs ++) . pure) (const excs) eExc) FTNormal -> do when lenient $ liftIO $ Dir.createDirectoryIfMissing True $ FilePath.takeDirectory fpStr sinkFile fpStr excs <- liftIO $ restoreTimeAndMode unless (null excs) $ yield $ return (fi, excs) ty -> do let exc = UnsupportedType ty unless lenient $ liftIO $ throwM exc yield $ return (fi, [toException exc]) tar-conduit-0.4.1/src/Data/Conduit/Tar/Unix.hs0000644000000000000000000001523614445727622017231 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.Conduit.Tar.Unix ( getFileInfo , restoreFileInternal ) where import Conduit hiding (throwM) import Control.Exception.Safe import Control.Monad (void, when, unless) import Data.Bits import qualified Data.ByteString.Char8 as S8 import Data.Either import Data.Conduit.Tar.Types import Foreign.C.Types (CTime (..)) import qualified System.Directory as Dir import qualified System.Posix.Files as Posix import qualified System.Posix.User as Posix import qualified System.FilePath.Posix as Posix #if MIN_VERSION_unix(2,8,0) import qualified System.Posix.User.ByteString as UBS #endif getFileInfo :: FilePath -> IO FileInfo getFileInfo fpStr = do let fp = encodeFilePath fpStr fs <- Posix.getSymbolicLinkStatus fpStr let uid = Posix.fileOwner fs gid = Posix.fileGroup fs -- Allow for username/group retrieval failure, especially useful for non-tty environment. -- Workaround for: https://ghc.haskell.org/trac/ghc/ticket/1487 -- Moreover, names are non-critical as they are not used during unarchival process #if MIN_VERSION_unix(2,8,0) euEntry :: Either IOException UBS.UserEntry <- try $ Posix.getUserEntryForID uid egEntry :: Either IOException UBS.GroupEntry <- try $ Posix.getGroupEntryForID gid let fileUserName = either (const "") UBS.userName euEntry fileGroupName = either (const "") UBS.groupName egEntry #else euEntry :: Either IOException Posix.UserEntry <- try $ Posix.getUserEntryForID uid egEntry :: Either IOException Posix.GroupEntry <- try $ Posix.getGroupEntryForID gid let fileUserName = either (const "") (S8.pack . Posix.userName) euEntry fileGroupName = either (const "") (S8.pack . Posix.groupName) egEntry #endif (fType, fSize) <- case () of () | Posix.isRegularFile fs -> return (FTNormal, Posix.fileSize fs) | Posix.isSymbolicLink fs -> do ln <- Posix.readSymbolicLink fpStr return (FTSymbolicLink (encodeFilePath ln), 0) | Posix.isCharacterDevice fs -> return (FTCharacterSpecial, 0) | Posix.isBlockDevice fs -> return (FTBlockSpecial, 0) | Posix.isDirectory fs -> return (FTDirectory, 0) | Posix.isNamedPipe fs -> return (FTFifo, 0) | otherwise -> error $ "Unsupported file type: " ++ S8.unpack fp return $! FileInfo { filePath = fp , fileUserId = uid , fileUserName = fileUserName , fileGroupId = gid , fileGroupName = fileGroupName , fileMode = Posix.fileMode fs .&. 0o7777 , fileSize = fSize , fileType = fType , fileModTime = Posix.modificationTime fs } -- | See 'Data.Conduit.Tar.restoreFileWithErrors' for documentation restoreFileInternal :: (MonadResource m) => Bool -> FileInfo -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m () restoreFileInternal lenient fi@FileInfo {..} = do let fpStr = decodeFilePath filePath tryAnyCond action = if lenient then tryAny action else fmap Right action restorePermissions = do eExc1 <- tryAnyCond $ Posix.setOwnerAndGroup fpStr fileUserId fileGroupId eExc2 <- tryAnyCond $ Posix.setFileMode fpStr fileMode return $! fst $ partitionEithers [eExc1, eExc2] -- | Catch all exceptions, but only if lenient is set to True case fileType of FTDirectory -> do excs <- liftIO $ do Dir.createDirectoryIfMissing True fpStr restorePermissions yield $ do eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>= (`when` Posix.setFileTimes fpStr fileModTime fileModTime)) return (fi, either ((excs ++) . pure) (const excs) eExc) FTSymbolicLink link -> do excs <- liftIO $ do -- Try to unlink any existing file/symlink void $ tryAny $ Posix.removeLink fpStr when lenient $ Dir.createDirectoryIfMissing True $ Posix.takeDirectory fpStr Posix.createSymbolicLink (decodeFilePath link) fpStr eExc1 <- tryAnyCond $ Posix.setSymbolicLinkOwnerAndGroup fpStr fileUserId fileGroupId #if MIN_VERSION_unix(2,7,0) -- Try best effort in setting symbolic link modification time. let CTime epochInt32 = fileModTime unixModTime = fromInteger (fromIntegral epochInt32) eExc2 <- tryAny $ Posix.setSymbolicLinkTimesHiRes fpStr unixModTime unixModTime #endif return $ fst $ partitionEithers [eExc1, eExc2] unless (null excs) $ yield (return (fi, excs)) FTHardLink link -> do excs <- liftIO $ do let linkedFp = decodeFilePath link when lenient $ do linkedFileExists <- Posix.fileExist linkedFp -- If the linked file does not exist (yet), we cannot create a hard link. -- Try to "pre-create" it. unless linkedFileExists $ do Dir.createDirectoryIfMissing True $ Posix.takeDirectory linkedFp writeFile linkedFp "" Dir.createDirectoryIfMissing True $ Posix.takeDirectory fpStr -- Try to unlink any existing file/hard link void $ tryAny $ Posix.removeLink fpStr Posix.createLink linkedFp fpStr liftIO $ do excs <- restorePermissions eExc <- tryAnyCond $ Posix.setFileTimes fpStr fileModTime fileModTime return (either ((excs ++) . pure) (const excs) eExc) unless (null excs) $ yield (return (fi, excs)) FTNormal -> do when lenient $ liftIO $ Dir.createDirectoryIfMissing True $ Posix.takeDirectory fpStr sinkFile fpStr excs <- liftIO $ do excs <- restorePermissions eExc <- tryAnyCond $ Posix.setFileTimes fpStr fileModTime fileModTime return (either ((excs ++) . pure) (const excs) eExc) unless (null excs) $ yield $ return (fi, excs) ty -> do let exc = UnsupportedType ty unless lenient $ liftIO $ throwM exc yield $ return (fi, [toException exc]) tar-conduit-0.4.1/tests/Space.hs0000644000000000000000000000704114445727612014702 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Measure space usage by the tar algo. module Main where import Conduit import Control.DeepSeq import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.Conduit.List as CL import qualified Data.Conduit.Tar as Tar import Data.Conduit.Tar.Types import Data.Monoid import GHC.Generics import System.Posix.Types import Weigh main :: IO () main = do mainWith (do setColumns [Case, Allocated, Max, Live, GCs, Check] sequence_ [ action ("tar " ++ show count ++ " files") (runConduitRes (CL.sourceList files .| void Tar.tar .| CL.sinkNull)) | count :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (concat (map (\i -> makeFileN (S8.pack (show i) <> ".txt") 10) [1 :: Int .. count])) ] sequence_ [ action ("tar file of " ++ show bytes ++ " bytes") (runConduitRes (CL.sourceList files .| void Tar.tar .| CL.sinkNull)) | bytes :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (makeFileN "file.txt" bytes) ] sequence_ [ action ("untar " ++ show count ++ " files") (runConduitRes (CL.sourceList files .| void Tar.tar .| void (Tar.untar (const (return ()))) .| CL.sinkNull)) | count :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (concat (map (\i -> makeFileN (S8.pack (show i) <> ".txt") 10) [1 :: Int .. count])) ] sequence_ [ action ("untar file of " ++ show bytes ++ " bytes") (runConduitRes (CL.sourceList files .| void Tar.tar .| void (Tar.untar (const (return ()))) .| CL.sinkNull)) | bytes :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (makeFileN "file.txt" bytes) ]) ---------------------------------------------------------------------- -- Helpers makeFileN :: ByteString -> Int -> [Either FileInfo ByteString] makeFileN fname bytes = let contents = S8.pack (take bytes (cycle "Hello Dave")) in [ Left FileInfo { filePath = fname , fileUserId = 0 , fileUserName = "test" , fileGroupId = 0 , fileGroupName = "test" , fileMode = 0 , fileSize = fromIntegral (S.length contents) , fileType = FTNormal , fileModTime = 1234 } , Right contents ] ---------------------------------------------------------------------- -- NFData helper instances. If ever these instances become available, -- these can just be removed. deriving instance Generic FileInfo instance NFData FileInfo deriving instance Generic FileType instance NFData FileType deriving instance Generic CUid instance NFData CUid deriving instance Generic COff instance NFData COff deriving instance Generic CGid instance NFData CGid deriving instance Generic CMode instance NFData CMode tar-conduit-0.4.1/tests/Spec.hs0000644000000000000000000004132214546273416014541 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Main where import Conduit import Control.Exception import Control.Monad (forM_, void, when, zipWithM_) import Data.ByteString as S import Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy.Char8 as LS8 import Data.ByteString.Short (fromShort) import Data.Conduit.List import Data.Conduit.Tar import Data.Int import Data.List (sortOn) import Data.Monoid import Prelude as P import System.Directory import qualified System.FilePath as Host import qualified System.FilePath.Posix as Posix -- always use forward slashes import System.IO import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) import Test.Hspec import Test.QuickCheck #if !MIN_VERSION_base(4,8,0) import Control.Applicative (pure, (<$>)) import Data.Word #endif import Data.Conduit.Zlib (ungzip) main :: IO () main = do hSetBuffering stdout LineBuffering let baseTmp = "tar-conduit-tests" isStack <- doesDirectoryExist ".stack-work" let testPaths = ["src", "README.md", "ChangeLog.md", "LICENSE"] #ifndef WINDOWS <> ["./tests"] -- On Windows, the 'stack test' command results in error message: -- -- uncaught exception: IOException of type PermissionDenied -- System.Win32File.read: permission denied (Permission denied) -- -- if '.stack-work' is included in the test paths. <> [".stack-work" | isStack] #else -- The package does not support symlinks on Windows. See -- Data.Conduit.Tar.Windows.getFileInfo. <> ["./tests/files"] #endif hspec $ do describe "tar/untar" $ do let tarUntarContent dir = runConduitRes $ yield dir .| void tarFilePath .| untar (const (foldC >>= yield)) .| foldC it "content" $ do c <- collectContent "src" tarUntarContent "src" `shouldReturn` c describe "tar/untar/tar" $ do around (withTempTarFiles baseTmp) $ it "structure" $ \(fpIn, hIn, outDir, fpOut) -> do writeTarball hIn testPaths hClose hIn extractTarball fpIn (Just outDir) curDir <- getCurrentDirectory finally (setCurrentDirectory outDir >> createTarball fpOut testPaths) (setCurrentDirectory curDir) tb1 <- readTarballSorted fpIn tb2 <- readTarballSorted fpOut P.length tb1 `shouldBe` P.length tb2 zipWithM_ shouldBe (fmap fst tb2) (fmap fst tb1) zipWithM_ shouldBe (fmap snd tb2) (fmap snd tb1) describe "untar" $ do around (withTempTarFiles baseTmp) $ it "create-intermediate" $ \(fpIn, hIn, outDir, fpOut) -> do hClose hIn extractTarballLenient "tests/files/subdir.tar" (Just outDir) curDir <- getCurrentDirectory collectContent (outDir Posix. "dir/subdir/") `shouldReturn` "Hello World\n" describe "ustar" ustarSpec describe "GNUtar" gnutarSpec describe "pax" paxSpec describe "unsupported headers" $ do it "associated payload is discarded" $ do contents <- readGzipTarball "./tests/files/libpq-0.3.tar.gz" let fileNames = filePath . fst <$> contents fileNames `shouldContain` [ "libpq-0.3/" , "libpq-0.3/.gitignore" , "libpq-0.3/Database/" , "libpq-0.3/Database/PQ.hsc" , "libpq-0.3/LICENSE" , "libpq-0.3/README.md" , "libpq-0.3/Setup.hs" , "libpq-0.3/libpq.cabal" ] defFileInfo :: FileInfo defFileInfo = FileInfo { filePath = "test-file-name" , fileUserId = 1000 , fileUserName = "test-user-name" , fileGroupId = 1000 , fileGroupName = "test-group-name" , fileMode = 0o644 , fileSize = 0 , fileType = FTNormal , fileModTime = 123456789 } fileInfoExpectation :: [(FileInfo, ByteString)] -> IO () fileInfoExpectation files = do let source = P.concat [[Left fi, Right content] | (fi, content) <- files] collectBack fi = do content <- foldC yield (fi, content) result <- runConduit $ sourceList source .| void tar .| untar collectBack .| sinkList result `shouldBe` files data GnuTarFile = GnuTarFile FileInfo (Maybe ByteString) deriving (Show, Eq) asciiGen :: Int -> Gen ByteString asciiGen n = S.pack <$> vectorOf n (frequency [(1, pure 0x2f), (20, choose (0x20, 0x7e))]) instance Arbitrary GnuTarFile where arbitrary = do filePathLen <- (`mod` 4090) <$> arbitrary filePath <- ("test-" <>) . S8.filter (/= ('\\')) <$> asciiGen filePathLen NonNegative fileUserId64 <- arbitrary let fileUserId = fromIntegral (fileUserId64 :: Int64) NonNegative fileGroupId64 <- arbitrary let fileGroupId = fromIntegral (fileGroupId64 :: Int64) fileUserNameLen <- (`mod` 32) <$> arbitrary fileUserName <- asciiGen fileUserNameLen fileGroupNameLen <- (`mod` 32) <$> arbitrary fileGroupName <- asciiGen fileGroupNameLen fileMode <- fromIntegral <$> choose (0o000 :: Word, 0o777) -- TODO: use `filePathLen` instead, once long link name 'K' is implemented linkNameLen <- (`mod` 101) <$> arbitrary fileType <- oneof [ pure FTNormal , pure FTDirectory , FTSymbolicLink <$> asciiGen linkNameLen , FTHardLink <$> asciiGen linkNameLen ] (fileSize, mContent) <- case fileType of FTNormal -> do content <- arbitraryByteString return (fromIntegral (S.length content), Just content) _ -> return (0, Nothing) fileModTime <- fromIntegral <$> (arbitrary :: Gen Int64) return (GnuTarFile FileInfo {..} mContent) arbitraryByteString :: Gen ByteString arbitraryByteString = do maxLen <- arbitrary len <- (`mod` (maxLen + 1)) <$> arbitrary genFun <- arbitrary let strGen x | x < len = Just (genFun x, x + 1) | otherwise = Nothing return $ fst $ S.unfoldrN maxLen strGen 0 fileInfoProperty :: [GnuTarFile] -> Property fileInfoProperty files = either throw (source ===) eResult where eResult = runConduit $ sourceList source .| void tar .| untar collectBack .| sinkList source = P.concat [Left fi : maybe [] ((: []) . Right) mContent | GnuTarFile fi mContent <- files] collectBack fi = do yield $ Left fi case fileType fi of FTNormal -> do content <- foldC yield $ Right content _ -> return () emptyFileInfoExpectation :: FileInfo -> IO () emptyFileInfoExpectation fi = fileInfoExpectation [(fi, "")] ustarSpec :: Spec ustarSpec = do it "minimal" $ do emptyFileInfoExpectation defFileInfo it "long file name <255" $ do emptyFileInfoExpectation $ defFileInfo {filePath = S8.pack (P.replicate 99 'f' Posix. P.replicate 99 'o')} gnutarSpec :: Spec gnutarSpec = do it "LongLink - a file with long file name" $ do emptyFileInfoExpectation $ defFileInfo { filePath = S8.pack (P.replicate 100 'f' Posix. P.replicate 100 'o' Posix. P.replicate 99 'b') } it "LongLink - multiple files with long file names" $ do fileInfoExpectation [ ( defFileInfo { filePath = S8.pack (P.replicate 100 'f' Posix. P.replicate 100 'o' Posix. P.replicate 99 'b') , fileSize = 10 } , "1234567890") , ( defFileInfo { filePath = S8.pack (P.replicate 1000 'g' Posix. P.replicate 1000 'o' Posix. P.replicate 99 'b') , fileSize = 11 } , "abcxdefghij") ] it "Large User Id" $ do emptyFileInfoExpectation $ defFileInfo {fileUserId = 0o777777777} it "All Large Numeric Values" $ do emptyFileInfoExpectation $ defFileInfo { fileUserId = 0x7FFFFFFFFFFFFFFF , fileGroupId = 0x7FFFFFFFFFFFFFFF , fileModTime = fromIntegral (maxBound :: Int64) } it "Negative Values" $ do emptyFileInfoExpectation $ defFileInfo {fileModTime = fromIntegral (minBound :: Int64)} emptyFileInfoExpectation $ defFileInfo {fileModTime = -10} emptyFileInfoExpectation $ defFileInfo {fileUserId = fromIntegral (minBound :: Int64)} it "Negative Size" $ (emptyFileInfoExpectation (defFileInfo {fileSize = -10}) `shouldThrow` (\case TarCreationError _ -> True _ -> False)) it "tar/untar Property" $ property fileInfoProperty withTempTarFiles :: FilePath -> ((FilePath, Handle, FilePath, FilePath) -> IO c) -> IO c withTempTarFiles base = bracket (do tmpDir <- getTemporaryDirectory (fp1, h1) <- openBinaryTempFile tmpDir (Host.addExtension base ".tar") let outPath = Host.dropExtension fp1 ++ ".out" return (fp1, h1, outPath, Host.addExtension outPath ".tar") ) (\(fp, h, dirOut, fpOut) -> do hClose h removeFile fp doesDirectoryExist dirOut >>= (`when` removeDirectoryRecursive dirOut) doesFileExist fpOut >>= (`when` removeFile fpOut) ) -- | Collects all of the files and direcotries from the tarball. Then all of them get sorted, since -- apparently Windows has no guaranteed order the files within a directory will be listed in upon a -- tarball creation. readTarballSorted :: FilePath -> IO [(FileInfo, Maybe ByteString)] readTarballSorted fp = sortOn (filePath . fst) <$> (runConduitRes $ sourceFileBS fp .| untar grabBoth .| sinkList) readGzipTarball :: FilePath -> IO [(FileInfo, Maybe ByteString)] readGzipTarball fp = runConduitRes $ sourceFileBS fp .| ungzip .| untar grabBoth .| sinkList grabBoth :: (Monad m) => FileInfo -> ConduitM ByteString (FileInfo, Maybe ByteString) m () grabBoth fi = case fileType fi of FTNormal -> do content <- foldC yield (fi, Just content) _ -> yield (fi, Nothing) collectContent :: FilePath -> IO (ByteString) collectContent dir = runConduitRes $ sourceDirectoryDeep False dir .| mapMC (\fp -> runConduit (sourceFileBS fp .| foldC)) .| foldC -- | This test uses untar to process a simple example in the pax interchange -- format. paxSpec :: Spec paxSpec = assert payloadSizeCheck $ do it "untarChunksRaw, pax interchange format" $ do res <- runConduitRes $ paxExample .| chopEvery bigChopSize .| untarChunksRaw .| processTarChunks .| sinkList pure res `shouldReturn` [ "/pax-global-header" , "payload: 19 comment=Example\n" , "/pax-extended-header" , "payload: " <> bigPayload1 , "payload: " <> bigPayload2 , "original-dir/original-filepath" , "payload: " <> smallPayload ] it "untar, pax interchange format" $ do res <- runConduitRes $ paxExample .| chopEvery smallChopSize .| untar process .| sinkList pure res `shouldReturn` [ (veryLongFilepath, smallPayload1) , (veryLongFilepath, smallPayload2) ] it "untarRaw, pax interchange format" $ do res <- runConduitRes $ paxExample .| chopEvery smallChopSize .| untarRaw process .| sinkList pure res `shouldReturn` [ ("original-dir/original-filepath", smallPayload1) , ("original-dir/original-filepath", smallPayload2) ] where process fi = awaitForever $ \bs -> yield (filePath fi, bs) processTarChunks = awaitForever $ \tc -> yield $ case tc of ChunkHeader h -> fromShort $ headerFileNamePrefix h <> "/" <> headerFileNameSuffix h ChunkPayload _ bs -> "payload: " <> bs ChunkException e -> "exception: " <> S8.pack (show e) chopEvery :: (MonadIO m) => Int -> ConduitT ByteString ByteString m () chopEvery n = chop where chop = await >>= \case Nothing -> pure () Just val -> do forM_ (split (S.unpack val)) $ \chunk -> yield (S.pack chunk) chop split = P.takeWhile (not . P.null) . P.map (P.take n) . P.iterate (P.drop n) bigChopSize = 512 (bigPayload1, bigPayload2) = S.splitAt bigChopSize veryLongFilepathRecord smallChopSize = 4 (smallPayload1, smallPayload2) = S.splitAt smallChopSize smallPayload moreThanHalf s l = l > s && l <= 2 * s payloadSizeCheck = moreThanHalf bigChopSize (S.length veryLongFilepathRecord) && moreThanHalf smallChopSize (S.length smallPayload) -- | Produces a simple example in the pax interchange format. It has a pax -- \'global\' header block providing a comment, a pax \'next\' header block -- providing a very long path (@\"very\very\...\very\long\filepath\"@), and a -- normal file with filepath @\"original-filepath\"@ and payload @\"payload\". paxExample :: MonadThrow m => ConduitM a ByteString m () paxExample = void $ yieldMany [ Left globalHeader , Right globalPayload , Left extendedHeader , Right extendedPayload , Left ustarHeader , Right ustarPayload ] .| void tarEntries where defaultHeader :: FileOffset -> Header defaultHeader offset = Header { headerOffset = offset , headerPayloadOffset = offset + 512 , headerFileNameSuffix = mempty , headerFileMode = 0o666 , headerOwnerId = 0x0 , headerGroupId = 0x0 , headerPayloadSize = 0x0 , headerTime = 0x0 , headerLinkIndicator = 0x0 , headerLinkName = mempty , headerMagicVersion = "ustar" , headerOwnerName = "root" , headerGroupName = "root" , headerDeviceMajor = 0x0 , headerDeviceMinor = 0x0 , headerFileNamePrefix = mempty } nextOffset :: Header -> FileOffset nextOffset h = let payloadRecordCount = (headerPayloadSize h + 511) `div` 512 in headerPayloadOffset h + 512 + payloadRecordCount * 512 globalHeader = (defaultHeader 0x0) { headerFileNameSuffix = "pax-global-header" , headerPayloadSize = fromIntegral $ S.length globalPayload , headerLinkIndicator = 0x67 -- UTF-8 'g' } globalPayload = "19 comment=Example\n" extendedHeader = (defaultHeader $ nextOffset globalHeader) { headerFileNameSuffix = "pax-extended-header" , headerPayloadSize = fromIntegral $ S.length extendedPayload , headerLinkIndicator = 0x78 -- UTF-8 'x' } -- The path in the pax extended header should override the filepath -- specified in the ustar header. extendedPayload = veryLongFilepathRecord ustarHeader = (defaultHeader $ nextOffset extendedHeader) { headerFileNameSuffix = "original-filepath" , headerPayloadSize = fromIntegral $ S.length ustarPayload , headerLinkIndicator = 0x30 -- UTF-8 '0' , headerFileNamePrefix = "original-dir" } ustarPayload = smallPayload -- | A very/very/.../very/long/filepath with 653 bytes. veryLongFilepath :: ByteString veryLongFilepath = S8.toStrict (LS8.take 640 $ LS8.cycle "very/") <> "long/filepath" -- | A very, very, ..., very, long filepath record with 663 bytes. veryLongFilepathRecord :: ByteString veryLongFilepathRecord = "663 path=" <> veryLongFilepath <> "\n" -- | A small payload. smallPayload :: ByteString smallPayload = "payload" tar-conduit-0.4.1/tests/Time.hs0000644000000000000000000000704214445727612014546 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Measure time usage by the tar/untar functions. module Main where import Conduit import Control.DeepSeq import Control.Monad import Criterion.Main import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.Conduit.List as CL import qualified Data.Conduit.Tar as Tar import Data.Conduit.Tar.Types import Data.Monoid import GHC.Generics import System.Posix.Types main :: IO () main = defaultMain (concat [ [ bench ("tar " ++ show count ++ " files") (nfIO (runConduitRes (CL.sourceList files .| void Tar.tar .| CL.sinkNull))) | count :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (concat (map (\i -> makeFileN (S8.pack (show i) <> ".txt") 10) [1 :: Int .. count])) ] , [ bench ("tar file of " ++ show bytes ++ " bytes") (nfIO (runConduitRes (CL.sourceList files .| void Tar.tar .| CL.sinkNull))) | bytes :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (makeFileN "file.txt" bytes) ] , [ bench ("untar " ++ show count ++ " files") (nfIO (runConduitRes (CL.sourceList files .| void Tar.tar .| void (Tar.untar (const (return ()))) .| CL.sinkNull))) | count :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (concat (map (\i -> makeFileN (S8.pack (show i) <> ".txt") 10) [1 :: Int .. count])) ] , [ bench ("untar file of " ++ show bytes ++ " bytes") (nfIO (runConduitRes (CL.sourceList files .| void Tar.tar .| void (Tar.untar (const (return ()))) .| CL.sinkNull))) | bytes :: Int <- [1, 10, 100, 1000, 10000] , let !files = force (makeFileN "file.txt" bytes) ] ]) ---------------------------------------------------------------------- -- Helpers makeFileN :: ByteString -> Int -> [Either FileInfo ByteString] makeFileN fname bytes = let contents = S8.pack (take bytes (cycle "Hello Dave")) in [ Left FileInfo { filePath = fname , fileUserId = 0 , fileUserName = "test" , fileGroupId = 0 , fileGroupName = "test" , fileMode = 0 , fileSize = fromIntegral (S.length contents) , fileType = FTNormal , fileModTime = 1234 } , Right contents ] ---------------------------------------------------------------------- -- NFData helper instances. If ever these instances become available, -- these can just be removed. deriving instance Generic FileInfo instance NFData FileInfo deriving instance Generic FileType instance NFData FileType deriving instance Generic CUid instance NFData CUid deriving instance Generic COff instance NFData COff deriving instance Generic CGid instance NFData CGid deriving instance Generic CMode instance NFData CMode tar-conduit-0.4.1/README.md0000644000000000000000000000000014445727612013414 0ustar0000000000000000tar-conduit-0.4.1/ChangeLog.md0000644000000000000000000000565514546273416014333 0ustar0000000000000000# ChangeLog for tar-conduit ## 0.4.1 - 2024-01-06 * Fix bug in the parsing of pax extended header data when provided in more than one sequential chunk [#37](https://github.com/snoyberg/tar-conduit/issues/37) ## 0.4.0 - 2023-08-07 * `untarChunks` and `untar` now provide partial support for the pax interchange format, by applying pax header blocks and certain keywords in pax extended headers. Exposes `applyPaxChunkHeaders`. Also exposes `untarChunksRaw` and `untarRaw`, which do not apply pax header blocks and extended headers. ## 0.3.2.1 - 2023-06-25 * `unix-2.8` compatibility [#32](https://github.com/snoyberg/tar-conduit/pull/32) ## 0.3.2 - 2019-01-14 * Create a prefix directory whenever a directory type entry is missing from the tarball itself. Fixes [#26](https://github.com/snoyberg/tar-conduit/issues/26). ## 0.3.1 - 2018-11-19 * Fixed modification time restoration on Windows for read-only files [#25](https://github.com/snoyberg/tar-conduit/pull/25). ## 0.3.0 - 2018-08-28 * Support for `FTHardLink` restoration, but not creation yet. * Restoring files made even more lenient with creation of full directory path if any parents of it are missing. ## 0.2.5 - 2018-08-28 * Exported `untarWithExceptions`, `restoreFileIntoLenient` ## 0.2.4 - 2018-08-27 * Use forward slashes on Windows too, see [issue #21](https://github.com/snoyberg/tar-conduit/issues/21) * Addition of `extractTarballLenient` and `restoreFileWithErrors` ## 0.2.3.1 - 2018-06-06 * Fixed drops associated payload for unsupported headers ((https://github.com/snoyberg/tar-conduit/issues/17)) ([PR 18](https://github.com/snoyberg/tar-conduit/pull/18)) * Dropped support for GHC 7/Stack LTS-2, LTS-3, LTS-6 ## 0.2.3 - 2018-02-10 * Fixed compatibility with new `conduit >= 1.3.0` ## 0.2.2 - 2018-02-06 * Fixed proper unicode filepaths handling. * Fixed restoration of symbolic links. * Fixed restoring files with long names (>255), that use GNU tar format. * Utilizing GNU tar standard implemented support for long (>2097151) values of OwnerId, GroupId, DeviceMinor and DeviceMajor values, as well as (>8589934591) for FileSize and ModificationTime. Thus removing the 8GB size limitation, allowing negative timestamps and fixing compatibility with systems that use UID and GID in the higher range. * Expose `withFileInfo`. * Improved error reporting. ## 0.2.1 - 2018-02-03 * Expose `untarChunks` ## 0.2.0 - 2018-01-23 * Implemented tarball creation. * Introduced `FileInfo` datatype that makes it easier to work with archives by automatically handling tar specific blocks and applying them to `FileInfo`. * Full support for `ustar` format. * Support for GNU tar features: long file name. Discardes unsupported. * Helper tar/untar functions for dealing directly with the filesystem. ## 0.1.1 - 2017-05-31 * Allow checksums to have leading spaces ([PR 8](https://github.com/snoyberg/tar-conduit/pull/8)) ## 0.1.0 - 2016-11-03 * Initial release tar-conduit-0.4.1/tests/files/libpq-0.3.tar.gz0000644000000000000000000005542714445727612017164 0ustar0000000000000000L<s6[vFRVbcIdǖ_۱fs^$$v{ ݹk9~e"<^ _zӧO/bggݽOvXk\*ySR#ד]4Yb' F쉧vwOw}7O~'o{^ޕ׿(Ϟ=,pߒݽOx-?Xed!~9L} N=8%s%>a?9bU_l/g;?W^xE'{Kv;.Qe,łbfi^CE ;E"!^."Ζt\DW\|ϋؗ)]bg8`+%#{ʕ`y'fy!*ەse!.ߟD[ ^lBx^"$I A!+~D z49oD!% 8Y VPB*)A**̊Wp~a,j- 0K eCFA h?_~ӹLTEbq^c-9/0at]PÝ0RCR Ej5h0l\w7FKcd1HJs VY/Q Y7U3i)e],Lj9oE!wB)hWx0OQp*D w:o?(y/KQ* -pt!j&NN)^-2J,JT0}֫߂쭊nnyR9ʪZ)s"e=grβoj;b;5]XVoZbs趂 |F3g7摦<¤B9{в$L}^Z_ZP̴Y*d&A [Mp^DűAT˲88{r{ =p@*Y^٦XT2<jw=mGUגa:y 2z$PQўʯM 9e0NOf;>ƞ!v]yQ,Q"A_;XTq }IiED=:tY`j0S4iA/W1#?`yo5͚m=z۬жy{U!x<2s5?q)5\U)Ef1'*B&Q2dmg-'cDۂ]_9ٿ|swk%{n,0FluXia|)piEQ% * `D6B95j$Axx4@Ww9z`)j h>"՘E JQաX sg "z'rYiM NvY XLQXY*8-10'1< ;a-5T0q̨ j3n#EX =܀]"ܾ0 ]j Ċ: Hdwh)z5\67f78=-v: ɗ K`Lwv& <#աi]x֭d E O%B,uk</3s `h, vRmCfhG |D(`ܒ.HSD:T깻- Li (<4YS 0:sCãDc4M<"W|%i4zT8(rk3:&%fp鯓/ d 'ȏݽpz/|^fL47/Pv/):dߪ  q1>M Dr1nѨ)B UN6mD0H@qjAĽ*lV&JZ0g7Qx gǟB:S՜F${+\x*HuS}̠tNh4zgF2//:nt5B ^=ބqif=Rdp <6BO۸ҁ_O\{@2͑/|MEvQ (*fg=xIυOd:(FB&Ql%(b _k @Eٟ4`W%oN;:̐zhπ1f#B4^%فY<^xD|)(bۊ\,;|cCԷ:Fނ4ztD}@CfbHrLC[cw`/{tlPj~j&u)\-[Ω)4=8wJ'ѫ1z&T.B414 Q#"V.2eq!! 8]Sݲ;hχ]L[,%1]&$8 -% dsM+naItde/FU9Rf/sUD-)CPZy q.2uSn%B oaY4/jEK*IlP .'ܗ$^ D[x^#?C7MIP^01 $mXDqJ蠦0#hp5=:` -( G4s\ ħ7Jhl8_ViAWt\2L6sь^k)f-*=˳q:?ck$, bBfqS׉ eqC؆!Pb8Z 0|lxUTؗRdXd ]ɺa;;Bt@[FA<֞Jf tfїڵ9s1>?;99>}s}1?1.|q3Ͷ/'wrgr.ZT]ut+ EGb@+սj~?(N{7ayi2IΝ4cQ`00y^A54y#]) vp+We=ƶ7M;bb8xO XIM9>S9ny/ri%D>ŊӿԚ'dS$~@$19$n/͢l.Y4U7G/{gN3+ƯۤFϴTyRמigZ`5]ϛLOվ}~oصoDzM̬Gm~Mx?Ai{Ҟu=KUƎ,h3XE'^WmfS􁱤ͻ<µ`=I.0rDRT"5mPXg]aw/D|ء g4%qtۦX\N.`4*=K tFy',,bA# OfjnL'P쳥QׇCt6E؁ sWrVDXcQXc)\.DΑ#&al:%I,Ǹ]tؚتﹴ{ n ҩB,y٢6[T;tYt4~ ͉#TbSF>'D0ב:g&lhgxBx8vYm˫ aV0gR<0hiOdgmepGvͮf߻{Dj;>(nUL{`f|XSb}n2ys7Q.j;ff9Gd~#ڭ0#uMq]~ qF?i]`eQk+4@AE0k9eWll^?:4("Ҷ`M@s)3扠 {j^H]]QI?>><* V\3A s︙Kq w1qN;=xڌ3ׯzW Ļ'R(&Y[0˶m]а| Tďл:Y^yzt0͡MZ|DO[)ȉqqlz%m6/.799t o[ح$Ʈtw3k[x&'_ ^W2tZc0ݫtΞtE%pwX 6ցJP7: =Ԓ2{[<l".Eu%f/% …,چf2}ІU ~R3;aw:5"䵛O\KPUT9DumvG8l8x䶀\]Z3 W23Q<7F2X %PE] .Ἳ:v[Va嚌18';ς=#GaTzq_bmek6:wV+oeF&*9 @߷K<0p^g\ٗ.ȧ˂' vk3RKQ4 ٣qz=Ì5f ɍ51Y8il[DNeGYL`%2ۘf fy'c`i/Om:αɀMaK?ēDdqҵ& h0y^Lyv Gl)K#[`R?Q\JL8+ ^x9>JK%:XPYG |r}H%xy]ߜ`3RhZSYּ!ԉ>3TqDR,a!W1hQ^>ZiҺ;R%dJ:'uĭ>Mʛ|贛XbswJOFړas,\W~*¯O@9dC_vx4|pBA+ah=;4+cȨʨ+Vc*G*F5uF&;wHנ#(snXab Ĩ$'heD,=iQsB-*+KHl7V)- chum,O;?h2CK<;>a]œ]Y:]c@)R**xX^*ɍxNg7aݠb8@d6<2p\ųNŗF\AXoΎ>Fycuԉa>DZiS(Ҁ TNAšs~B` B! "q$(mF]ت{zly4$q[J/iwQdwK^]aHD}xd6384YHx '`.kXdŏ"eDYvS&W9zȏg`;Afzªlpj6#h.~R_tȭ=쀢ڤR"GQONN{'{FQu͚|iqn'*Z3Ñ@5oF vo%Tg֔m3IdzUrZ<+8g`bv&pmg^b=Z>gcom;TϸÖmgRgbH ai{)8Tp0ZL (eM/.kqM㥮AH`S4HڀBs8U\1j9b, d9$Csē͢k*9"]$(DRJ bW69'x`N mH&!e7c܈,hj;W$YF69q"/>CgV8i` 0 p+6A}+6"Ȣ`B-pWOeB8{Mz9)WaC]X'œWNߣUh9LIzG`t?;N=r;"[3Cas-ؙyo_y!۽5RL1'Bl,Hxf  yH8Ex t {rRu>?a"]i#<(t!X8'Z8ꯑ%ȶ6 n-("b xg%~[5^I _޶˶WW|0Z6EX^i{5ߵАmwM/IpdI;B2/_eYl>֊1m iwM<߽]:sVW.!IIt5V<| ޛѻzؠru-p|;>\/ܙ4:;92g^أVɻH !/7T[ &/`PV]xp|7;:g>%UWjaZ"Iz}~R5;[g/jb=E~59B(vX3&r% 1u|R㑃_gŊXիG⺎>'ɘ ա 'ƯH. .ޖAclƛVW]IʱrgC=2$IT8KJ yb1V@ͳ^d E8aifqy)))2 <66eϾ <-rkf Z^7"Diu]lL<>}` j$dχHBP!s /`NW7q*Ɂ |ˠ Lf'S 4cd︿oԇs'쥷{WZ9<3LJr4xE 5XL %l3{M鵔 9MJ + iT1ojt8 yQ&"6hDc]nBx?ȅ`X#XF# h |y*U<9P(Rc;?:~GﴛP@婪Ͳd+j {z'7{xX!%nh7RJ2U%x; }@o*ʼnfL# 7B7 Vj ב9Xcpv;?~Ө?׷|CgJjVFR}pU@u>9ܕG'\x*[S1ѫldmk_`1(WnxBc)v!9\#xUsTC V'ic x+ T$ah-)"]~∀*!&hÒ*‘.,~{%bbpYэ,vdFt8. G'EUN)8dacewL,A9+PuٿW9e/\2GI 3w3w7:)Ր5 }19b;"2^\Q9vbZks{9)!.b% \KX(3̯Sx_*㲀joXl9;_?rfz 4YՆKP8'snSja2bȖh2u \G.{m+gi7xOTQߌx}rϧλ-%z+7}¿>Ӷ1NiMniw+hЦ uUD"r#)LZsk@Nia~K>}8D\4BëUr&r3PCl!U':pOAB` \րe3 &潪Zi_sNJq4% Zd}mA_]9bW{J'Qn]KY8N#uy6Gk2Kiדvի1fWXdE7)fTI1  Aa4OVeg@CJ=9ؙMn҂통\T‰ؿVTTĸ.8SHdx3>Enc&HyS.\WjHG!6AB *,l0|o KR@27/3ɵ#@6t*yTx%%&oղX+Xntbq6;`+h:,:hTRר{ʹkaQ9\-X[?e]ֽ;;;;MjNkN+뚣$W氿@qsJ\VتdڪTdJbdJH]Oӭ*9.&VڪT)~xo"'cCj6xO3rX'ca"b@څx6dz2$ {Y<"F`y׺=d5|PKH%e89c35W K` mnʷ.2<;X`;w58-}Зb+xq_)IG#a*Qe=QS _qV$h< Bp.q%#`Rkr[(Pk8.(˻d?ź !Ko4+=O_OjXNMCjU/S՛Lf_<3J]n2Ѕ ~FNo6N* fD?¤ty =NM<µ| ]͎TiR` vMwE 'gةؕx3n<]e(昺珻f ;F 9O ^e5, l{ZZ(?QD3饏-}aiϨaTiWNJ@ɴLœ&iӂDc\*iV]Dn.d&&"l}+gTpŁ97QkIi?pGsQ'V.ܫY8i2 (h9?M2۳uH+nYJivXRّ-'Rx(Vyg\KB_L$`.y뫐8:j^URA۩cgհO1 '‸m{"JQ2Mތl[&-+y+oc2SJR#$\8`D; p@:F5$@ t3Gq:6,MA1OC ,|B2v?>Q%ǂ5B Dg{FƵB àʨ>L1ؘwބo{SbD/f6s_RE0F@Cj eFde'c % @N91s#ܗNc [Dl~9ݰշ:Mgl][*,6nh Ш3 )z V+*a"$zdKY"1RVzƑy`#8c\ Wc.!_3thl!TyԄԽ Cᆈ1a_qħ}:SgJұԒJFd731?1޵:gMK2]vitҐ@mM7H13uv>%԰:7f2$ߖ[kV󥱯¢I57mοS! T s??3{KtќbUu?W0oԳ<%si V2!3ƙu 24`n7g P:y[!TĥSs?Ik3J%KdTW <w}BldRvt#1/ٞXJVzb0Hq]dlXҭRsJjjKˎbW9^}ө ?nx1C 2H-?g"1ǐؼ̛|]_KP;&s  дc# lagK6ս7 2[|5=s5 fdֱ*ܺq ;ߴ"f`]X#P/T)W}LWzB>䤀N+nϟ+@xSRǫiѠU-8_HOᅙW'XГ>^mp)D]=x YM"dțv\L0|.M!8ܺa!L|}ƗHUH.#2'vaohq;fVҨ›mqT68<˺2DykbdhZmg*E?JuCݬpSQq`DҶc"AË|+ԫ.kiU5uί85($!f6"m\=:36kYr"YD?ue-<+APjX ^;.Xd\̆&"y6'Cπʣ\cq <|H̊c#ݛvAteCF#B,w+3;3WJ,P.sn0A9wOC<1H.z3kHÓ,c%2:& ) ZLr <ܱפsVwkbጵCXsjĶWUی|eF៬7){ 7Rƚ thYpFLˡIbF|՚˚t@X}A0f6{'OAzr]~x(s'=V:|@["I@rH*E@Z΂6OoնT(QWKѥ\YyLWTOa!+Oi1 `J&r\ ׈&Jyw}$Of]dfrpa9C؝5qA0܌Qjٷ(^gpOBSltϱX07eGv[JnwFK2Eb5z;ĹKQ,v[,uE \|),ŚC)U/wlW.zĺ&' %"^(:!z/Om4Mze~Zuq1Q8x0Svρl0DҐ-sGSV@᝛巯ܯfRjNT9;+a>,wU0ѸuB/9P^ FMas _"9Mfl R\ner2>!(#U@M&\Vo6o56[#d31{E]o1BfK^Z+n#=l0v `i-9_LT!ZTHWӈP2 n>7!!W~ڪ CLf~d pE|\Q,͓I.R+A(OU󃁀KT^`P(hn^5=4 ةm8'0\:,GАO!jJ۪#ek xm+(f !փsz=} / ]9sZ`H4m::d%ca# r={WʧV[,,1_\,W9\z،^;>'hJJs0Q^Q %MQyk6ي++υ*ܰpSd\xNQR!Y^@eV(؊?jZ @~i߻;=G!/AphԶUȫ*;}9^ѕ9m\M%2UɄ*Cd{drfR9[8݁.ծ)Os钷ofh֤~hX'c5u)L}bpS-pk.F;bM 1Z,$9XпE[{#)Ԝ F"Q>Y񅹪lO|t"sуݘ2C#̒(3_%̆ab6gVL9AuNObXq#oӸhv^z6&ʓ2LU1J;PLMv]̧ `Pڐ +xNۦVV}deP"<|}-K8d潇Qm>qOR0 d,̋0X蒅Gg+9ҺYmﳉiG=r\Â9ލȊ 4,b2yB'tWvaɍQd1FgE* [+8I|!;`rK{KŀՁ x!LŠLySF$xc`WlP䂘 ;WxȬhWtA`NKI6z/1f "3o߇^,Z۷ -]Zg2P-_ePƜiR2/}@g}讗$'fG!g3#u[{7mD5{XӃthcS~(w2r8R Q]?<̞J[a:S<~eu}<ͯ¿5S]uCZ$38֭]lpk~&INw-$ފvK ^Oj IO^VchޘʖALkLx~8!Cr2$yE?nFSXU;y'.E:t(S$t i5{?aIh.3A zG6vCToX3ڴ L1ڟO(L|30Dcl[fqM>!Z\KxYx7/{0qqFaŏ}k«(5ӪlKyr(Tϵ"@!o}^M+o'UYؼLlKਫ &~swonQ{y?ڗ:\wEFDoyc{[{r{+]J}eGU"p:Ћ~*hه8^ЖO^b`KyiJlXmn6فڞǷH%aWgJ9u?0lL:k3>٬8mZNiUGCw6=0<]g<_=RQ=`v!)N<$~'`m{4 q?OEA6/|_ݛ$L75%=)!hf=eq:7d&UΣ0׷M@2FY-Ճʮ㖌>NINR6͖=j pkmݍ>,2.jwZzٴTmZ_ڸV PH7nY=4[>.EO |Ww\-&ʷ)BB+K??DO_=9Sӟ7?=ݳg_ճ/(o0g Ѧem8!lq$q˧ϞvW%098Li2I!>(Kȅ.k$CC$$1J `b0#b}HHX\{s$^'*p௏p~Dl9fh,+L^ƒ\"~uAFfqz +FbzT!#&7-! $c\],%3mLYnם[Xz2v `8.4@7sSؤ_a>0q&/\'-*`I;Bl/0cƵҚ"G1zFi/2>9?D/E׽hp(z=8:l486vw.7FӨo3a'_u"i4o#Sl4`j0z;m{?a1u88mE'{itrvz2"A;MQ(;:g=訿$k,Q1 8xk]I3Hs520<ƺMwj^?JxC쫯?{ΗO9~?DKh@~?_&Qb^|(dzt6ϧY]:U=.FVd-Bvgj զkxh@g"7/H:yxf fWz4r4~p _A%SK޵Ƴ ŸbŮl,M/nE9Z5@Uč4CX/&F?n &/Nck pF!3@Md[QXޠ;Rb\D@6l6Ꮵs [Us=ٺ\y~e^]VVa`}z<(Zv6 Lӥ]5bRꕥ`=@w3{-Û|\sj [(a:k[qgw!6&rҽ*T|M%vQܭ  "axS,Qsw%\ϸ?^N[0 csc5a+sx 5 HLĜH%Ojvu?;/Cv3 7| GRhMj(1g<͟X}>^ . W[ah "Jimv[ ^%|ex]' sY{sZ-?yri;ή {G8x9YYp>-c:k{fI ~w/?!KMx5h=O?A7^(^Z:}kG ӣQ4J{h;#*f|U~y<~?y<~?y<~?y<~?:*tar-conduit-0.4.1/tests/files/subdir.tar0000644000000000000000000002400014445727612016407 0ustar0000000000000000dir/subdir/file.txt0000664000175100017510000000001413416732314015405 0ustar luispedroluispedroHello World tar-conduit-0.4.1/LICENSE0000644000000000000000000000204314445727612013153 0ustar0000000000000000Copyright (c) 2016 Michael Snoyman Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. tar-conduit-0.4.1/Setup.hs0000644000000000000000000000005614445727612013604 0ustar0000000000000000import Distribution.Simple main = defaultMain tar-conduit-0.4.1/tar-conduit.cabal0000644000000000000000000000606614546273416015374 0ustar0000000000000000name: tar-conduit version: 0.4.1 synopsis: Extract and create tar files using conduit for streaming description: Please see README.md. This is just filler to avoid warnings. homepage: https://github.com/snoyberg/tar-conduit#readme license: MIT license-file: LICENSE author: Michael Snoyman maintainer: michael@snoyman.com, bartavelle@gmail.com, alexey@kuleshevi.ch category: Data Conduit build-type: Simple extra-source-files: README.md ChangeLog.md tests/files/libpq-0.3.tar.gz tests/files/subdir.tar cabal-version: 1.24 library if impl(ghc < 8) buildable: False hs-source-dirs: src exposed-modules: Data.Conduit.Tar, Data.Conduit.Tar.Types build-depends: base >= 4.9.0.0 && < 5 , bytestring , conduit , conduit-combinators >= 1.0.8.1 , containers , directory , filepath , mtl , safe-exceptions , text default-language: Haskell2010 ghc-options: -Wall if os(windows) other-modules: Data.Conduit.Tar.Windows build-depends: time , unix-compat cpp-options: -DWINDOWS else other-modules: Data.Conduit.Tar.Unix build-depends: unix test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Spec.hs build-depends: QuickCheck , base >= 4.9.0.0 && < 5 , bytestring , conduit , conduit-extra , conduit-combinators >= 1.0.8.1 , directory , filepath , hspec , tar-conduit ghc-options: -O2 -threaded -rtsopts if os(windows) cpp-options: -DWINDOWS default-language: Haskell2010 test-suite space default-language: Haskell2010 type: exitcode-stdio-1.0 ghc-options: -O2 main-is: Space.hs hs-source-dirs: tests build-depends: base >= 4.9.0.0 , bytestring , conduit , conduit-combinators >= 1.0.8.1 , containers , deepseq , directory , filepath , hspec , tar-conduit , weigh benchmark time default-language: Haskell2010 type: exitcode-stdio-1.0 ghc-options: -O2 main-is: Time.hs hs-source-dirs: tests build-depends: base >= 4.9.0.0 , bytestring , conduit , conduit-combinators >= 1.0.8.1 , containers , criterion , deepseq , directory , filepath , hspec , tar-conduit source-repository head type: git location: https://github.com/snoyberg/tar-conduit