diff --git a/Codec/Archive/Tar.hs b/Codec/Archive/Tar.hs --- a/Codec/Archive/Tar.hs +++ b/Codec/Archive/Tar.hs @@ -34,10 +34,10 @@ -- -- It can read and write standard POSIX tar files and also the GNU and old -- Unix V7 tar formats. The convenience functions that are provided in the - -- "Codec.Archive.Tar.Entry" module for creating achive entries are primarily - -- designed for standard portable archives. If you need to construct GNU - -- format archives or exactly preserve file ownership and permissions then - -- you will need to write some extra helper functions. + -- "Codec.Archive.Tar.Entry" module for creating archive entries are + -- primarily designed for standard portable archives. If you need to + -- construct GNU format archives or exactly preserve file ownership and + -- permissions then you will need to write some extra helper functions. -- -- This module contains just the simple high level operations without -- exposing the all the details of tar files. If you need to inspect tar @@ -50,7 +50,7 @@ -- * Notes -- ** Compressed tar archives - -- | Tar files are commonly used in conjuction with gzip compression, as in + -- | Tar files are commonly used in conjunction with gzip 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 @@ -84,10 +84,10 @@ -- 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 - -- vulnerabilites have been common in packages handling tar archives. + -- 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 detials. If you need to do any custom + -- 'checkSecurity' function for more details. If you need to do any custom -- unpacking then you should use this. -- * Converting between internal and external representation @@ -101,7 +101,7 @@ -- * Packing and unpacking files to\/from internal representation -- | These functions are for packing and unpacking portable archives. They -- are not suitable in cases where it is important to preserve file ownership - -- and permissions or to archive special files like named pipes and unix + -- and permissions or to archive special files like named pipes and Unix -- device files. pack, unpack, @@ -144,8 +144,8 @@ -- @$ tar -f tarball.tar -C base -c dir@ -- -- This assumes a directory @.\/base\/dir@ with files inside, eg --- @./base/dir/foo.txt@. The file names inside the resulting tar file will be --- relative to @dir@, eg @dir/foo.txt@. +-- @.\/base\/dir\/foo.txt@. The file names inside the resulting tar file will be +-- relative to @dir@, eg @dir\/foo.txt@. -- -- 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: @@ -180,8 +180,8 @@ -- -- @$ tar -x -f tarball.tar -C dir@ -- --- So for example if the @tarball.tar@ file contains @foo/bar.txt@ then this --- will extract it to @dir/foo/bar.txt@. +-- So for example if the @tarball.tar@ file contains @foo\/bar.txt@ then this +-- will extract it to @dir\/foo\/bar.txt@. -- -- 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: diff --git a/Codec/Archive/Tar/Check.hs b/Codec/Archive/Tar/Check.hs --- a/Codec/Archive/Tar/Check.hs +++ b/Codec/Archive/Tar/Check.hs @@ -35,7 +35,7 @@ -- * file names are valid -- -- These checks are from the perspective of the current OS. That means we check --- for \"@C:\blah@\" files on Windows and \"\/blah\" files on unix. For archive +-- for \"@C:\blah@\" files on Windows and \"\/blah\" files on Unix. For archive -- entry types 'HardLink' and 'SymbolicLink' the same checks are done for the -- link target. A failure in any entry terminates the sequence of entries with -- an error. diff --git a/Codec/Archive/Tar/Entry.hs b/Codec/Archive/Tar/Entry.hs --- a/Codec/Archive/Tar/Entry.hs +++ b/Codec/Archive/Tar/Entry.hs @@ -12,7 +12,7 @@ -- Types and functions to manipulate tar entries. -- -- While the "Codec.Archive.Tar" module provides only the simple high level --- api, this module provides full access to the details of tar entries. This +-- API, this module provides full access to the details of tar entries. This -- lets you inspect all the meta-data, construct entries and handle error cases -- more precisely. -- diff --git a/Codec/Archive/Tar/Pack.hs b/Codec/Archive/Tar/Pack.hs --- a/Codec/Archive/Tar/Pack.hs +++ b/Codec/Archive/Tar/Pack.hs @@ -60,20 +60,25 @@ preparePaths :: FilePath -> [FilePath] -> IO [FilePath] preparePaths baseDir paths = fmap concat $ interleave - [ do isDir <- doesDirectoryExist path - if isDir then getDirectoryContentsRecursive (baseDir path) - else return [path] + [ do isDir <- doesDirectoryExist (baseDir path) + if isDir + then do entries <- getDirectoryContentsRecursive (baseDir path) + let entries' = map (path ) entries + dir = FilePath.Native.addTrailingPathSeparator path + if null path then return entries' + else return (dir : entries') + else return [path] | path <- paths ] packPaths :: FilePath -> [FilePath] -> IO [Entry] packPaths baseDir paths = interleave - [ do tarpath <- either fail return (toTarPath isDir relPath) + [ do tarpath <- either fail return (toTarPath isDir relpath) if isDir then packDirectoryEntry filepath tarpath else packFileEntry filepath tarpath - | filepath <- paths - , let isDir = FilePath.Native.hasTrailingPathSeparator filepath - relPath = FilePath.Native.makeRelative baseDir filepath ] + | relpath <- paths + , let isDir = FilePath.Native.hasTrailingPathSeparator filepath + filepath = baseDir relpath ] interleave :: [IO a] -> IO [a] interleave = unsafeInterleaveIO . go @@ -131,7 +136,7 @@ -- All directories are listed before the files that they contain. Amongst the -- contents of a directory, subdirectories are listed after normal files. The -- overall result is that files within a directory will be together in a single --- contiguous group. This tends to improve file layout an IO performance when +-- contiguous group. This tends to improve file layout and IO performance when -- creating or extracting tar archives. -- -- * This function returns results lazily. Subdirectories are not scanned @@ -139,14 +144,14 @@ -- getDirectoryContentsRecursive :: FilePath -> IO [FilePath] getDirectoryContentsRecursive dir0 = - recurseDirectories [FilePath.Native.addTrailingPathSeparator dir0] + fmap tail (recurseDirectories dir0 [""]) -recurseDirectories :: [FilePath] -> IO [FilePath] -recurseDirectories [] = return [] -recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do - (files, dirs') <- collect [] [] =<< getDirectoryContents dir +recurseDirectories :: FilePath -> [FilePath] -> IO [FilePath] +recurseDirectories _ [] = return [] +recurseDirectories base (dir:dirs) = unsafeInterleaveIO $ do + (files, dirs') <- collect [] [] =<< getDirectoryContents (base dir) - files' <- recurseDirectories (dirs' ++ dirs) + files' <- recurseDirectories base (dirs' ++ dirs) return (dir : files ++ files') where @@ -156,7 +161,7 @@ collect files dirs' (entry:entries) = do let dirEntry = dir entry dirEntry' = FilePath.Native.addTrailingPathSeparator dirEntry - isDirectory <- doesDirectoryExist dirEntry + isDirectory <- doesDirectoryExist (base dirEntry) if isDirectory then collect files (dirEntry':dirs') entries else collect (dirEntry:files) dirs' entries diff --git a/Codec/Archive/Tar/Read.hs b/Codec/Archive/Tar/Read.hs --- a/Codec/Archive/Tar/Read.hs +++ b/Codec/Archive/Tar/Read.hs @@ -136,7 +136,7 @@ parseOct ('\128':_) = fail "tar header uses non-standard number encoding" parseOct s = case readOct s of [(x,[])] -> return x - _ -> fail "tar header is malformatted (bad numeric encoding)" + _ -> fail "tar header is malformed (bad numeric encoding)" getBytes :: Int64 -> Int64 -> ByteString -> ByteString getBytes off len = BS.take len . BS.drop off diff --git a/Codec/Archive/Tar/Types.hs b/Codec/Archive/Tar/Types.hs --- a/Codec/Archive/Tar/Types.hs +++ b/Codec/Archive/Tar/Types.hs @@ -145,7 +145,7 @@ V7Format -- | The \"USTAR\" format is an extension of the classic V7 format. It was - -- later standardised by POSIX. It has some restructions but is the most + -- later standardised by POSIX. It has some restrictions but is the most -- portable format. -- | UstarFormat @@ -212,12 +212,12 @@ -- * Tar paths -- --- | The classic tar format allowed just 100 charcters for the file name. The +-- | The classic tar format allowed just 100 characters for the file name. The -- USTAR format extended this with an extra 155 characters, however it uses a -- complex method of splitting the name between the two sections. -- -- Instead of just putting any overflow into the extended area, it uses the --- extended area as a prefix. The agrevating insane bit however is that the +-- extended area as a prefix. The aggravating insane bit however is that the -- prefix (if any) must only contain a directory prefix. That is the split -- between the two areas must be on a directory separator boundary. So there is -- no simple calculation to work out if a file name is too long. Instead we @@ -231,7 +231,7 @@ -- -- So it's understandable but rather annoying. -- --- * Tar paths use posix format (ie @\'/\'@ directory separators), irrespective +-- * Tar paths use Posix format (ie @\'/\'@ directory separators), irrespective -- of the local path conventions. -- -- * The directory separator between the prefix and name is /not/ stored. @@ -245,8 +245,8 @@ -- The native 'FilePath' will use the native directory separator but it is not -- otherwise checked for validity or sanity. In particular: -- --- * The tar path may be invalid as a native path, eg the filename @\"nul\"@ is --- not valid on Windows. +-- * The tar path may be invalid as a native path, eg the file name @\"nul\"@ +-- is not valid on Windows. -- -- * The tar path may be an absolute path or may contain @\"..\"@ components. -- For security reasons this should not usually be allowed, but it is your @@ -311,10 +311,10 @@ addTrailingSep | isDir = FilePath.Posix.addTrailingPathSeparator | otherwise = id --- | Take a sanitized path, split on directory separators and try to pack it +-- | Take a sanitised path, split on directory separators and try to pack it -- into the 155 + 100 tar file name format. -- --- The stragey is this: take the name-directory components in reverse order +-- The strategy is this: take the name-directory components in reverse order -- and try to fit as many components into the 100 long name area as possible. -- If all the remaining components fit in the 155 name area then we win. -- @@ -347,7 +347,7 @@ where n' = n + length c packName' _ _ ok cs = (FilePath.Posix.joinPath ok, cs) --- | The tar format allows just 100 ASCII charcters for the 'SymbolicLink' and +-- | The tar format allows just 100 ASCII characters for the 'SymbolicLink' and -- 'HardLink' entry types. -- newtype LinkTarget = LinkTarget FilePath @@ -371,7 +371,7 @@ = FilePath.Native.addTrailingPathSeparator | otherwise = id --- | Convert a tar 'LinkTarget' to a unix/posix 'FilePath'. +-- | Convert a tar 'LinkTarget' to a Unix/Posix 'FilePath'. -- fromLinkTargetToPosixPath :: LinkTarget -> FilePath fromLinkTargetToPosixPath (LinkTarget path) = adjustDirectory $ @@ -416,7 +416,7 @@ | Fail String -- | This is like the standard 'unfoldr' function on lists, but for 'Entries'. --- It includes failure as an extra posibility that the stepper function may +-- It includes failure as an extra possibility that the stepper function may -- return. -- -- It can be used to generate 'Entries' from some other type. For example it is @@ -431,8 +431,8 @@ 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 posibility --- of failure. +-- Compared to '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 -- to scan a tarball for problems or to collect an index of the contents. diff --git a/Codec/Archive/Tar/Unpack.hs b/Codec/Archive/Tar/Unpack.hs --- a/Codec/Archive/Tar/Unpack.hs +++ b/Codec/Archive/Tar/Unpack.hs @@ -35,9 +35,10 @@ -- exception is raised. -- -- If the 'Entries' ends in an error then it is raised an an IO error. Any --- files or directories that have been upacked before the error was encountered --- will not be deleted. For this reason you may want to unpack into an empty --- directory so that you can easily clean up if unpacking fails part-way. +-- files or directories that have been unpacked before the error was +-- encountered will not be deleted. For this reason you may want to unpack +-- into an empty directory so that you can easily clean up if unpacking fails +-- part-way. -- -- On its own, this function only checks for security (using 'checkSecurity'). -- You can do other checks by applying checking functions to the 'Entries' that diff --git a/tar.cabal b/tar.cabal --- a/tar.cabal +++ b/tar.cabal @@ -1,5 +1,5 @@ name: tar -version: 0.3.0.0 +version: 0.3.1.0 license: BSD3 license-File: LICENSE author: Bjorn Bringert