diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,12 @@ +## 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 some GNU tar features: long file name, discardes. + * Helper tar/untar functions for dealing with 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)) diff --git a/src/Data/Conduit/Tar.hs b/src/Data/Conduit/Tar.hs --- a/src/Data/Conduit/Tar.hs +++ b/src/Data/Conduit/Tar.hs @@ -1,76 +1,75 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-| 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 - untar + tar + , tarEntries + , untar + , untarWithFinalizers + , restoreFile + , restoreFileInto , withEntry , withEntries -- * Helper functions , headerFileType , headerFilePath + -- ** Creation + , tarFilePath + , filePathConduit + -- * Directly on files + , createTarball + , writeTarball + , extractTarball -- * Types - , Header (..) - , TarChunk (..) - , TarException (..) - , Offset - , Size - , FileType (..) + , module Data.Conduit.Tar.Types ) where -import Conduit -import Control.Exception (Exception, assert) -import Control.Monad (unless) -import Data.ByteString (ByteString) -import Data.Typeable (Typeable) -import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 -import qualified Data.ByteString.Unsafe as BU -import System.Posix.Types (CMode) -import Data.Word (Word8) -import Data.Int (Int64) -import Data.ByteString.Short (ShortByteString, toShort, fromShort) -import Data.Monoid ((<>)) +import Conduit as C +import Control.Exception (assert) +import Control.Monad (unless, void) +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 Data.Monoid ((<>), mempty) +import Foreign.C.Types (CTime (..)) +import System.Directory (createDirectoryIfMissing, + getCurrentDirectory) +import System.FilePath +import System.IO #if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<*)) +import Control.Applicative ((<*)) #endif -data Header = Header - { headerOffset :: !Offset - , headerPayloadOffset :: !Offset - , headerFileNameSuffix :: !ShortByteString - , headerFileMode :: !CMode - , headerOwnerId :: !Int - , headerGroupId :: !Int - , headerPayloadSize :: !Size - , headerTime :: !Int64 - , headerLinkIndicator :: !Word8 - , headerOwnerName :: !ShortByteString - , headerGroupName :: !ShortByteString - , headerDeviceMajor :: !Int - , headerDeviceMinor :: !Int - , headerFileNamePrefix :: !ShortByteString - } - deriving Show +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.length headerFileNamePrefix > 0 + then S.concat + [fromShort headerFileNamePrefix, pathSeparatorS, fromShort headerFileNameSuffix] + else fromShort headerFileNameSuffix + headerFilePath :: Header -> FilePath -headerFilePath h = S8.unpack $ fromShort - $ headerFileNamePrefix h <> headerFileNameSuffix h +headerFilePath = S8.unpack . headerFilePathBS -data FileType - = FTNormal - | FTHardLink - | FTSymbolicLink - | FTCharacterSpecial - | FTBlockSpecial - | FTDirectory - | FTFifo - | FTOther !Word8 - deriving (Show, Eq) headerFileType :: Header -> FileType headerFileType h = @@ -78,39 +77,14 @@ 0 -> FTNormal 48 -> FTNormal 49 -> FTHardLink - 50 -> FTSymbolicLink + 50 -> FTSymbolicLink (fromShort (headerLinkName h)) 51 -> FTCharacterSpecial 52 -> FTBlockSpecial 53 -> FTDirectory 54 -> FTFifo x -> FTOther x -type Offset = Int -type Size = Int - -data TarChunk - = ChunkHeader Header - | ChunkPayload !Offset !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 !Offset - | IncompleteHeader !Offset - | IncompletePayload !Offset !Size - | ShortTrailer !Offset - | BadTrailer !Offset - | InvalidHeader !Offset - | BadChecksum !Offset - deriving (Show, Typeable) -instance Exception TarException - -parseHeader :: Offset -> ByteString -> Either TarException Header +parseHeader :: FileOffset -> ByteString -> Either TarException Header parseHeader offset bs = assert (S.length bs == 512) $ do let checksumBytes = S.take 8 $ S.drop 148 bs expectedChecksum = parseOctal checksumBytes @@ -124,8 +98,10 @@ , headerOwnerId = getOctal 108 8 , headerGroupId = getOctal 116 8 , headerPayloadSize = getOctal 124 12 - , headerTime = getOctal 136 12 + , headerTime = CTime $ getOctal 136 12 , headerLinkIndicator = BU.unsafeIndex bs 156 + , headerLinkName = getShort 157 100 + , headerMagicVersion = toShort $ S.take 8 $ S.drop 257 bs , headerOwnerName = getShort 265 32 , headerGroupName = getShort 297 32 , headerDeviceMajor = getOctal 329 8 @@ -150,8 +126,8 @@ zero = 48 seven = 55 -untar :: Monad m => ConduitM ByteString TarChunk m () -untar = +untarChunks :: Monad m => ConduitM ByteString TarChunk m () +untarChunks = loop 0 where loop !offset = assert (offset `mod` 512 == 0) $ do @@ -179,9 +155,9 @@ yield $ ChunkHeader h offset' <- payloads (offset + 512) $ headerPayloadSize h let expectedOffset = offset + 512 + headerPayloadSize h + - (case (512 - (headerPayloadSize h `mod` 512)) of + (case 512 - (headerPayloadSize h `mod` 512) of 512 -> 0 - x -> x) + x -> x) assert (offset' == expectedOffset) (loop offset') _ -> do leftover bs @@ -191,23 +167,24 @@ let padding = case offset `mod` 512 of 0 -> 0 - x -> 512 - x + x -> 512 - fromIntegral x takeCE padding .| sinkNull - return $! offset + padding + return $! offset + fromIntegral padding payloads !offset !size = do mbs <- await case mbs of Nothing -> do - yield $ ChunkException $ IncompletePayload offset size + yield $ ChunkException $ IncompletePayload offset $ fromIntegral size return offset Just bs -> do - let (x, y) = S.splitAt size bs + let (x, y) = S.splitAt (fromIntegral (min size (fromIntegral (maxBound :: Int)))) bs yield $ ChunkPayload offset x - let size' = size - S.length x - offset' = offset + S.length 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. withEntry :: MonadThrow m => (Header -> ConduitM ByteString o m r) @@ -216,20 +193,24 @@ mc <- await case mc of Nothing -> throwM NoMoreHeaders - Just (ChunkHeader h) -> payloads .| (inner h <* sinkNull) + Just (ChunkHeader h) -> payloadsConduit .| (inner h <* sinkNull) Just x@(ChunkPayload offset _bs) -> do leftover x throwM $ UnexpectedPayload offset Just (ChunkException e) -> throwM e - where - payloads = do - mx <- await - case mx of - Just (ChunkPayload _ bs) -> yield bs >> payloads - Just x@ChunkHeader{} -> leftover x - Just (ChunkException e) -> throwM e - Nothing -> return () + +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. @@ -237,17 +218,17 @@ > 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.untar -- decode the tar archive +> .| CT.untarChunks -- decode the tar archive > .| CT.withEntries hashentry -- process each file > .| printC -- print the results > ) @@ -270,3 +251,492 @@ => (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 portions of GNU format: +-- * '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: +-- +withFileInfo :: MonadThrow m + => (FileInfo -> ConduitM ByteString o m ()) + -> ConduitM TarChunk o m () +withFileInfo inner = go + where + go = do + mc <- await + case mc of + Nothing -> return () + Just (ChunkHeader h) + | headerLinkIndicator h >= 55 -> do + if (headerMagicVersion h == gnuTarMagicVersion) + then handleGnuTarHeader h .| go + else go + Just (ChunkHeader h) -> do + payloadsConduit .| (inner (fileInfoFromHeader h) <* sinkNull) + go + Just x@(ChunkPayload offset _bs) -> do + leftover x + throwM $ UnexpectedPayload offset + Just (ChunkException e) -> throwM e + +-- | Take care of custom GNU tar format. +handleGnuTarHeader :: MonadThrow m + => Header + -> ConduitM TarChunk TarChunk m () +handleGnuTarHeader h = do + 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 .| sinkBuilder + 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." + yield + (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 () + + + +-- | Just like `withFileInfo`, but works directly on the stream of bytes. +untar :: MonadThrow m + => (FileInfo -> ConduitM ByteString o m ()) + -> ConduitM ByteString o m () +untar inner = untarChunks .| withFileInfo inner + + +-- | 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. +untarWithFinalizers :: + (MonadThrow m, MonadIO m) + => (FileInfo -> ConduitM ByteString (IO ()) m ()) + -> ConduitM ByteString c m () +untarWithFinalizers inner = do + finilizers <- untar inner .| foldlC (>>) (return ()) + liftIO finilizers + + +-------------------------------------------------------------------------------- +-- 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" + let (prefix, suffix) = splitPathAt 100 $ filePath fi + if (SS.length prefix > 155) + then return $ Left $ FileNameTooLong fi + else do + (payloadSize, linkName, linkIndicator) <- + case fileType fi of + FTNormal -> return (fileSize fi, SS.empty, 48) + FTSymbolicLink ln -> return (0, toShort ln, 50) + FTDirectory -> return (0, SS.empty, 53) + fty -> throwM $ TarCreationError $ "Unsupported file type: " ++ show fty + 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 + encChecksum <- encodeOctal 7 $ sumsl left + 32 * 8 + sumsl right + return $ + SL.toStrict $ + toLazyByteString $ lazyByteString left <> encChecksum <> word8 0 <> lazyByteString right + + +packHeaderNoChecksum :: MonadThrow m => Header -> m (SL.ByteString, SL.ByteString) +packHeaderNoChecksum Header {..} = do + let CTime headerTime' = headerTime + hNameSuffix <- encodeShort 100 headerFileNameSuffix + hFileMode <- encodeOctal 7 headerFileMode + hOwnerId <- encodeOctal 7 headerOwnerId + hGroupId <- encodeOctal 7 headerGroupId + hPayloadSize <- encodeOctal 11 headerPayloadSize + hTime <- encodeOctal 11 headerTime' + hLinkName <- encodeShort 100 headerLinkName + hMagicVersion <- encodeShort 8 headerMagicVersion + hOwnerName <- encodeShort 32 headerOwnerName + hGroupName <- encodeShort 32 headerGroupName + hDevMajor <- encodeDevice headerDeviceMajor + hDevMinor <- encodeDevice headerDeviceMinor + hNamePrefix <- encodeShort 155 headerFileNamePrefix + return + ( toLazyByteString $ + hNameSuffix <> + hFileMode <> word8 0 <> + hOwnerId <> word8 0 <> + hGroupId <> word8 0 <> + hPayloadSize <> word8 0 <> + hTime <> word8 0 + , toLazyByteString $ + word8 headerLinkIndicator <> + hLinkName <> + hMagicVersion <> + hOwnerName <> + hGroupName <> + hDevMajor <> word8 0 <> + hDevMinor <> word8 0 <> + hNamePrefix <> + byteString (S.replicate 12 0) + ) + where + encodeDevice 0 = return $ byteString $ S.replicate 7 0 + encodeDevice devid = encodeOctal 7 devid + + +-- | Encode a `ShortByteString` with an exact length, NUL terminating if it is +-- shorter, but throwing `TarCreationError` if it is longer. +encodeShort :: MonadThrow m => Int -> ShortByteString -> m Builder +encodeShort !len !sbs + | lenShort <= len = return $ shortByteString sbs <> byteString (S.replicate (len - lenShort) 0) + | otherwise = + throwM $ + TarCreationError $ "Can't fit '" ++ S8.unpack (fromShort sbs) ++ "' into the tar header" + where + lenShort = SS.length sbs + + +-- | Encode a number in 8base padded with zeros. Throws `TarCreationError` when overflows. +encodeOctal :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder +encodeOctal !len !val = go 0 val mempty + where + 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 = + throwM $ + TarCreationError $ + ": Tar value overflow (for maxLen " ++ show len ++ "): " ++ show val + + + +-- | 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 recieving 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." + Just (Right content) -> do + let nextSize = prevSize + fromIntegral (S.length content) + unless (nextSize <= headerPayloadSize header) $ + throwM $ TarCreationError "Too much payload" + 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 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 _) -> + 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 should no be modified +-- afterwards. Returned is the total size of the bytestring as a `FileOffset`. +tar :: MonadResource 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. +tarEntries :: MonadResource 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. +filePathConduit :: MonadResource m => + ConduitM FilePath (Either FileInfo ByteString) m () +filePathConduit = do + mfp <- await + case mfp of + Just fp -> do + fi <- liftIO $ getFileInfo $ S8.pack fp + case fileType fi of + FTNormal -> do + yield (Left fi) + sourceFile (S8.unpack (filePath fi)) .| mapC Right + FTSymbolicLink _ -> yield (Left fi) + FTDirectory -> do + yield (Left fi) + sourceDirectory (S8.unpack (filePath fi)) .| filePathConduit + fty -> do + leftover fp + throwM $ TarCreationError $ "Unsupported file type: " ++ show fty + 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. +tarFilePath :: 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 +createTarball :: FilePath -- ^ File name for the tarball + -> [FilePath] -- ^ List of files and directories to include in the tarball + -> IO () +createTarball tarfp dirs = do + runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkFile tarfp + + +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 = do + runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkHandle tarHandle + + +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. +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) + + +-- | 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 fi = + restoreFile fi {filePath = S8.pack (cd makeRelative "/" (S8.unpack (filePath fi)))} + + diff --git a/src/Data/Conduit/Tar/Types.hs b/src/Data/Conduit/Tar/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/Tar/Types.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} +-- | Module contains all the types necessary for tarball processing. +module Data.Conduit.Tar.Types + ( Header(..) + , TarChunk(..) + , TarException(..) + , TarCreateException(..) + , FileType(..) + , FileInfo(..) + , FileOffset + , ByteCount + , UserID + , GroupID + , DeviceID + , EpochTime + ) where + +import Control.Exception (Exception) +import Data.ByteString (ByteString) +import Data.ByteString.Short (ShortByteString) +import Data.Typeable +import Data.Word + +#if WINDOWS +import System.PosixCompat.Types +#else +import System.Posix.Types +#endif + +data FileType + = FTNormal + | FTHardLink + | 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`, `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 + + + +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 + deriving (Show, Typeable) +instance Exception TarException + + +data TarCreateException + = FileNameTooLong !FileInfo + | TarCreationError !String + deriving (Show, Typeable) +instance Exception TarCreateException + + diff --git a/src/Data/Conduit/Tar/Unix.hs b/src/Data/Conduit/Tar/Unix.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/Tar/Unix.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Data.Conduit.Tar.Unix + ( getFileInfo + , restoreFile + ) where + +import Conduit +import Control.Exception +import Control.Monad (when) +import Data.Bits +import qualified Data.ByteString.Char8 as S8 +import Data.Conduit.Tar.Types (FileInfo (..), FileType (..)) +import qualified System.Directory as Dir +import qualified System.Posix.Files.ByteString as Posix +import qualified System.Posix.User as Posix + +getFileInfo :: S8.ByteString -> IO FileInfo +getFileInfo fp = do + fs <- Posix.getSymbolicLinkStatus fp + 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 + euEntry :: Either IOException Posix.UserEntry <- try $ Posix.getUserEntryForID uid + egEntry :: Either IOException Posix.GroupEntry <- try $ Posix.getGroupEntryForID gid + (fType, fSize) <- + case () of + () | Posix.isRegularFile fs -> return (FTNormal, Posix.fileSize fs) + | Posix.isSymbolicLink fs -> do + ln <- Posix.readSymbolicLink fp + return (FTSymbolicLink 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 = either (const "") (S8.pack . Posix.userName) euEntry + , fileGroupId = gid + , fileGroupName = either (const "") (S8.pack . Posix.groupName) egEntry + , fileMode = Posix.fileMode fs .&. 0o7777 + , fileSize = fSize + , fileType = fType + , fileModTime = Posix.modificationTime fs + } + +-- | 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 FileInfo {..} = do + let filePath' = S8.unpack filePath + case fileType of + FTDirectory -> do + liftIO $ Dir.createDirectoryIfMissing False filePath' + yield $ + (Dir.doesDirectoryExist filePath' >>= + (`when` Posix.setFileTimes filePath fileModTime fileModTime)) + FTSymbolicLink link -> + liftIO $ do + exist <- Posix.fileExist filePath + when exist $ Dir.removeFile filePath' + Posix.createSymbolicLink link filePath + FTNormal -> sinkFile filePath' + ty -> error $ "Unsupported tar entry type: " ++ show ty + liftIO $ do + Posix.setFileTimes filePath fileModTime fileModTime + Posix.setSymbolicLinkOwnerAndGroup filePath fileUserId fileGroupId + Posix.setFileMode filePath fileMode diff --git a/src/Data/Conduit/Tar/Windows.hs b/src/Data/Conduit/Tar/Windows.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/Tar/Windows.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Data.Conduit.Tar.Windows + ( getFileInfo + , restoreFile + ) where + +import Conduit +import Control.Monad (when) +import Data.Bits +import qualified Data.ByteString.Char8 as S8 +import Data.Conduit.Tar.Types (FileInfo (..), FileType (..)) +import Data.Time.Clock.POSIX +import Foreign.C.Types (CTime (..)) +import qualified System.Directory as Dir +import qualified System.PosixCompat.Files as Posix + +getFileInfo :: S8.ByteString -> IO FileInfo +getFileInfo fp = do + let fp' = S8.unpack fp + fs <- Posix.getSymbolicLinkStatus fp' + let uid = Posix.fileOwner fs + gid = 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 = fp + , fileUserId = uid + , fileUserName = "" + , fileGroupId = gid + , fileGroupName = "" + , fileMode = Posix.fileMode fs .&. 0o7777 + , fileSize = fSize + , fileType = fType + , fileModTime = Posix.modificationTime fs + } + +-- | 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 FileInfo {..} = do + let filePath' = S8.unpack filePath + CTime modTimeEpoch = fileModTime + modTime = posixSecondsToUTCTime (fromIntegral modTimeEpoch) + case fileType of + FTDirectory -> do + liftIO $ Dir.createDirectoryIfMissing False filePath' + yield $ + (Dir.doesDirectoryExist filePath' >>= + (`when` Dir.setModificationTime filePath' modTime)) + FTNormal -> sinkFile filePath' + ty -> error $ "Unsupported tar entry type: " ++ show ty + liftIO $ do + Dir.setModificationTime filePath' modTime + Posix.setSymbolicLinkOwnerAndGroup filePath' fileUserId fileGroupId + Posix.setFileMode filePath' fileMode + diff --git a/tar-conduit.cabal b/tar-conduit.cabal --- a/tar-conduit.cabal +++ b/tar-conduit.cabal @@ -1,12 +1,12 @@ name: tar-conduit -version: 0.1.1 -synopsis: Parse tar files using conduit for streaming -description: Please see README.md +version: 0.2.0 +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 +maintainer: michael@snoyman.com, bartavelle@gmail.com, alexey@kuleshevi.ch category: Data Conduit build-type: Simple extra-source-files: README.md ChangeLog.md @@ -14,23 +14,73 @@ library hs-source-dirs: src - exposed-modules: Data.Conduit.Tar + exposed-modules: Data.Conduit.Tar, Data.Conduit.Tar.Types build-depends: base >= 4.7 && < 5 , bytestring , conduit-combinators >= 1.0.8.1 + , filepath default-language: Haskell2010 + ghc-options: -Wall + if os(windows) + other-modules: Data.Conduit.Tar.Windows + build-depends: directory + , time + , unix-compat + cpp-options: -DWINDOWS + else + other-modules: Data.Conduit.Tar.Unix + build-depends: directory + , unix --- test-suite tar-conduit-test --- type: exitcode-stdio-1.0 --- hs-source-dirs: test --- main-is: Spec.hs --- build-depends: base --- , hspec --- , tar-conduit --- , conduit-extra --- , conduit-combinators --- ghc-options: -threaded -rtsopts -with-rtsopts=-N --- default-language: Haskell2010 +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Spec.hs + build-depends: base + , bytestring + , directory + , filepath + , hspec + , tar-conduit + , conduit-combinators + ghc-options: -threaded -rtsopts -with-rtsopts=-N + 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 + , weigh + , deepseq + , containers + , bytestring + , directory + , filepath + , hspec + , tar-conduit + , conduit-combinators + , conduit + +benchmark time + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -O2 + main-is: Time.hs + hs-source-dirs: tests + build-depends: base + , criterion + , deepseq + , containers + , bytestring + , directory + , filepath + , hspec + , tar-conduit + , conduit-combinators + , conduit source-repository head type: git diff --git a/tests/Space.hs b/tests/Space.hs new file mode 100644 --- /dev/null +++ b/tests/Space.hs @@ -0,0 +1,116 @@ +{-# 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 diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE FlexibleContexts #-} +module Main where + +import Prelude as P +import Conduit +import Control.Monad (void, when, zipWithM_) +import Test.Hspec +import Data.Conduit.Tar +import System.Directory +import Data.ByteString as S +import System.IO +import System.FilePath +import Control.Exception + +main :: IO () +main = do + let baseTmp = "tar-conduit-tests" + isStack <- doesDirectoryExist ".stack-work" + let testPaths = + ["src", "./tests", "README.md", "ChangeLog.md", "LICENSE"] ++ + if isStack + then [".stack-work", "./sample"] + else [] + 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 <- readTarball fpIn + tb2 <- readTarball fpOut + P.length tb1 `shouldBe` P.length tb2 + zipWithM_ shouldBe (fmap fst tb2) (fmap fst tb1) + zipWithM_ shouldBe (fmap snd tb2) (fmap snd tb1) + +withTempTarFiles :: FilePath -> ((FilePath, Handle, FilePath, FilePath) -> IO c) -> IO c +withTempTarFiles base = + bracket + (do tmpDir <- getTemporaryDirectory + (fp1, h1) <- openBinaryTempFile tmpDir (addExtension base ".tar") + let outPath = dropExtension fp1 ++ ".out" + return (fp1, h1, outPath, addExtension outPath ".tar") + ) + (\(fp, h, dirOut, fpOut) -> do + hClose h + removeFile fp + doesDirectoryExist dirOut >>= (`when` removeDirectoryRecursive dirOut) + doesFileExist fpOut >>= (`when` removeFile fpOut) + ) + + +readTarball + :: (MonadIO m, MonadThrow m, MonadBaseControl IO m) => + FilePath -> m [(FileInfo, Maybe ByteString)] +readTarball fp = runConduitRes $ sourceFileBS fp .| untar grabBoth .| sinkList + where + 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 + diff --git a/tests/Time.hs b/tests/Time.hs new file mode 100644 --- /dev/null +++ b/tests/Time.hs @@ -0,0 +1,120 @@ +{-# 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