diff --git a/Codec/Archive/Tar.hs b/Codec/Archive/Tar.hs --- a/Codec/Archive/Tar.hs +++ b/Codec/Archive/Tar.hs @@ -159,13 +159,17 @@ import Codec.Archive.Tar.Check -import Control.Exception (Exception, throw, catch) +import Control.Exception.Safe (Exception, throw, catch, throwIO, finally, bracketOnError) import qualified Data.ByteString.Lazy as BS -import System.IO (withFile, IOMode(..)) +import System.IO (hClose, withFile, IOMode(..)) import Prelude hiding (read, readFile) -import HPath.IO +import System.Posix.RawFilePath.Directory import System.Posix.IO (OpenMode(..)) +import qualified System.Posix.IO.ByteString as SPI +import System.Posix.FD ( openFd ) +import System.Posix.RawFilePath.Directory.Errors + -- | Create a new @\".tar\"@ file from a directory of files. -- -- It is equivalent to calling the standard @tar@ program like so: @@ -202,10 +206,7 @@ -> [RawFilePath] -- ^ Files and directories to archive, relative to base dir -> IO () create tar base paths = - withRawFilePath tar $ (\p -> either go go p) - - where - go p = writeFileL p (Just newFilePerms) . write =<< pack base paths + writeFileL tar (Just newFilePerms) . write =<< pack base paths -- | Extract all the files contained in a @\".tar\"@ file. -- @@ -238,7 +239,7 @@ extract :: RawFilePath -- ^ Destination directory -> RawFilePath -- ^ Tarball -> IO () -extract dir tar = unpack dir . read =<< (withRawFilePath tar $ either readFile readFile) +extract dir tar = unpack dir . read =<< (readFile tar) -- | Append new entries to a @\".tar\"@ file from a directory of files. -- @@ -250,10 +251,16 @@ -> RawFilePath -- ^ Base directory -> [RawFilePath] -- ^ Files and directories to archive, relative to base dir -> IO () -append tar base paths = - withHandle tar ReadWrite $ \(hnd, _) -> do - _ <- hSeekEndEntryOffset hnd Nothing - BS.hPut hnd . write =<< pack base paths +append tar base paths = do + handle <- + bracketOnError (openFd tar ReadWrite [] (Just newFilePerms)) (SPI.closeFd) + $ SPI.fdToHandle + finally (action handle) (hClose handle) + + where + action handle = do + _ <- hSeekEndEntryOffset handle Nothing + BS.hPut handle . write =<< pack base paths ------------------------- -- Correctness properties 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 @@ -31,7 +31,7 @@ import Codec.Archive.Tar.Types import Data.Typeable (Typeable) -import Control.Exception (Exception) +import Control.Exception.Safe (Exception) import Control.Monad (MonadPlus(mplus)) import qualified System.Posix.FilePath as FilePath.Posix import qualified Data.ByteString as BS diff --git a/Codec/Archive/Tar/Index.hs b/Codec/Archive/Tar/Index.hs --- a/Codec/Archive/Tar/Index.hs +++ b/Codec/Archive/Tar/Index.hs @@ -106,7 +106,7 @@ import qualified Data.Array.Unboxed as A import Prelude hiding (lookup) import System.IO -import Control.Exception (assert, throwIO) +import Control.Exception.Safe (assert, throwIO) import Control.DeepSeq import qualified Data.ByteString as BS @@ -132,7 +132,7 @@ import Data.List (nub, sort, sortBy, stripPrefix, isPrefixOf) import Data.Maybe import Data.Function (on) -import Control.Exception (SomeException, try) +import Control.Exception.Safe (SomeException, try) import Codec.Archive.Tar.Write as Tar import qualified Data.ByteString.Handle as HBS #endif diff --git a/Codec/Archive/Tar/Index/IntTrie.hs b/Codec/Archive/Tar/Index/IntTrie.hs --- a/Codec/Archive/Tar/Index/IntTrie.hs +++ b/Codec/Archive/Tar/Index/IntTrie.hs @@ -56,7 +56,7 @@ #else import Data.ByteString.Lazy.Builder as BS #endif -import Control.Exception (assert) +import Control.Exception.Safe (assert) #if MIN_VERSION_containers(0,5,0) import qualified Data.Map.Strict as Map import qualified Data.IntMap.Strict as IntMap diff --git a/Codec/Archive/Tar/Index/StringTable.hs b/Codec/Archive/Tar/Index/StringTable.hs --- a/Codec/Archive/Tar/Index/StringTable.hs +++ b/Codec/Archive/Tar/Index/StringTable.hs @@ -40,7 +40,7 @@ #if (MIN_VERSION_base(4,5,0)) import Data.Monoid ((<>)) #endif -import Control.Exception (assert) +import Control.Exception.Safe (assert) import qualified Data.Array.Unboxed as A import Data.Array.Unboxed ((!)) 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 @@ -28,8 +28,7 @@ import System.Posix.ByteString.FilePath (RawFilePath) import qualified System.Posix.FilePath as FilePath.Posix import System.Posix.FilePath ( (), isSpecialDirectoryEntry ) -import HPath (toFilePath) -import HPath.IO +import System.Posix.RawFilePath.Directory import Data.Time.Clock ( UTCTime ) import Data.Time.Clock.POSIX @@ -62,7 +61,7 @@ preparePaths :: RawFilePath -> [RawFilePath] -> IO [RawFilePath] preparePaths baseDir paths = fmap concat $ interleave - [ do isDir <- withRawFilePath (baseDir path) $ \p -> either doesDirectoryExist doesDirectoryExist p + [ do isDir <- doesDirectoryExist (baseDir path) if isDir then do entries <- getDirectoryContentsRecursive (baseDir path) let entries' = map (path ) entries @@ -104,7 +103,7 @@ -> IO Entry packFileEntry filepath tarpath = do mtime <- getModTime filepath - executable <- withRawFilePath filepath $ either isExecutable isExecutable + executable <- isExecutable filepath file <- openFd filepath SPI.ReadOnly [] Nothing >>= SPI.fdToHandle size <- hFileSize file content <- L.hGetContents file @@ -151,7 +150,7 @@ recurseDirectories :: RawFilePath -> [RawFilePath] -> IO [RawFilePath] recurseDirectories _ [] = return [] recurseDirectories base (dir:dirs) = unsafeInterleaveIO $ do - (files, dirs') <- collect [] [] =<< ((fmap . fmap) toFilePath $ (withRawFilePath (base dir) $ either getDirsFiles' getDirsFiles')) + (files, dirs') <- collect [] [] =<< (getDirsFiles' (base dir)) files' <- recurseDirectories base (dirs' ++ dirs) return (dir : files ++ files') @@ -163,7 +162,7 @@ collect files dirs' (entry:entries) = do let dirEntry = dir entry dirEntry' = FilePath.Posix.addTrailingPathSeparator dirEntry - isDirectory <- withRawFilePath (base dirEntry) $ either doesDirectoryExist doesDirectoryExist + isDirectory <- doesDirectoryExist (base dirEntry) if isDirectory then collect files (dirEntry':dirs') entries else collect (dirEntry:files) dirs' entries @@ -171,5 +170,5 @@ getModTime :: RawFilePath -> IO EpochTime getModTime path = do - t <- withRawFilePath path $ either getModificationTime getModificationTime + t <- getModificationTime path return . floor . utcTimeToPOSIXSeconds $ t 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 @@ -19,7 +19,7 @@ import Data.Char (ord) import Data.Int (Int64) import Data.Bits (Bits(shiftL)) -import Control.Exception (Exception(..)) +import Control.Exception.Safe (Exception(..)) import Data.Typeable (Typeable) import Control.Applicative import Control.Monad 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 @@ -24,18 +24,17 @@ ( () ) import qualified System.Posix.FilePath as FilePath.Native ( takeDirectory ) -import Control.Exception ( Exception - , throwIO - , finally - ) +import Control.Exception.Safe ( Exception + , throwIO + , finally + ) import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) -import Control.Exception as Exception +import Control.Exception.Safe as Exception ( catch ) import System.IO.Error ( isPermissionError ) -import HPath hiding (()) -import HPath.IO hiding (Directory, SymbolicLink) +import System.Posix.RawFilePath.Directory hiding (Directory, SymbolicLink) import qualified System.Posix.IO.ByteString as SPI import qualified System.Posix as Posix import System.Posix.FD @@ -91,19 +90,15 @@ -- Note that tar archives do not make sure each directory is created -- before files they contain, indeed we may have to create several -- levels of directory. - withRawFilePath absDir (\p -> either (createDirRecursive newDirPerms) - (createDirRecursive newDirPerms) p) - withRawFilePath absPath (\p -> case p of - Right x -> writeFileL x (Just newFilePerms) content - Left x -> writeFileL x (Just newFilePerms) content) + createDirRecursive newDirPerms absDir + writeFileL absPath (Just newFilePerms) content setModTime absPath mtime where absDir = baseDir FilePath.Native.takeDirectory path absPath = baseDir path extractDir path mtime = do - withRawFilePath absPath $ \p -> either (createDirRecursive newDirPerms) - (createDirRecursive newDirPerms) p + createDirRecursive newDirPerms absPath setModTime absPath mtime where absPath = baseDir path @@ -116,16 +111,9 @@ emulateLinks = mapM_ $ \(relPath, relLinkTarget) -> do let absPath = baseDir relPath absTarget = FilePath.Native.takeDirectory absPath relLinkTarget - let copy x y = copyFile x y Overwrite - withRawFilePath absPath $ \absPath' -> withRawFilePath absTarget $ \absTarget' -> case (absTarget', absPath') of - (Right x, Right y) -> copy x y - (Left x, Right y) -> copy x y - (Right x, Left y) -> copy x y - (Left x, Left y) -> copy x y + copyFile absTarget absPath Overwrite setModTime :: RawFilePath -> EpochTime -> IO () -setModTime path t = withRawFilePath path $ \p -> either go go p - where - go p = setModificationTime p (fromIntegral t) +setModTime p t = setModificationTime p (fromIntegral t) `Exception.catch` \e -> if isPermissionError e then return () else throwIO e diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,14 @@ See also http://pvp.haskell.org/faq +0.6.1.1 + + * Use hpath-directory instead of hpath-io for a more lightweight dependency + * use safe-exceptions + +0.6.1.0 + + * Use ByteString based filepaths to not break unicode + 0.6.0.0 *TODO* * Add offending path as new field to `TarBombError` constructor diff --git a/tar-bytestring.cabal b/tar-bytestring.cabal --- a/tar-bytestring.cabal +++ b/tar-bytestring.cabal @@ -1,5 +1,5 @@ name: tar-bytestring -version: 0.6.1.0 +version: 0.6.1.1 license: BSD3 license-file: LICENSE author: Duncan Coutts @@ -11,7 +11,10 @@ 2020 Julian Ospald category: Codec synopsis: Reading, writing and manipulating ".tar" archive files. -description: This library is for working with \"@.tar@\" archive files. It +description: Fork of 'tar' package, which currently breaks + Unicode filepaths, by utilizing ByteString.Char8. + + This library is for working with \"@.tar@\" archive files. It can read and write a range of common variations of archive format including V7, POSIX USTAR and GNU formats. . @@ -39,11 +42,11 @@ bytestring >= 0.10, array < 0.6, time >= 1.8, - containers >= 0.2 && < 0.6, + containers >= 0.2 && < 0.7, deepseq >= 1.1 && < 1.5, - hpath-io >= 0.12.0 && < 0.13, - hpath >= 0.11.0 && < 0.12, + hpath-directory >= 0.13 && < 0.14, hpath-filepath >= 0.10.2 && < 0.11, + safe-exceptions >= 0.1, unix, word8 @@ -90,9 +93,9 @@ QuickCheck == 2.*, tasty >= 0.10, tasty-quickcheck >= 0.8, - hpath-io >= 0.12.0 && < 0.13, - hpath >= 0.11.0 && < 0.12, + hpath-directory >= 0.13.0 && < 0.14, hpath-filepath >= 0.10.2 && < 0.11, + safe-exceptions >= 0.1, unix, word8 @@ -142,9 +145,9 @@ deepseq, time, criterion >= 1.0, - hpath-io >= 0.12.0 && < 0.13, - hpath >= 0.11.0 && < 0.12, + hpath-directory >= 0.13 && < 0.14, hpath-filepath >= 0.10.2 && < 0.11, + safe-exceptions >= 0.1, unix, word8