tar 0.6.0.0 → 0.6.1.0
raw patch · 20 files changed
+517/−284 lines, 20 filesdep +os-stringdep +transformers
Dependencies added: os-string, transformers
Files
- Codec/Archive/Tar.hs +49/−33
- Codec/Archive/Tar/Check/Internal.hs +21/−4
- Codec/Archive/Tar/Index.hs +5/−5
- Codec/Archive/Tar/Index/IntTrie.hs +3/−2
- Codec/Archive/Tar/Index/Internal.hs +28/−26
- Codec/Archive/Tar/Index/StringTable.hs +2/−1
- Codec/Archive/Tar/LongNames.hs +8/−2
- Codec/Archive/Tar/Pack.hs +12/−13
- Codec/Archive/Tar/PackAscii.hs +24/−10
- Codec/Archive/Tar/Read.hs +123/−82
- Codec/Archive/Tar/Types.hs +102/−60
- Codec/Archive/Tar/Unpack.hs +5/−1
- Codec/Archive/Tar/Write.hs +12/−5
- changelog.md +20/−1
- tar.cabal +6/−4
- test/Codec/Archive/Tar/Index/StringTable/Tests.hs +1/−1
- test/Codec/Archive/Tar/Index/Tests.hs +4/−3
- test/Codec/Archive/Tar/Pack/Tests.hs +83/−24
- test/Codec/Archive/Tar/Types/Tests.hs +8/−7
- test/Properties.hs +1/−0
Codec/Archive/Tar.hs view
@@ -51,34 +51,42 @@ -- * Notes -- ** Compressed tar archives- -- | Tar files are commonly used in conjunction with gzip compression, as in- -- \"@.tar.gz@\" or \"@.tar.bz2@\" files. This module does not directly+ -- | Tar files are commonly used in conjunction with compression, as in+ -- @.tar.gz@ or @.tar.bz2@ files. This module does not directly -- handle compressed tar files however they can be handled easily by -- composing functions from this module and the modules- -- @Codec.Compression.GZip@ or @Codec.Compression.BZip@- -- (see @zlib@ or @bzlib@ packages).+ -- [@Codec.Compression.GZip@](https://hackage.haskell.org/package/zlib/docs/Codec-Compression-Zlib.html)+ -- or+ -- [@Codec.Compression.BZip@](https://hackage.haskell.org/package/bzlib-0.5.0.5/docs/Codec-Compression-BZip.html). --- -- Creating a compressed \"@.tar.gz@\" file is just a minor variation on the+ -- Creating a compressed @.tar.gz@ file is just a minor variation on the -- 'create' function, but where throw compression into the pipeline: --- -- > BS.writeFile tar . GZip.compress . Tar.write =<< Tar.pack base dir+ -- > import qualified Data.ByteString.Lazy as BL+ -- > import qualified Codec.Compression.GZip as GZip+ -- >+ -- > BL.writeFile tar . GZip.compress . Tar.write =<< Tar.pack base dir --- -- Similarly, extracting a compressed \"@.tar.gz@\" is just a minor variation+ -- Similarly, extracting a compressed @.tar.gz@ is just a minor variation -- on the 'extract' function where we use decompression in the pipeline: --- -- > Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar+ -- > import qualified Data.ByteString.Lazy as BL+ -- > import qualified Codec.Compression.Zlib as GZip+ -- >+ -- > Tar.unpack dir . Tar.read . GZip.decompress =<< BL.readFile tar -- -- ** Security -- | This is pretty important. A maliciously constructed tar archives could -- contain entries that specify bad file names. It could specify absolute- -- file names like \"@\/etc\/passwd@\" or relative files outside of the- -- archive like \"..\/..\/..\/something\". This security problem is commonly+ -- file names like @\/etc\/passwd@ or relative files outside of the+ -- archive like @..\/..\/..\/something@. This security problem is commonly -- called a \"directory traversal vulnerability\". Historically, such -- vulnerabilities have been common in packages handling tar archives. --- -- The 'extract' and 'unpack' functions check for bad file names. See the- -- 'checkSecurity' function for more details. If you need to do any custom+ -- The 'extract' and 'Codec.Archive.Tar.unpack' functions check for bad file names. See the+ -- 'Codec.Archive.Tar.Check.checkSecurity' function for more details.+ -- If you need to do any custom -- unpacking then you should use this. -- ** Tarbombs@@ -87,8 +95,13 @@ -- 'extract' function does not check for these however if you want to do -- that you can use the 'checkTarbomb' function like so: --- -- > Tar.unpack dir . Tar.checkTarbomb expectedDir- -- > . Tar.read =<< BS.readFile tar+ -- > import Control.Exception (SomeException(..))+ -- > import Control.Applicative ((<|>))+ -- > import qualified Data.ByteString.Lazy as BL+ -- >+ -- > Tar.unpackAndCheck (\x -> SomeException <$> checkEntryTarbomb expectedDir x+ -- > <|> SomeException <$> checkEntrySecurity x) dir .+ -- > Tar.read =<< BL.readFile tar -- -- In this case extraction will fail if any file is outside of @expectedDir@. @@ -113,7 +126,7 @@ -- * Types -- ** Tar entry type -- | This module provides only very simple and limited read-only access to- -- the 'Entry' type. If you need access to the details or if you need to+ -- the 'GenEntry' type. If you need access to the details or if you need to -- construct your own entries then also import "Codec.Archive.Tar.Entry". GenEntry, Entry,@@ -143,7 +156,7 @@ -- The style of error handling by returning structured errors. The pure -- functions in the library do not throw exceptions, they return the errors -- as data. The IO actions in the library can throw exceptions, in particular- -- the 'unpack' action does this. All the error types used are an instance of+ -- the 'Codec.Archive.Tar.unpack' action does this. All the error types used are an instance of -- the standard 'Exception' class so it is possible to 'throw' and 'catch' -- them. @@ -151,20 +164,19 @@ FormatError(..), ) where -import Codec.Archive.Tar.LongNames-import Codec.Archive.Tar.Types--import Codec.Archive.Tar.Read-import Codec.Archive.Tar.Write--import Codec.Archive.Tar.Pack-import Codec.Archive.Tar.Unpack-import Codec.Archive.Tar.Index (hSeekEndEntryOffset)- import Codec.Archive.Tar.Check+import Codec.Archive.Tar.Entry+import Codec.Archive.Tar.Index (hSeekEndEntryOffset)+import Codec.Archive.Tar.LongNames (decodeLongNames, encodeLongNames, DecodeLongNamesError(..))+import Codec.Archive.Tar.Pack (pack, packAndCheck)+import Codec.Archive.Tar.Read (read, FormatError(..))+import Codec.Archive.Tar.Types (unfoldEntries, foldlEntries, foldEntries, mapEntriesNoFail, mapEntries, Entries, GenEntries(..))+import Codec.Archive.Tar.Unpack (unpack, unpackAndCheck)+import Codec.Archive.Tar.Write (write) -import Control.Exception (Exception, throw, catch)-import qualified Data.ByteString.Lazy as BS+import Control.Applicative ((<|>))+import Control.Exception (Exception, throw, catch, SomeException(..))+import qualified Data.ByteString.Lazy as BL import System.IO (withFile, IOMode(..)) import Prelude hiding (read) @@ -181,7 +193,9 @@ -- This is a high level \"all in one\" operation. Since you may need variations -- on this function it is instructive to see how it is written. It is just: ----- > BS.writeFile tar . Tar.write =<< Tar.pack base paths+-- > import qualified Data.ByteString.Lazy as BL+-- >+-- > BL.writeFile tar . Tar.write =<< Tar.pack base paths -- -- Notes: --@@ -203,7 +217,7 @@ -> FilePath -- ^ Base directory -> [FilePath] -- ^ Files and directories to archive, relative to base dir -> IO ()-create tar base paths = BS.writeFile tar . write =<< pack base paths+create tar base paths = BL.writeFile tar . write =<< pack base paths -- | Extract all the files contained in a @\".tar\"@ file. --@@ -217,7 +231,9 @@ -- This is a high level \"all in one\" operation. Since you may need variations -- on this function it is instructive to see how it is written. It is just: ----- > Tar.unpack dir . Tar.read =<< BS.readFile tar+-- > import qualified Data.ByteString.Lazy as BL+-- >+-- > Tar.unpack dir . Tar.read =<< BL.readFile tar -- -- Notes: --@@ -236,7 +252,7 @@ extract :: FilePath -- ^ Destination directory -> FilePath -- ^ Tarball -> IO ()-extract dir tar = unpack dir . read =<< BS.readFile tar+extract dir tar = unpack dir . read =<< BL.readFile tar -- | Append new entries to a @\".tar\"@ file from a directory of files. --@@ -251,4 +267,4 @@ append tar base paths = withFile tar ReadWriteMode $ \hnd -> do _ <- hSeekEndEntryOffset hnd Nothing- BS.hPut hnd . write =<< pack base paths+ BL.hPut hnd . write =<< pack base paths
Codec/Archive/Tar/Check/Internal.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Codec.Archive.Tar.Check.Internal@@ -70,12 +70,18 @@ -- link target. A failure in any entry terminates the sequence of entries with -- an error. --+-- Whenever possible, consider fusing 'Codec.Archive.Tar.Check.checkSecurity'+-- with packing / unpacking by using+-- 'Codec.Archive.Tar.packAndCheck' / 'Codec.Archive.Tar.unpackAndCheck'+-- with 'Codec.Archive.Tar.Check.checkEntrySecurity'.+-- Not only it is faster, but also alleviates issues with lazy I/O+-- such as exhaustion of file handlers. checkSecurity :: Entries e -> GenEntries FilePath FilePath (Either (Either e DecodeLongNamesError) FileNameError) checkSecurity = checkEntries checkEntrySecurity . decodeLongNames --- | Worker of 'checkSecurity'.+-- | Worker of 'Codec.Archive.Tar.Check.checkSecurity'. -- -- @since 0.6.0.0 checkEntrySecurity :: GenEntry FilePath FilePath -> Maybe FileNameError@@ -151,9 +157,15 @@ -- Given the expected subdirectory, this function checks all entries are within -- that subdirectroy. ----- Note: This check must be used in conjunction with 'checkSecurity'--- (or 'checkPortability').+-- Note: This check must be used in conjunction with 'Codec.Archive.Tar.Check.checkSecurity'+-- (or 'Codec.Archive.Tar.Check.checkPortability'). --+-- Whenever possible, consider fusing 'Codec.Archive.Tar.Check.checkTarbomb'+-- with packing / unpacking by using+-- 'Codec.Archive.Tar.packAndCheck' / 'Codec.Archive.Tar.unpackAndCheck'+-- with 'Codec.Archive.Tar.Check.checkEntryTarbomb'.+-- Not only it is faster, but also alleviates issues with lazy I/O+-- such as exhaustion of file handlers. checkTarbomb :: FilePath -> Entries e@@ -217,6 +229,11 @@ -- includes characters that are valid in both systems and the \'/\' vs \'\\\' -- directory separator conventions. --+-- Whenever possible, consider fusing 'checkPortability' with packing / unpacking by using+-- 'Codec.Archive.Tar.packAndCheck' / 'Codec.Archive.Tar.unpackAndCheck'+-- with 'checkEntryPortability'.+-- Not only it is faster, but also alleviates issues with lazy I/O+-- such as exhaustion of file handlers. checkPortability :: Entries e -> GenEntries FilePath FilePath (Either (Either e DecodeLongNamesError) PortabilityError)
Codec/Archive/Tar/Index.hs view
@@ -22,11 +22,11 @@ -- within the archive. -- -- This module provides an index of a @tar@ file. A linear pass of the- -- @tar@ file is needed to 'build' the 'TarIndex', but thereafter you can+ -- @tar@ file is needed to 'build' the t'TarIndex', but thereafter you can -- 'lookup' paths in the @tar@ file, and then use 'hReadEntry' to -- seek to the right part of the file and read the entry. --- -- An index cannot be used to lookup 'Directory' entries in a tar file;+ -- An index cannot be used to lookup 'Codec.Archive.Tar.Directory' entries in a tar file; -- instead, you will get 'TarDir' entry listing all the entries in the -- directory. @@ -73,12 +73,12 @@ -- $incremental-construction -- If you need more control than 'build' then you can construct the index--- in an accumulator style using the 'IndexBuilder' and operations.+-- in an accumulator style using the t'IndexBuilder' and operations. -- -- Start with 'empty' and use 'addNextEntry' (or 'skipNextEntry') for -- each 'Codec.Archive.Tar.Entry.Entry' in the tar file in order. Every entry must added or skipped in--- order, otherwise the resulting 'TarIndex' will report the wrong--- 'TarEntryOffset's. At the end use 'finalise' to get the 'TarIndex'.+-- order, otherwise the resulting t'TarIndex' will report the wrong+-- 'TarEntryOffset's. At the end use 'finalise' to get the t'TarIndex'. -- -- For example, 'build' is simply: --
Codec/Archive/Tar/Index/IntTrie.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP, BangPatterns, PatternGuards #-} {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-} module Codec.Archive.Tar.Index.IntTrie ( @@ -122,10 +123,10 @@ -- Toplevel trie array construction -- --- So constructing the 'IntTrie' as a whole is just a matter of stringing+-- So constructing the t'IntTrie' as a whole is just a matter of stringing -- together all the bits --- | Build an 'IntTrie' from a bunch of (key, value) pairs, where the keys+-- | Build an t'IntTrie' from a bunch of (key, value) pairs, where the keys -- are sequences. -- construct :: [([Key], Value)] -> IntTrie
Codec/Archive/Tar/Index/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP, BangPatterns, PatternGuards #-} {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -122,7 +123,7 @@ instance NFData TarIndex where rnf (TarIndex _ _ _) = () -- fully strict by construction --- | The result of 'lookup' in a 'TarIndex'. It can either be a file directly,+-- | The result of 'Codec.Archive.Tar.Index.lookup' in a t'TarIndex'. It can either be a file directly, -- or a directory entry containing further entries (and all subdirectories -- recursively). Note that the subtrees are constructed lazily, so it's -- cheaper if you don't look at them.@@ -143,7 +144,7 @@ type TarEntryOffset = Word32 --- | Look up a given filepath in the 'TarIndex'. It may return a 'TarFileEntry'+-- | Look up a given filepath in the t'TarIndex'. It may return a 'TarFileEntry' -- containing the 'TarEntryOffset' of the file within the tar file, or if -- the filepath identifies a directory then it returns a 'TarDir' containing -- the list of files within that directory.@@ -171,7 +172,8 @@ lookupComponents [] . filter (/= BS.Char8.singleton '.') . splitDirectories- . packAscii+ . posixToByteString+ . toPosixString where lookupComponents cs' [] = Just (reverse cs') lookupComponents cs' (c:cs) = case StringTable.lookup table c of@@ -179,7 +181,7 @@ Just cid -> lookupComponents (cid:cs') cs fromComponentId :: StringTable PathComponentId -> PathComponentId -> FilePath-fromComponentId table = BS.Char8.unpack . StringTable.index table+fromComponentId table = fromPosixString . byteToPosixString . StringTable.index table -- | All the files in the index with their corresponding 'TarEntryOffset's. --@@ -193,7 +195,7 @@ , let path = FilePath.joinPath (map (fromComponentId pathTable . keyToPathComponentId) cids) ] --- | Build a 'TarIndex' from a sequence of tar 'Entries'. The 'Entries' are+-- | Build a t'TarIndex' from a sequence of tar 'Entries'. The 'Entries' are -- assumed to start at offset @0@ within a file. -- build :: Entries e -> Either e TarIndex@@ -203,7 +205,7 @@ go !builder Done = Right $! finalise builder go !_ (Fail err) = Left err --- | The intermediate type used for incremental construction of a 'TarIndex'.+-- | The intermediate type used for incremental construction of a t'TarIndex'. -- data IndexBuilder = IndexBuilder !(StringTableBuilder PathComponentId)@@ -212,14 +214,14 @@ deriving (Eq, Show) instance NFData IndexBuilder where- rnf (IndexBuilder _ _ _) = () -- fully strict by construction+ rnf IndexBuilder{} = () -- fully strict by construction --- | The initial empty 'IndexBuilder'.+-- | The initial empty t'IndexBuilder'. -- empty :: IndexBuilder empty = IndexBuilder StringTable.empty IntTrie.empty 0 --- | Add the next 'Entry' into the 'IndexBuilder'.+-- | Add the next t'Entry' into the t'IndexBuilder'. -- addNextEntry :: Entry -> IndexBuilder -> IndexBuilder addNextEntry entry (IndexBuilder stbl itrie nextOffset) =@@ -231,13 +233,13 @@ itrie' = IntTrie.insert (map pathComponentIdToKey cids) (IntTrie.Value nextOffset) itrie -- | Use this function if you want to skip some entries and not add them to the--- final 'TarIndex'.+-- final t'TarIndex'. -- skipNextEntry :: Entry -> IndexBuilder -> IndexBuilder skipNextEntry entry (IndexBuilder stbl itrie nextOffset) = IndexBuilder stbl itrie (nextEntryOffset entry nextOffset) --- | Finish accumulating 'Entry' information and build the compact 'TarIndex'+-- | Finish accumulating t'Entry' information and build the compact t'TarIndex' -- lookup structure. -- finalise :: IndexBuilder -> TarIndex@@ -248,8 +250,8 @@ pathTrie = IntTrie.finalise itrie -- | This is the offset immediately following the entry most recently added--- to the 'IndexBuilder'. You might use this if you need to know the offsets--- but don't want to use the 'TarIndex' lookup structure.+-- to the t'IndexBuilder'. You might use this if you need to know the offsets+-- but don't want to use the t'TarIndex' lookup structure. -- Use with 'hSeekEntryOffset'. See also 'nextEntryOffset'. -- indexNextEntryOffset :: IndexBuilder -> TarEntryOffset@@ -266,7 +268,7 @@ -- offset of the current entry. -- -- This is much like using 'skipNextEntry' and 'indexNextEntryOffset', but without--- using an 'IndexBuilder'.+-- using an t'IndexBuilder'. -- nextEntryOffset :: Entry -> TarEntryOffset -> TarEntryOffset nextEntryOffset entry offset =@@ -285,7 +287,7 @@ splitTarPath :: TarPath -> [FilePathBS] splitTarPath (TarPath name prefix) =- splitDirectories prefix ++ splitDirectories name+ splitDirectories (posixToByteString prefix) ++ splitDirectories (posixToByteString name) splitDirectories :: FilePathBS -> [FilePathBS] splitDirectories bs =@@ -300,14 +302,14 @@ -- | Resume building an existing index ----- A 'TarIndex' is optimized for a highly compact and efficient in-memory+-- A t'TarIndex' is optimized for a highly compact and efficient in-memory -- representation. This, however, makes it read-only. If you have an existing--- 'TarIndex' for a large file, and want to add to it, you can translate the--- 'TarIndex' back to an 'IndexBuilder'. Be aware that this is a relatively--- costly operation (linear in the size of the 'TarIndex'), though still+-- t'TarIndex' for a large file, and want to add to it, you can translate the+-- t'TarIndex' back to an t'IndexBuilder'. Be aware that this is a relatively+-- costly operation (linear in the size of the t'TarIndex'), though still -- faster than starting again from scratch. ----- This is the left inverse to 'finalise' (modulo ordering).+-- This is the left inverse to 'Codec.Archive.Tar.Index.finalise' (modulo ordering). -- unfinalise :: TarIndex -> IndexBuilder unfinalise (TarIndex pathTable pathTrie finalOffset) =@@ -320,7 +322,7 @@ -- I/O operations -- --- | Reads an entire 'Entry' at the given 'TarEntryOffset' in the tar file.+-- | Reads an entire t'Entry' at the given 'TarEntryOffset' in the tar file. -- The 'Handle' must be open for reading and be seekable. -- -- This reads the whole entry into memory strictly, not incrementally. For more@@ -340,7 +342,7 @@ } _ -> return entry --- | Read the header for a 'Entry' at the given 'TarEntryOffset' in the tar+-- | Read the header for a t'Entry' at the given 'TarEntryOffset' in the tar -- file. The 'entryContent' will contain the correct metadata but an empty file -- content. The 'Handle' must be open for reading and be seekable. --@@ -408,7 +410,7 @@ -- -- After this action, the 'Handle' position is not in any useful place. If -- you want to skip to the next entry, take the 'TarEntryOffset' returned and--- use 'hReadEntryHeaderOrEof' again. Or if having inspected the 'Entry'+-- use 'hReadEntryHeaderOrEof' again. Or if having inspected the t'Entry' -- header you want to read the entry content (if it has one) then use -- 'hSeekEntryContentOffset' on the original input 'TarEntryOffset'. --@@ -426,7 +428,7 @@ -- | Seek to the end of a tar file, to the position where new entries can -- be appended, and return that 'TarEntryOffset'. ----- If you have a valid 'TarIndex' for this tar file then you should supply it+-- If you have a valid t'TarIndex' for this tar file then you should supply it -- because it allows seeking directly to the correct location. -- -- If you do not have an index, then this becomes an expensive linear@@ -459,7 +461,7 @@ -- (de)serialisation -- --- | The 'TarIndex' is compact in memory, and it has a similarly compact+-- | The t'TarIndex' is compact in memory, and it has a similarly compact -- external representation. -- serialise :: TarIndex -> BS.ByteString@@ -485,7 +487,7 @@ <> StringTable.serialise stringTable <> IntTrie.serialise intTrie --- | Read the external representation back into a 'TarIndex'.+-- | Read the external representation back into a t'TarIndex'. -- deserialise :: BS.ByteString -> Maybe (TarIndex, BS.ByteString) deserialise bs
Codec/Archive/Tar/Index/StringTable.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP, BangPatterns, PatternGuards, DeriveDataTypeable #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+{-# OPTIONS_HADDOCK hide #-} module Codec.Archive.Tar.Index.StringTable ( @@ -90,7 +91,7 @@ index' bs offsets . (ixs !) . fromIntegral . fromEnum --- | Given a list of strings, construct a 'StringTable' mapping those strings+-- | Given a list of strings, construct a t'StringTable' mapping those strings -- to a dense set of integers. Also return the ids for all the strings used -- in the construction. --
Codec/Archive/Tar/LongNames.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_HADDOCK hide #-} module Codec.Archive.Tar.LongNames ( encodeLongNames@@ -6,10 +8,13 @@ , DecodeLongNamesError(..) ) where +import Codec.Archive.Tar.PackAscii import Codec.Archive.Tar.Types import Control.Exception import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL+import "os-string" System.OsString.Posix (PosixString, PosixChar)+import qualified "os-string" System.OsString.Posix as PS -- | Errors raised by 'decodeLongNames'. --@@ -71,7 +76,7 @@ encodeLinkPath lnk = case toTarPath' lnk of FileNameEmpty -> (Nothing, LinkTarget mempty) FileNameOK (TarPath name prefix)- | B.null prefix -> (Nothing, LinkTarget name)+ | PS.null prefix -> (Nothing, LinkTarget name) | otherwise -> (Just $ longSymLinkEntry lnk, LinkTarget name) FileNameTooLong (TarPath name _) -> (Just $ longSymLinkEntry lnk, LinkTarget name)@@ -133,7 +138,8 @@ Fail $ Right NoLinkEntryAfterTypeKEntry otherEntryPayloadToFilePath :: BL.ByteString -> FilePath-otherEntryPayloadToFilePath = B.unpack . B.takeWhile (/= '\0') . BL.toStrict+otherEntryPayloadToFilePath =+ fromPosixString . byteToPosixString . B.takeWhile (/= '\0') . BL.toStrict castEntry :: Entry -> GenEntry FilePath FilePath castEntry e = e
Codec/Archive/Tar/Pack.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Codec.Archive.Tar@@ -59,11 +60,9 @@ -- entries. Hard links are treated like ordinary files. Special files like -- FIFOs (named pipes), sockets or device files will cause problems. ----- An exception will be thrown for any file names that are too long to--- represent as a 'TarPath'.--- -- * This function returns results lazily. Subdirectories are scanned -- and files are read one by one as the list of entries is consumed.+-- Do not change their contents before the output of 'Codec.Archive.Tar.pack' was consumed in full. -- pack :: FilePath -- ^ Base directory@@ -71,10 +70,10 @@ -> IO [Entry] pack = packAndCheck (const Nothing) --- | Like 'pack', but allows to specify additional sanity/security+-- | Like 'Codec.Archive.Tar.pack', but allows to specify additional sanity/security -- checks on the input filenames. This is useful if you know which -- check will be used on client side--- in 'Codec.Tar.Check.unpack' / 'Codec.Tar.Check.unpackAndCheck'.+-- in 'Codec.Archive.Tar.unpack' / 'Codec.Archive.Tar.unpackAndCheck'. -- -- @since 0.6.0.0 packAndCheck@@ -127,7 +126,7 @@ xs' <- interleave xs return (x':xs') --- | Construct a tar 'Entry' based on a local file.+-- | Construct a tar entry based on a local file. -- -- This sets the entry size, the data contained in the file and the file's -- modification time. If the file is executable then that information is also@@ -137,7 +136,7 @@ -- packFileEntry :: FilePath -- ^ Full path to find the file on the local disk- -> tarPath -- ^ Path to use for the tar 'Entry' in the archive+ -> tarPath -- ^ Path to use for the tar 'GenEntry' in the archive -> IO (GenEntry tarPath linkTarget) packFileEntry filepath tarpath = do mtime <- getModTime filepath@@ -170,14 +169,14 @@ , entryTime = mtime } --- | Construct a tar 'Entry' based on a local directory (but not its contents).+-- | Construct a tar entry based on a local directory (but not its contents). -- -- The only attribute of the directory that is used is its modification time. -- Directory ownership and detailed permissions are not preserved. -- packDirectoryEntry :: FilePath -- ^ Full path to find the file on the local disk- -> tarPath -- ^ Path to use for the tar 'Entry' in the archive+ -> tarPath -- ^ Path to use for the tar 'GenEntry' in the archive -> IO (GenEntry tarPath linkTarget) packDirectoryEntry filepath tarpath = do mtime <- getModTime filepath@@ -185,14 +184,14 @@ entryTime = mtime } --- | Construct a tar 'Entry' based on a local symlink.+-- | Construct a tar entry based on a local symlink. -- -- This automatically checks symlink safety via 'checkEntrySecurity'. -- -- @since 0.6.0.0 packSymlinkEntry :: FilePath -- ^ Full path to find the file on the local disk- -> tarPath -- ^ Path to use for the tar 'Entry' in the archive+ -> tarPath -- ^ Path to use for the tar 'GenEntry' in the archive -> IO (GenEntry tarPath FilePath) packSymlinkEntry filepath tarpath = do linkTarget <- getSymbolicLinkTarget filepath@@ -213,12 +212,12 @@ -- -- * This function returns results lazily. Subdirectories are not scanned -- until the files entries in the parent directory have been consumed.--- If the source directory structure changes before the result is used,+-- If the source directory structure changes before the result is used in full, -- the behaviour is undefined. -- getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive dir0 =- fmap tail (recurseDirectories dir0 [""])+ fmap (drop 1) (recurseDirectories dir0 [""]) recurseDirectories :: FilePath -> [FilePath] -> IO [FilePath] recurseDirectories _ [] = return []
Codec/Archive/Tar/PackAscii.hs view
@@ -1,14 +1,28 @@+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_HADDOCK hide #-}+ module Codec.Archive.Tar.PackAscii- ( packAscii+ ( toPosixString+ , fromPosixString+ , posixToByteString+ , byteToPosixString ) where -import qualified Data.ByteString.Char8 as BS.Char8-import Data.Char-import GHC.Stack+import Data.ByteString (ByteString)+import qualified Data.ByteString.Short as Sh+import System.IO.Unsafe (unsafePerformIO)+import "os-string" System.OsString.Posix (PosixString)+import qualified "os-string" System.OsString.Posix as PS+import qualified "os-string" System.OsString.Internal.Types as PS --- | We should really migrate to @OsPath@ from @filepath@ package,--- but for now let's not corrupt data silently.-packAscii :: HasCallStack => FilePath -> BS.Char8.ByteString-packAscii xs- | all isAscii xs = BS.Char8.pack xs- | otherwise = error $ "packAscii: only ASCII filenames are supported, but got " ++ xs+toPosixString :: FilePath -> PosixString+toPosixString = unsafePerformIO . PS.encodeFS++fromPosixString :: PosixString -> FilePath+fromPosixString = unsafePerformIO . PS.decodeFS++posixToByteString :: PosixString -> ByteString+posixToByteString = Sh.fromShort . PS.getPosixString++byteToPosixString :: ByteString -> PosixString+byteToPosixString = PS.PosixString . Sh.toShort
Codec/Archive/Tar/Read.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, DeriveDataTypeable, BangPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Codec.Archive.Tar.Read@@ -12,23 +14,31 @@ -- Portability : portable -- ------------------------------------------------------------------------------module Codec.Archive.Tar.Read (read, FormatError(..)) where+module Codec.Archive.Tar.Read+ ( read+ , FormatError(..)+ ) where +import Codec.Archive.Tar.PackAscii import Codec.Archive.Tar.Types import Data.Char (ord) import Data.Int (Int64)-import Data.Bits (Bits(shiftL))+import Data.Bits (Bits(shiftL, (.&.), complement)) import Control.Exception (Exception(..)) import Data.Typeable (Typeable) import Control.Applicative import Control.Monad import Control.DeepSeq+import Control.Monad.Trans.State.Lazy import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.Char8 import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Lazy as LBS+import System.IO.Unsafe (unsafePerformIO)+import "os-string" System.OsString.Posix (PosixString, PosixChar)+import qualified "os-string" System.OsString.Posix as PS import Prelude hiding (read) @@ -64,97 +74,128 @@ -- * The conversion is done lazily. -- read :: LBS.ByteString -> Entries FormatError-read = unfoldEntries getEntry+read = evalState (readStreaming getN get)+ where+ getN :: Int64 -> State LBS.ByteString LBS.ByteString+ getN n = do+ (pref, st) <- LBS.splitAt n <$> get+ put st+ pure pref -getEntry :: LBS.ByteString -> Either FormatError (Maybe (Entry, LBS.ByteString))-getEntry bs- | BS.length header < 512 = Left TruncatedArchive+readStreaming+ :: Monad m+ => (Int64 -> m LBS.ByteString)+ -> m LBS.ByteString+ -> m (Entries FormatError)+readStreaming = (unfoldEntriesM id .) . getEntryStreaming - -- Tar files end with at least two blocks of all '0'. Checking this serves- -- two purposes. It checks the format but also forces the tail of the data- -- which is necessary to close the file if it came from a lazily read file.- --- -- It's tempting to fall into trailer parsing as soon as LBS.head bs == '\0',- -- because, if interpreted as an 'Entry', it means that 'entryTarPath' is an empty- -- string. Yet it's not a concern of this function: parse it as an 'Entry'- -- and let further pipeline such as 'checkEntrySecurity' deal with it. After all,- -- it might be a format extension with unknown semantics. Such somewhat malformed- -- archives do exist in the wild, see https://github.com/haskell/tar/issues/73.- --- -- Only if an entire block is null, we assume that we are parsing a trailer.- | LBS.all (== 0) (LBS.take 512 bs) = case LBS.splitAt 1024 bs of- (end, trailing)- | LBS.length end /= 1024 -> Left ShortTrailer- | not (LBS.all (== 0) end) -> Left BadTrailer- | not (LBS.all (== 0) trailing) -> Left TrailingJunk- | otherwise -> Right Nothing+getEntryStreaming+ :: Monad m+ => (Int64 -> m LBS.ByteString)+ -> m LBS.ByteString+ -> m (Either FormatError (Maybe Entry))+getEntryStreaming getN getAll = do+ header <- getN 512+ if LBS.length header < 512 then pure (Left TruncatedArchive) else do - | otherwise = do+ -- Tar files end with at least two blocks of all '0'. Checking this serves+ -- two purposes. It checks the format but also forces the tail of the data+ -- which is necessary to close the file if it came from a lazily read file.+ --+ -- It's tempting to fall into trailer parsing as soon as LBS.head bs == '\0',+ -- because, if interpreted as an 'Entry', it means that 'entryTarPath' is an empty+ -- string. Yet it's not a concern of this function: parse it as an 'Entry'+ -- and let further pipeline such as 'checkEntrySecurity' deal with it. After all,+ -- it might be a format extension with unknown semantics. Such somewhat malformed+ -- archives do exist in the wild, see https://github.com/haskell/tar/issues/73.+ --+ -- Only if an entire block is null, we assume that we are parsing a trailer.+ if LBS.all (== 0) header then do+ nextBlock <- getN 512+ if LBS.length nextBlock < 512 then pure (Left ShortTrailer)+ else if LBS.all (== 0) nextBlock then do+ remainder <- getAll+ pure $ if LBS.all (== 0) remainder then Right Nothing else Left TrailingJunk+ else pure (Left BadTrailer) - case (chksum_, format_) of- (Right chksum, _ ) | correctChecksum header chksum -> return ()- (Right _, Right _) -> Left ChecksumIncorrect- _ -> Left NotTarFormat+ else case parseHeader header of+ Left err -> pure $ Left err+ Right (name, mode, uid, gid, size, mtime, typecode, linkname, format, uname, gname, devmajor, devminor, prefix) -> do - -- These fields are partial, have to check them- format <- format_; mode <- mode_;- uid <- uid_; gid <- gid_;- size <- size_; mtime <- mtime_;- devmajor <- devmajor_; devminor <- devminor_;+ -- It is crucial to get (size + padding) in one monadic operation+ -- and drop padding in a pure computation. If you get size bytes first,+ -- then skip padding, unpacking in constant memory will become impossible.+ let paddedSize = (size + 511) .&. complement 511+ paddedContent <- getN paddedSize+ let content = LBS.take size paddedContent - let content = LBS.take size (LBS.drop 512 bs)- padding = (512 - size) `mod` 512- bs' = LBS.drop (512 + size + padding) bs+ pure $ Right $ Just $ Entry {+ entryTarPath = TarPath (byteToPosixString name) (byteToPosixString prefix),+ entryContent = case typecode of+ '\0' -> NormalFile content size+ '0' -> NormalFile content size+ '1' -> HardLink (LinkTarget $ byteToPosixString linkname)+ '2' -> SymbolicLink (LinkTarget $ byteToPosixString linkname)+ _ | format == V7Format+ -> OtherEntryType typecode content size+ '3' -> CharacterDevice devmajor devminor+ '4' -> BlockDevice devmajor devminor+ '5' -> Directory+ '6' -> NamedPipe+ '7' -> NormalFile content size+ _ -> OtherEntryType typecode content size,+ entryPermissions = mode,+ entryOwnership = Ownership (BS.Char8.unpack uname)+ (BS.Char8.unpack gname) uid gid,+ entryTime = mtime,+ entryFormat = format+ } - entry = Entry {- entryTarPath = TarPath name prefix,- entryContent = case typecode of- '\0' -> NormalFile content size- '0' -> NormalFile content size- '1' -> HardLink (LinkTarget linkname)- '2' -> SymbolicLink (LinkTarget linkname)- _ | format == V7Format- -> OtherEntryType typecode content size- '3' -> CharacterDevice devmajor devminor- '4' -> BlockDevice devmajor devminor- '5' -> Directory- '6' -> NamedPipe- '7' -> NormalFile content size- _ -> OtherEntryType typecode content size,- entryPermissions = mode,- entryOwnership = Ownership (BS.Char8.unpack uname)- (BS.Char8.unpack gname) uid gid,- entryTime = mtime,- entryFormat = format- }+parseHeader+ :: LBS.ByteString+ -> Either FormatError (BS.ByteString, Permissions, Int, Int, Int64, EpochTime, Char, BS.ByteString, Format, BS.ByteString, BS.ByteString, DevMajor, DevMinor, BS.ByteString)+parseHeader header' = do+ case (chksum_, format_ magic) of+ (Right chksum, _ ) | correctChecksum header chksum -> return ()+ (Right _, Right _) -> Left ChecksumIncorrect+ _ -> Left NotTarFormat - return (Just (entry, bs'))+ mode <- mode_+ uid <- uid_+ gid <- gid_+ size <- size_+ mtime <- mtime_+ format <- format_ magic+ devmajor <- devmajor_+ devminor <- devminor_ + pure (name, mode, uid, gid, size, mtime, typecode, linkname, format, uname, gname, devmajor, devminor, prefix) where- header = LBS.toStrict (LBS.take 512 bs)+ header = LBS.toStrict header' - name = getString 0 100 header- mode_ = getOct 100 8 header- uid_ = getOct 108 8 header- gid_ = getOct 116 8 header- size_ = getOct 124 12 header- mtime_ = getOct 136 12 header- chksum_ = getOct 148 8 header- typecode = getByte 156 header- linkname = getString 157 100 header- magic = getChars 257 8 header- uname = getString 265 32 header- gname = getString 297 32 header- devmajor_ = getOct 329 8 header- devminor_ = getOct 337 8 header- prefix = getString 345 155 header--- trailing = getBytes 500 12 header+ name = getString 0 100 header+ mode_ = getOct 100 8 header+ uid_ = getOct 108 8 header+ gid_ = getOct 116 8 header+ size_ = getOct 124 12 header+ mtime_ = getOct 136 12 header+ chksum_ = getOct 148 8 header+ typecode = getByte 156 header+ linkname = getString 157 100 header+ magic = getChars 257 8 header+ uname = getString 265 32 header+ gname = getString 297 32 header+ devmajor_ = getOct 329 8 header+ devminor_ = getOct 337 8 header+ prefix = getString 345 155 header+ -- trailing = getBytes 500 12 header - format_- | magic == ustarMagic = return UstarFormat- | magic == gnuMagic = return GnuFormat- | magic == v7Magic = return V7Format- | otherwise = Left UnrecognisedTarFormat+format_ :: BS.ByteString -> Either FormatError Format+format_ magic+ | magic == ustarMagic = return UstarFormat+ | magic == gnuMagic = return GnuFormat+ | magic == v7Magic = return V7Format+ | otherwise = Left UnrecognisedTarFormat v7Magic, ustarMagic, gnuMagic :: BS.ByteString v7Magic = BS.Char8.pack "\0\0\0\0\0\0\0\0"
Codec/Archive/Tar/Types.hs view
@@ -1,4 +1,12 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, BangPatterns, DeriveTraversable, ScopedTypeVariables, RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module : Codec.Archive.Tar.Types@@ -65,6 +73,7 @@ foldEntries, foldlEntries, unfoldEntries,+ unfoldEntriesM, ) where import Data.Int (Int64)@@ -87,20 +96,32 @@ ( joinPath, addTrailingPathSeparator, pathSeparator ) import System.Posix.Types ( FileMode )+import "os-string" System.OsString.Posix (PosixString, PosixChar)+import qualified "os-string" System.OsString.Posix as PS import Codec.Archive.Tar.PackAscii +-- | File size in bytes. type FileSize = Int64--- | The number of seconds since the UNIX epoch++-- | The number of seconds since the UNIX epoch. type EpochTime = Int64++-- | Major device number. type DevMajor = Int++-- | Minor device number. type DevMinor = Int++-- | User-defined tar format expansion. type TypeCode = Char++-- | Permissions information for 'GenEntry'. type Permissions = FileMode -- | Polymorphic tar archive entry. High-level interfaces -- commonly work with 'GenEntry' 'FilePath' 'FilePath',--- while low level uses 'GenEntry' 'TarPath' 'LinkTarget'.+-- while low-level ones use 'GenEntry' t'TarPath' t'LinkTarget'. -- -- @since 0.6.0.0 data GenEntry tarPath linkTarget = Entry {@@ -130,14 +151,17 @@ -- type Entry = GenEntry TarPath LinkTarget --- | Native 'FilePath' of the file or directory within the archive.+-- | Low-level function to get a native 'FilePath' of the file or directory+-- within the archive, not accounting for long names. It's likely+-- that you want to apply 'Codec.Archive.Tar.decodeLongNames'+-- and use 'Codec.Archive.Tar.Entry.entryTarPath' afterwards instead of 'entryPath'. -- entryPath :: GenEntry TarPath linkTarget -> FilePath entryPath = fromTarPath . entryTarPath -- | Polymorphic content of a tar archive entry. High-level interfaces -- commonly work with 'GenEntryContent' 'FilePath',--- while low level uses 'GenEntryContent' 'LinkTarget'.+-- while low-level ones use 'GenEntryContent' t'LinkTarget'. -- -- Portable archives should contain only 'NormalFile' and 'Directory'. --@@ -160,6 +184,7 @@ -- ready for serialization / deserialization. type EntryContent = GenEntryContent LinkTarget +-- | Ownership information for 'GenEntry'. data Ownership = Ownership { -- | The owner user name. Should be set to @\"\"@ if unknown. ownerName :: String,@@ -228,7 +253,7 @@ directoryPermissions :: Permissions directoryPermissions = 0o0755 --- | An 'Entry' with all default values except for the file name and type. It+-- | An entry with all default values except for the file name and type. It -- uses the portable USTAR/POSIX format (see 'UstarFormat'). -- -- You can use this as a basis and override specific fields, eg:@@ -248,7 +273,7 @@ entryFormat = UstarFormat } --- | A tar 'Entry' for a file.+-- | A tar entry for a file. -- -- Entry fields such as file permissions and ownership have default values. --@@ -261,24 +286,24 @@ fileEntry name fileContent = simpleEntry name (NormalFile fileContent (LBS.length fileContent)) --- | A tar 'Entry' for a symbolic link.+-- | A tar entry for a symbolic link. symlinkEntry :: tarPath -> linkTarget -> GenEntry tarPath linkTarget symlinkEntry name targetLink = simpleEntry name (SymbolicLink targetLink) -- | [GNU extension](https://www.gnu.org/software/tar/manual/html_node/Standard.html)--- to store a filepath too long to fit into 'entryTarPath'+-- to store a filepath too long to fit into 'Codec.Archive.Tar.Entry.entryTarPath' -- as 'OtherEntryType' @\'L\'@ with the full filepath as 'entryContent'. -- The next entry must contain the actual--- data with truncated 'entryTarPath'.+-- data with truncated 'Codec.Archive.Tar.Entry.entryTarPath'. -- -- See [What exactly is the GNU tar ././@LongLink "trick"?](https://stackoverflow.com/questions/2078778/what-exactly-is-the-gnu-tar-longlink-trick) -- -- @since 0.6.0.0 longLinkEntry :: FilePath -> GenEntry TarPath linkTarget longLinkEntry tarpath = Entry {- entryTarPath = TarPath (BS.Char8.pack "././@LongLink") BS.empty,- entryContent = OtherEntryType 'L' (LBS.fromStrict $ packAscii tarpath) (fromIntegral $ length tarpath),+ entryTarPath = TarPath [PS.pstr|././@LongLink|] mempty,+ entryContent = OtherEntryType 'L' (LBS.fromStrict $ posixToByteString $ toPosixString tarpath) (fromIntegral $ length tarpath), entryPermissions = ordinaryFilePermissions, entryOwnership = Ownership "" "" 0 0, entryTime = 0,@@ -286,23 +311,23 @@ } -- | [GNU extension](https://www.gnu.org/software/tar/manual/html_node/Standard.html)--- to store a link target too long to fit into 'entryTarPath'+-- to store a link target too long to fit into 'Codec.Archive.Tar.Entry.entryTarPath' -- as 'OtherEntryType' @\'K\'@ with the full filepath as 'entryContent'. -- The next entry must contain the actual--- data with truncated 'entryTarPath'.+-- data with truncated 'Codec.Archive.Tar.Entry.entryTarPath'. -- -- @since 0.6.0.0 longSymLinkEntry :: FilePath -> GenEntry TarPath linkTarget longSymLinkEntry linkTarget = Entry {- entryTarPath = TarPath (BS.Char8.pack "././@LongLink") BS.empty,- entryContent = OtherEntryType 'K' (LBS.fromStrict . packAscii $ linkTarget) (fromIntegral $ length linkTarget),+ entryTarPath = TarPath [PS.pstr|././@LongLink|] mempty,+ entryContent = OtherEntryType 'K' (LBS.fromStrict $ posixToByteString $ toPosixString $ linkTarget) (fromIntegral $ length linkTarget), entryPermissions = ordinaryFilePermissions, entryOwnership = Ownership "" "" 0 0, entryTime = 0, entryFormat = GnuFormat } --- | A tar 'Entry' for a directory.+-- | A tar entry for a directory. -- -- Entry fields such as file permissions and ownership have default values. --@@ -337,8 +362,11 @@ -- -- * The directory separator between the prefix and name is /not/ stored. ---data TarPath = TarPath {-# UNPACK #-} !BS.ByteString -- path name, 100 characters max.- {-# UNPACK #-} !BS.ByteString -- path prefix, 155 characters max.+data TarPath = TarPath+ {-# UNPACK #-} !PosixString+ -- ^ path name, 100 characters max.+ {-# UNPACK #-} !PosixString+ -- ^ path prefix, 155 characters max. deriving (Eq, Ord) instance NFData TarPath where@@ -347,7 +375,7 @@ instance Show TarPath where show = show . fromTarPath --- | Convert a 'TarPath' to a native 'FilePath'.+-- | Convert a t'TarPath' to a native 'FilePath'. -- -- The native 'FilePath' will use the native directory separator but it is not -- otherwise checked for validity or sanity. In particular:@@ -361,48 +389,47 @@ -- (e.g., using 'Codec.Archive.Tar.Check.checkEntrySecurity'). -- fromTarPath :: TarPath -> FilePath-fromTarPath = BS.Char8.unpack . fromTarPathInternal FilePath.Native.pathSeparator+fromTarPath = fromPosixString . fromTarPathInternal (PS.unsafeFromChar FilePath.Native.pathSeparator) --- | Convert a 'TarPath' to a Unix\/Posix 'FilePath'.+-- | Convert a t'TarPath' to a Unix\/Posix 'FilePath'. -- -- The difference compared to 'fromTarPath' is that it always returns a Unix -- style path irrespective of the current operating system. ----- This is useful to check how a 'TarPath' would be interpreted on a specific+-- This is useful to check how a t'TarPath' would be interpreted on a specific -- operating system, eg to perform portability checks. -- fromTarPathToPosixPath :: TarPath -> FilePath-fromTarPathToPosixPath = BS.Char8.unpack . fromTarPathInternal FilePath.Posix.pathSeparator+fromTarPathToPosixPath = fromPosixString . fromTarPathInternal (PS.unsafeFromChar FilePath.Posix.pathSeparator) --- | Convert a 'TarPath' to a Windows 'FilePath'.+-- | Convert a t'TarPath' to a Windows 'FilePath'. -- -- The only difference compared to 'fromTarPath' is that it always returns a -- Windows style path irrespective of the current operating system. ----- This is useful to check how a 'TarPath' would be interpreted on a specific+-- This is useful to check how a t'TarPath' would be interpreted on a specific -- operating system, eg to perform portability checks. -- fromTarPathToWindowsPath :: TarPath -> FilePath-fromTarPathToWindowsPath = BS.Char8.unpack . fromTarPathInternal FilePath.Windows.pathSeparator+fromTarPathToWindowsPath = fromPosixString . fromTarPathInternal (PS.unsafeFromChar FilePath.Windows.pathSeparator) -fromTarPathInternal :: Char -> TarPath -> BS.ByteString+fromTarPathInternal :: PosixChar -> TarPath -> PosixString fromTarPathInternal sep = go where- posixSep = FilePath.Posix.pathSeparator+ posixSep = PS.unsafeFromChar FilePath.Posix.pathSeparator adjustSeps = if sep == posixSep then id else- BS.Char8.map $ \c -> if c == posixSep then sep else c+ PS.map $ \c -> if c == posixSep then sep else c go (TarPath name prefix)- | BS.null prefix = adjustSeps name- | BS.null name = adjustSeps prefix- | otherwise = adjustSeps prefix <> BS.Char8.cons sep (adjustSeps name)+ | PS.null prefix = adjustSeps name+ | PS.null name = adjustSeps prefix+ | otherwise = adjustSeps prefix <> PS.cons sep (adjustSeps name) {-# INLINE fromTarPathInternal #-} --- | Convert a native 'FilePath' to a 'TarPath'.+-- | Convert a native 'FilePath' to a t'TarPath'. -- -- The conversion may fail if the 'FilePath' is empty or too long.--- Use 'toTarPath'' for a structured output. toTarPath :: Bool -- ^ Is the path for a directory? This is needed because for- -- directories a 'TarPath' must always use a trailing @\/@.+ -- directories a t'TarPath' must always use a trailing @\/@. -> FilePath -> Either String TarPath toTarPath isDir path = case toTarPath' path' of@@ -414,7 +441,7 @@ then path <> [FilePath.Native.pathSeparator] else path --- | Convert a native 'FilePath' to a 'TarPath'.+-- | Convert a native 'FilePath' to a t'TarPath'. -- Directory paths must always have a trailing @\/@, this is not checked. -- -- @since 0.6.0.0@@ -434,11 +461,11 @@ -- @since 0.6.0.0 data ToTarPathResult = FileNameEmpty- -- ^ 'FilePath' was empty, but 'TarPath' must be non-empty.+ -- ^ 'FilePath' was empty, but t'TarPath' must be non-empty. | FileNameOK TarPath- -- ^ All good, this is just a normal 'TarPath'.+ -- ^ All good, this is just a normal t'TarPath'. | FileNameTooLong TarPath- -- ^ 'FilePath' was longer than 255 characters, 'TarPath' contains+ -- ^ 'FilePath' was longer than 255 characters, t'TarPath' contains -- a truncated part only. An actual entry must be preceded by -- 'longLinkEntry'. @@ -452,12 +479,12 @@ splitLongPath path = case reverse (FilePath.Posix.splitPath path) of [] -> FileNameEmpty c : cs -> case packName nameMax (c :| cs) of- Nothing -> FileNameTooLong $ TarPath (packAscii $ take 100 path) BS.empty- Just (name, []) -> FileNameOK $! TarPath (packAscii name) BS.empty+ Nothing -> FileNameTooLong $ TarPath (toPosixString $ take 100 path) mempty+ Just (name, []) -> FileNameOK $! TarPath (toPosixString name) mempty Just (name, first:rest) -> case packName prefixMax remainder of- Nothing -> FileNameTooLong $ TarPath (packAscii $ take 100 path) BS.empty- Just (_ , _:_) -> FileNameTooLong $ TarPath (packAscii $ take 100 path) BS.empty- Just (prefix, []) -> FileNameOK $! TarPath (packAscii name) (packAscii prefix)+ Nothing -> FileNameTooLong $ TarPath (toPosixString $ take 100 path) mempty+ Just (_ , _:_) -> FileNameTooLong $ TarPath (toPosixString $ take 100 path) mempty+ Just (prefix, []) -> FileNameOK $! TarPath (toPosixString name) (toPosixString prefix) where -- drop the '/' between the name and prefix: remainder = init first :| rest@@ -482,20 +509,20 @@ -- | The tar format allows just 100 ASCII characters for the 'SymbolicLink' and -- 'HardLink' entry types. ---newtype LinkTarget = LinkTarget BS.ByteString+newtype LinkTarget = LinkTarget PosixString deriving (Eq, Ord, Show) instance NFData LinkTarget where rnf (LinkTarget bs) = rnf bs --- | Convert a native 'FilePath' to a tar 'LinkTarget'.+-- | Convert a native 'FilePath' to a tar t'LinkTarget'. -- string is longer than 100 characters or if it contains non-portable -- characters. toLinkTarget :: FilePath -> Maybe LinkTarget toLinkTarget path | length path <= 100 = do target <- toLinkTarget' path- Just $! LinkTarget (packAscii target)+ Just $! LinkTarget (toPosixString target) | otherwise = Nothing data LinkTargetException = IsAbsolute FilePath@@ -507,7 +534,7 @@ displayException (TooLong _) = "The link target is too long" -- | Convert a native 'FilePath' to a unix filepath suitable for--- using as 'LinkTarget'. Does not error if longer than 100 characters.+-- using as t'LinkTarget'. Does not error if longer than 100 characters. toLinkTarget' :: FilePath -> Maybe FilePath toLinkTarget' path | FilePath.Native.isAbsolute path = Nothing@@ -517,18 +544,18 @@ = FilePath.Posix.addTrailingPathSeparator | otherwise = id --- | Convert a tar 'LinkTarget' to a native 'FilePath'.+-- | Convert a tar t'LinkTarget' to a native 'FilePath'. fromLinkTarget :: LinkTarget -> FilePath-fromLinkTarget (LinkTarget pathbs) = fromFilePathToNative $ BS.Char8.unpack pathbs+fromLinkTarget (LinkTarget pathbs) = fromFilePathToNative $ fromPosixString pathbs --- | Convert a tar 'LinkTarget' to a Unix\/POSIX 'FilePath' (@\'/\'@ path separators).+-- | Convert a tar t'LinkTarget' to a Unix\/POSIX 'FilePath' (@\'/\'@ path separators). fromLinkTargetToPosixPath :: LinkTarget -> FilePath-fromLinkTargetToPosixPath (LinkTarget pathbs) = BS.Char8.unpack pathbs+fromLinkTargetToPosixPath (LinkTarget pathbs) = fromPosixString pathbs --- | Convert a tar 'LinkTarget' to a Windows 'FilePath' (@\'\\\\\'@ path separators).+-- | Convert a tar t'LinkTarget' to a Windows 'FilePath' (@\'\\\\\'@ path separators). fromLinkTargetToWindowsPath :: LinkTarget -> FilePath fromLinkTargetToWindowsPath (LinkTarget pathbs) =- fromFilePathToWindowsPath $ BS.Char8.unpack pathbs+ fromFilePathToWindowsPath $ fromPosixString pathbs -- | Convert a unix FilePath to a native 'FilePath'. fromFilePathToNative :: FilePath -> FilePath@@ -554,7 +581,7 @@ -- | Polymorphic sequence of archive entries. -- High-level interfaces -- commonly work with 'GenEntries' 'FilePath' 'FilePath',--- while low level uses 'GenEntries' 'TarPath' 'LinkTarget'.+-- while low-level ones use 'GenEntries' t'TarPath' t'LinkTarget'. -- -- The point of this type as opposed to just using a list is that it makes the -- failure case explicit. We need this because the sequence of entries we get@@ -604,8 +631,23 @@ Right Nothing -> Done Right (Just (e, x')) -> Next e (unfold x') --- | This is like the standard 'foldr' function on lists, but for 'Entries'.--- Compared to 'foldr' it takes an extra function to account for the+unfoldEntriesM+ :: Monad m+ => (forall a. m a -> m a)+ -- ^ id or unsafeInterleaveIO+ -> m (Either e (Maybe (GenEntry tarPath linkTarget)))+ -> m (GenEntries tarPath linkTarget e)+unfoldEntriesM interleave f = unfold+ where+ unfold = do+ f' <- f+ case f' of+ Left err -> pure $ Fail err+ Right Nothing -> pure Done+ Right (Just e) -> Next e <$> interleave unfold++-- | This is like the standard 'Data.List.foldr' function on lists, but for 'Entries'.+-- Compared to 'Data.List.foldr' it takes an extra function to account for the -- possibility of failure. -- -- This is used to consume a sequence of entries. For example it could be used@@ -622,7 +664,7 @@ fold Done = done fold (Fail err) = fail' err --- | A 'foldl'-like function on Entries. It either returns the final+-- | A 'Data.List.foldl'-like function on Entries. It either returns the final -- accumulator result, or the failure along with the intermediate accumulator -- value. --@@ -637,7 +679,7 @@ go !acc Done = Right acc go !acc (Fail err) = Left (err, acc) --- | This is like the standard 'map' function on lists, but for 'Entries'. It+-- | This is like the standard 'Data.List.map' function on lists, but for 'Entries'. It -- includes failure as a extra possible outcome of the mapping function. -- -- If your mapping function cannot fail it may be more convenient to use
Codec/Archive/Tar/Unpack.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# OPTIONS_HADDOCK hide #-} {-# HLINT ignore "Use for_" #-} -----------------------------------------------------------------------------@@ -90,9 +91,12 @@ -> IO () unpack = unpackAndCheck (fmap SomeException . checkEntrySecurity) --- | Like 'unpack', but run custom sanity/security checks instead of 'checkEntrySecurity'.+-- | Like 'Codec.Archive.Tar.unpack', but run custom sanity/security checks instead of 'checkEntrySecurity'. -- For example, --+-- > import Control.Exception (SomeException(..))+-- > import Control.Applicative ((<|>))+-- > -- > unpackAndCheck (\x -> SomeException <$> checkEntryPortability x -- > <|> SomeException <$> checkEntrySecurity x) dir entries --
Codec/Archive/Tar/Write.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Codec.Archive.Tar.Write@@ -12,6 +14,7 @@ ----------------------------------------------------------------------------- module Codec.Archive.Tar.Write (write) where +import Codec.Archive.Tar.PackAscii import Codec.Archive.Tar.Types import Data.Bits@@ -25,7 +28,8 @@ import qualified Data.ByteString.Char8 as BS.Char8 import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as LBS.Char8-+import "os-string" System.OsString.Posix (PosixString)+import qualified "os-string" System.OsString.Posix as PS -- | Create the external representation of a tar archive by serialising a list -- of tar entries.@@ -76,7 +80,7 @@ } = concat- [ putBString 100 name+ [ putPosixString 100 name , putOct 8 permissions , putOct 8 $ ownerId ownership , putOct 8 $ groupId ownership@@ -84,7 +88,7 @@ , putOct 12 modTime , replicate 8 ' ' -- dummy checksum , putChar8 typeCode- , putBString 100 linkTarget+ , putPosixString 100 linkTarget ] ++ case format of V7Format ->@@ -95,7 +99,7 @@ , putString 32 $ groupName ownership , putOct 8 deviceMajor , putOct 8 deviceMinor- , putBString 155 prefix+ , putPosixString 155 prefix , replicate 12 '\NUL' ] GnuFormat -> concat@@ -104,7 +108,7 @@ , putString 32 $ groupName ownership , putGnuDev 8 deviceMajor , putGnuDev 8 deviceMinor- , putBString 155 prefix+ , putPosixString 155 prefix , replicate 12 '\NUL' ] where@@ -141,6 +145,9 @@ putBString :: FieldWidth -> BS.ByteString -> String putBString n s = BS.Char8.unpack (BS.take n s) ++ replicate (n - BS.length s) '\NUL'++putPosixString :: FieldWidth -> PosixString -> String+putPosixString n s = fromPosixString (PS.take n s) ++ replicate (n - PS.length s) '\NUL' putString :: FieldWidth -> String -> String putString n s = take n s ++ replicate (n - length s) '\NUL'
changelog.md view
@@ -1,3 +1,8 @@+## 0.6.1.0 Bodigrim <andrew.lelechenko@gmail.com> January 2024++ * Support Unicode in filenames (encoded as UTF-8).+ * Reduce peak memory consumption when unpacking large files.+ ## 0.6.0.0 Bodigrim <andrew.lelechenko@gmail.com> December 2023 This release features support for long file paths and symlinks@@ -10,16 +15,30 @@ * Functions working on entries have been generalized to more polymorphic types, where possible. * Modules which used to `import Codec.Archive.Tar (Entry(..))` should now- `import Codec.Archive.Tar (GenEntry(..), Entry)` and similar for other `Gen`-types.+ `import Codec.Archive.Tar (Entry, pattern Entry)` and similar for other `Gen`-types.+ Another option is to import the entire module qualified. * Redesign `Codec.Archive.Tar.Check`. * Change types of `checkSecurity`, `checkTarbomb`, `checkPortability`. * Add offending path as new field to `TarBombError` constructor. * Extend `FileNameError` with `UnsafeLinkTarget` constructor. * Drop deprecated `emptyIndex` and `finaliseIndex`. + Examples of migration:++ * [`hackage-security`](https://github.com/haskell/hackage-security/commit/24693ce115c9769fe3c6ec9ca1d137d14d0d27ff)+ * [`archive-backpack`](https://github.com/vmchale/archive-backpack/commit/4b3d1bdff15fcf044d6171ca649a930c775d491b)+ * [`keter`](https://github.com/snoyberg/keter/commit/20a33d9276d5781ca6993b857d8d097085983ede)+ * [`libarchive`](https://github.com/vmchale/libarchive/commit/c0e101fede924a6e12f1d726587626c48444e65d)+ * [`cabal-install`](https://github.com/haskell/cabal/commit/51e6483f95ecb4f395dce36e47af296902a75143)+ * [`ghcup`](https://github.com/haskell/ghcup-hs/commit/6ae312c1f9dd054546e4afe4c969c37cd54b09a9)+ * [`hackage-server`](https://github.com/haskell/hackage-server/commit/6b71d1659500aba50b6a1e48aa53039046720af8)+ Bug fixes: * Add support for over-long filepaths via GNU extension.+ * Now `entryPath` corresponds to an internal, low-level path, limited+ to 255 characters. To list filenames properly use `decodeLongNames`,+ followed by `entryTarPath`. * Fix handling of hardlinks and symlinks. * Handle > 8 GB files insted of silent corruption. * Prohibit non-ASCII file names instead of silent corruption.
tar.cabal view
@@ -1,6 +1,7 @@+cabal-version: 2.2 name: tar-version: 0.6.0.0-license: BSD3+version: 0.6.1.0+license: BSD-3-Clause license-file: LICENSE author: Duncan Coutts <duncan@community.haskell.org> Bjorn Bringert <bjorn@bringert.net>@@ -22,7 +23,6 @@ It also provides features for random access to archive content using an index. build-type: Simple-cabal-version: 2.0 extra-source-files: test/data/long-filepath.tar test/data/long-symlink.tar@@ -55,7 +55,9 @@ deepseq >= 1.1 && < 1.6, directory >= 1.3.1 && < 1.4, filepath < 1.6,- time < 1.13+ os-string >= 2.0 && < 2.1,+ time < 1.13,+ transformers < 0.7, exposed-modules: Codec.Archive.Tar
test/Codec/Archive/Tar/Index/StringTable/Tests.hs view
@@ -49,7 +49,7 @@ where _tbl :: StringTable Int _tbl@(StringTable strs offsets ids _ixs) = construct strings- isSorted xs = and (zipWith (<) xs (tail xs))+ isSorted xs = and (zipWith (<) xs (drop 1 xs)) prop_finalise_unfinalise :: [BS.ByteString] -> Property prop_finalise_unfinalise strs =
test/Codec/Archive/Tar/Index/Tests.hs view
@@ -70,9 +70,10 @@ _ -> property False where index = construct paths- completions = [ head (FilePath.splitDirectories completion)+ completions = [ hd | (path,_) <- paths- , completion <- maybeToList $ stripPrefix (p ++ "/") path ]+ , completion <- maybeToList $ stripPrefix (p ++ "/") path+ , let hd : _ = FilePath.splitDirectories completion ] prop_toList :: ValidPaths -> Property prop_toList (ValidPaths paths) =@@ -248,7 +249,7 @@ , 1022 , 1023 , 1024 , 1025 , 1026 ] --- | 'IndexBuilder' constructed from a 'SimpleIndex'+-- | t'IndexBuilder' constructed from a 'SimpleIndex' newtype SimpleIndexBuilder = SimpleIndexBuilder IndexBuilder deriving Show
test/Codec/Archive/Tar/Pack/Tests.hs view
@@ -13,24 +13,39 @@ import Control.DeepSeq import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL+import Data.Char import Data.FileEmbed import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Pack as Pack-import Codec.Archive.Tar.Types (GenEntries(..), Entries, simpleEntry, toTarPath)+import Codec.Archive.Tar.Types (GenEntries(..), Entries, simpleEntry, toTarPath, GenEntry (entryTarPath)) import qualified Codec.Archive.Tar.Unpack as Unpack import qualified Codec.Archive.Tar.Write as Write import Control.Exception import Data.List.NonEmpty (NonEmpty(..))+import GHC.IO.Encoding import System.Directory import System.FilePath+import qualified System.FilePath.Posix as Posix import qualified System.Info import System.IO.Temp+import System.IO.Unsafe import Test.Tasty.QuickCheck +supportsUnicode :: Bool+supportsUnicode = unsafePerformIO $ do+ -- Normally getFileSystemEncoding returns a Unicode encoding,+ -- but if it is ASCII, we should not generate Unicode filenames.+ enc <- getFileSystemEncoding+ pure $ case textEncodingName enc of+ "ASCII" -> False+ "ANSI_X3.4-1968" -> False+ _ -> True+{-# NOINLINE supportsUnicode #-}+ -- | Write a single file, deeply buried within nested folders; -- pack and unpack; read back and compare results.-prop_roundtrip :: [ASCIIString] -> ASCIIString -> Property-prop_roundtrip xss (ASCIIString cnt)+prop_roundtrip :: [String] -> String -> Property+prop_roundtrip xss cnt | x : xs <- filter (not . null) $ map mkFilePath xss = ioProperty $ withSystemTempDirectory "tar-test" $ \baseDir -> do file : dirs <- pure $ trimUpToMaxPathLength baseDir (x : xs)@@ -39,38 +54,82 @@ absDir = baseDir </> relDir relFile = relDir </> file absFile = absDir </> file- createDirectoryIfMissing True absDir- writeFile absFile cnt- -- Forcing the result, otherwise lazy IO misbehaves.- !entries <- Pack.pack baseDir [relFile] >>= evaluate . force+ errMsg = "relDir = " ++ relDir +++ "\nabsDir = " ++ absDir +++ "\nrelFile = " ++ relFile +++ "\nabsFile = " ++ absFile - -- Try hard to clean up- removeFile absFile- writeFile absFile "<should be overwritten>"- case dirs of- [] -> pure ()- d : _ -> removeDirectoryRecursive (baseDir </> d)+ -- Not all filesystems allow paths to contain arbitrary Unicode.+ -- E. g., at the moment of writing Apple FS does not support characters+ -- introduced in Unicode 15.0.+ canCreateDirectory <- try (createDirectoryIfMissing True absDir)+ case canCreateDirectory of+ Left (e :: IOException) -> discard+ Right () -> do+ canWriteFile <- try (writeFile absFile cnt)+ case canWriteFile of+ Left (e :: IOException) -> discard+ Right () -> counterexample errMsg <$> do - -- Unpack back- Unpack.unpack baseDir (foldr Next Done entries :: Entries IOException)- cnt' <- readFile absFile- pure $ cnt === cnt'+ -- Forcing the result, otherwise lazy IO misbehaves.+ !entries <- Pack.pack baseDir [relFile] >>= evaluate . force + let fileNames+ = map (map (\c -> if c == Posix.pathSeparator then pathSeparator else c))+ $ Tar.foldEntries ((:) . entryTarPath) [] undefined+ -- decodeLongNames produces FilePath with POSIX path separators+ $ Tar.decodeLongNames $ foldr Next Done entries++ if [relFile] /= fileNames then pure ([relFile] === fileNames) else do++ -- Try hard to clean up+ removeFile absFile+ writeFile absFile "<should be overwritten>"+ case dirs of+ [] -> pure ()+ d : _ -> removeDirectoryRecursive (baseDir </> d)++ -- Unpack back+ Unpack.unpack baseDir (foldr Next Done entries :: Entries IOException)+ exist <- doesFileExist absFile+ if exist then do+ cnt' <- readFile absFile >>= evaluate . force+ pure $ cnt === cnt'+ else do+ -- Forcing the result, otherwise lazy IO misbehaves.+ recFiles <- Pack.getDirectoryContentsRecursive baseDir >>= evaluate . force+ pure $ counterexample ("File " ++ absFile ++ " does not exist; instead found\n" ++ unlines recFiles) False+ | otherwise = discard -mkFilePath :: ASCIIString -> FilePath-mkFilePath (ASCIIString xs) = makeValid $- filter (\c -> not $ isPathSeparator c || c `elem` [' ', '.', ':']) xs+mkFilePath :: String -> FilePath+mkFilePath xs = makeValid $ filter isGood $+ map (if supportsUnicode then id else chr . (`mod` 128) . ord) xs+ where+ isGood c+ = not (isPathSeparator c)+ && c `notElem` [' ', '\n', '\r', '.', ':']+ && generalCategory c /= Surrogate+ && (supportsUnicode || isAscii c) trimUpToMaxPathLength :: FilePath -> [FilePath] -> [FilePath]-trimUpToMaxPathLength baseDir = go (maxPathLength - length baseDir - 1)+trimUpToMaxPathLength baseDir = go (maxPathLength - utf8Length baseDir - 1) where go :: Int -> [FilePath] -> [FilePath] go cnt [] = [] go cnt (x : xs)- | cnt <= 0 = []- | cnt <= length x = [take cnt x]- | otherwise = x : go (cnt - length x - 1) xs+ | cnt < 4 = []+ | cnt <= utf8Length x = [take (cnt `quot` 4) x]+ | otherwise = x : go (cnt - utf8Length x - 1) xs++utf8Length :: String -> Int+utf8Length = sum . map charLength+ where+ charLength c+ | c < chr 0x80 = 1+ | c < chr 0x800 = 2+ | c < chr 0x10000 = 3+ | otherwise = 4 maxPathLength :: Int maxPathLength = case System.Info.os of
test/Codec/Archive/Tar/Types/Tests.hs view
@@ -17,6 +17,7 @@ , prop_fromTarPathToWindowsPath ) where +import Codec.Archive.Tar.PackAscii import Codec.Archive.Tar.Types import qualified Data.ByteString as BS@@ -49,8 +50,8 @@ FilePath.Native.joinPath $ FilePath.Posix.splitDirectories prefix ++ FilePath.Posix.splitDirectories name where- name = BS.Char8.unpack namebs- prefix = BS.Char8.unpack prefixbs+ name = BS.Char8.unpack $ posixToByteString namebs+ prefix = BS.Char8.unpack $ posixToByteString prefixbs adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name = FilePath.Native.addTrailingPathSeparator | otherwise = id@@ -60,8 +61,8 @@ FilePath.Posix.joinPath $ FilePath.Posix.splitDirectories prefix ++ FilePath.Posix.splitDirectories name where- name = BS.Char8.unpack namebs- prefix = BS.Char8.unpack prefixbs+ name = BS.Char8.unpack $ posixToByteString namebs+ prefix = BS.Char8.unpack $ posixToByteString prefixbs adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name = FilePath.Posix.addTrailingPathSeparator | otherwise = id@@ -71,8 +72,8 @@ FilePath.Windows.joinPath $ FilePath.Posix.splitDirectories prefix ++ FilePath.Posix.splitDirectories name where- name = BS.Char8.unpack namebs- prefix = BS.Char8.unpack prefixbs+ name = BS.Char8.unpack $ posixToByteString namebs+ prefix = BS.Char8.unpack $ posixToByteString prefixbs adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name = FilePath.Windows.addTrailingPathSeparator | otherwise = id@@ -220,6 +221,6 @@ }, entryTarPath = let TarPath name _prefix = entryTarPath entry- in TarPath name BS.empty+ in TarPath name mempty } limitToV7FormatCompat entry = entry
test/Properties.hs view
@@ -64,6 +64,7 @@ ] , testGroup "pack" [+ adjustOption (\(QuickCheckMaxRatio n) -> QuickCheckMaxRatio (max n 100)) $ testProperty "roundtrip" Pack.prop_roundtrip, testProperty "symlink" Pack.unit_roundtrip_symlink, testProperty "long filepath" Pack.unit_roundtrip_long_filepath,