tar-conduit 0.2.3.1 → 0.2.4

raw patch · 7 files changed

+175/−67 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• src/Data/Conduit/Tar.hs +68/−4
• src/Data/Conduit/Tar/Types.hs +1/−0
• src/Data/Conduit/Tar/Unix.hs +38/−26
• src/Data/Conduit/Tar/Windows.hs +33/−17
• tar-conduit.cabal +5/−6
• tests/Spec.hs +26/−14

@@ -1,3 +1,7 @@+## 0.2.4 - 2018-08-28+ * Use forward slashes on Windows too, see [issue #21](https://github.com/snoyberg/tar-conduit/issues/21)+ * Addition of `extractTarballLenient`+ ## 0.2.3.1 - 2018-06-06  * Fixed drops associated payload for unsupported headers ((https://github.com/snoyberg/tar-conduit/issues/17)) ([PR 18](https://github.com/snoyberg/tar-conduit/pull/18))  * Dropped support for GHC 7/Stack LTS-2, LTS-3, LTS-6

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns        #-} {-# LANGUAGE CPP                 #-} {-# LANGUAGE OverloadedStrings   #-}@@ -14,6 +15,7 @@     , untarWithFinalizers     , restoreFile     , restoreFileInto+    , restoreFileWithErrors     -- ** Operate on Chunks     , untarChunks     , withEntry@@ -29,12 +31,13 @@     , createTarball     , writeTarball     , extractTarball+    , extractTarballLenient       -- * Types     , module Data.Conduit.Tar.Types     ) where  import           Conduit                  as C-import           Control.Exception        (assert)+import           Control.Exception        (assert, SomeException) import           Control.Monad            (unless, void) import           Data.Bits import           Data.ByteString          (ByteString)@@ -399,6 +402,19 @@     liftIO finilizers  +-- | Same as `untarWithFinalizers`, but will also produce a list of any exceptions that might have+-- occured during restoration process.+--+-- @since 0.2.4+untarWithExceptions ::+       (MonadThrow m, MonadIO m)+    => (FileInfo -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())+    -> ConduitM ByteString c m [(FileInfo, [SomeException])]+untarWithExceptions inner = do+    finalizers <- untar inner .| C.foldMapC (fmap pure)+    filter (not . null . snd) <$> liftIO finalizers++ -------------------------------------------------------------------------------- -- Create a tar file ----------------------------------------------------------- --------------------------------------------------------------------------------@@ -829,8 +845,10 @@     runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkHandle tarHandle  +-- always use forward slash, see+-- https://github.com/snoyberg/tar-conduit/issues/21 pathSeparatorS :: ByteString-pathSeparatorS = S8.singleton pathSeparator+pathSeparatorS = "/" -- S8.singleton pathSeparator   fileInfoFromHeader :: Header -> FileInfo@@ -863,9 +881,55 @@     runConduitRes $ sourceFileBS tarfp .| untarWithFinalizers (restoreFileInto cd)  +prependDirectory :: FilePath -> FileInfo -> FileInfo+prependDirectory cd fi =+    fi {filePath = encodeFilePath (cd </> makeRelative "/" (getFileInfoPath fi))}++ -- | 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 = encodeFilePath (cd </> makeRelative "/" (getFileInfoPath fi))}+restoreFileInto cd = restoreFile . prependDirectory cd++-- | Restore all files into a folder. Absolute file paths will be turned into relative to the+-- supplied folder. Yields a list with exceptions instead of throwing them.+restoreFileIntoLenient :: MonadResource m =>+    FilePath -> FileInfo -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()+restoreFileIntoLenient cd = restoreFileWithErrors True . prependDirectory cd+++-- | Same as `extractTarball`, but ignores possible extraction errors. It can still throw a+-- `TarException` if the tarball is corrupt or malformed.+--+-- @since 0.2.4+extractTarballLenient :: FilePath -- ^ Filename for the tarball+                   -> Maybe FilePath -- ^ Folder where tarball should be extract+                   -- to. Default is the current path+                   -> IO [(FileInfo, [SomeException])]+extractTarballLenient tarfp mcd = do+    cd <- maybe getCurrentDirectory return mcd+    createDirectoryIfMissing True cd+    runConduitRes $+        sourceFileBS tarfp .| untarWithExceptions (restoreFileIntoLenient cd)++++-- | Restore files onto the file system. Produces actions that will set the modification time on the+-- directories, which can be executed after the pipeline has finished and all files have been+-- written to disk.+restoreFile :: (MonadResource m) =>+               FileInfo -> ConduitM S8.ByteString (IO ()) m ()+restoreFile fi = restoreFileWithErrors False fi .| mapC void+++-- | Restore files onto the file system, much in the same way `restoreFile` does it, except with+-- ability to ignore restoring problematic files and report errors that occured as a list of+-- exceptions, which will be returned as a list when finilizer executed. If a list is empty, it+-- means, that no errors occured and a file only had a finilizer associated with it.+restoreFileWithErrors ::+       (MonadResource m)+    => Bool+    -> FileInfo+    -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()+restoreFileWithErrors = restoreFileInternal

@@ -136,6 +136,7 @@     | InvalidHeader     !FileOffset     | BadChecksum       !FileOffset     | FileTypeError     !FileOffset !Char !String+    | UnsupportedType   !FileType     deriving (Show, Typeable) instance Exception TarException 

@@ -4,14 +4,15 @@ {-# LANGUAGE ScopedTypeVariables #-} module Data.Conduit.Tar.Unix     ( getFileInfo-    , restoreFile+    , restoreFileInternal     ) where -import           Conduit+import           Conduit                       hiding (throwM) import           Control.Exception.Safe-import           Control.Monad                 (void, when)+import           Control.Monad                 (void, when, unless) import           Data.Bits import qualified Data.ByteString.Char8         as S8+import           Data.Either import           Data.Conduit.Tar.Types import           Foreign.C.Types               (CTime (..)) import qualified System.Directory              as Dir@@ -53,41 +54,52 @@         , 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+-- | See 'Data.Conduit.Tar.restoreFileWithErrors' for documentation+restoreFileInternal ::+       (MonadResource m)+    => Bool+    -> FileInfo+    -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()+restoreFileInternal lenient fi@FileInfo {..} = do     let fpStr = decodeFilePath filePath+        tryAnyCond action = if lenient then tryAny action else fmap Right action         restorePermissions = do-            void $ tryAny $ Posix.setOwnerAndGroup fpStr fileUserId fileGroupId-            void $ tryAny $ Posix.setFileMode fpStr fileMode+            eExc1 <- tryAnyCond $ Posix.setOwnerAndGroup fpStr fileUserId fileGroupId+            eExc2 <- tryAnyCond $ Posix.setFileMode fpStr fileMode+            return $! fst $ partitionEithers [eExc1, eExc2]+        -- | Catch all exceptions, but only if lenient is set to True     case fileType of         FTDirectory -> do-            liftIO $ do+            excs <- liftIO $ do                 Dir.createDirectoryIfMissing False fpStr                 restorePermissions-            yield $-                (Dir.doesDirectoryExist fpStr >>=-                 (`when` Posix.setFileTimes fpStr fileModTime fileModTime))-        FTSymbolicLink link ->-            liftIO $ do+            yield $ do+                eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>=+                                    (`when` Posix.setFileTimes fpStr fileModTime fileModTime))+                return (fi, either ((excs ++) . pure) (const excs) eExc)+        FTSymbolicLink link -> do+            excs <- liftIO $ do                 -- Try to unlink any existing file/symlink-                _ <- tryAny $ Posix.removeLink fpStr+                void $ tryAny $ Posix.removeLink fpStr                 Posix.createSymbolicLink (decodeFilePath link) fpStr-                _ <- tryAny $ Posix.setSymbolicLinkOwnerAndGroup fpStr fileUserId fileGroupId-                -- Try best effort in setting symbolic link modification time.+                eExc1 <- tryAnyCond $ Posix.setSymbolicLinkOwnerAndGroup fpStr fileUserId fileGroupId #if MIN_VERSION_unix(2,7,0)+                -- Try best effort in setting symbolic link modification time.                 let CTime epochInt32 = fileModTime                     unixModTime = fromInteger (fromIntegral epochInt32)-                void $ tryAny $ Posix.setSymbolicLinkTimesHiRes fpStr unixModTime unixModTime+                eExc2 <- tryAny $ Posix.setSymbolicLinkTimesHiRes fpStr unixModTime unixModTime #endif+                return $ fst $ partitionEithers [eExc1, eExc2]+            unless (null excs) $ yield (return (fi, excs))         FTNormal -> do             sinkFile fpStr-            liftIO $ do-                restorePermissions-                Posix.setFileTimes fpStr fileModTime fileModTime-        ty -> error $ "Unsupported tar entry type: " ++ show ty+            excs <- liftIO $ do+                excs <- restorePermissions+                eExc <- tryAnyCond $ Posix.setFileTimes fpStr fileModTime fileModTime+                return (either ((excs ++) . pure) (const excs) eExc)+            unless (null excs) $ yield (return (fi, excs))+        ty -> do+            let exc = UnsupportedType ty+            unless lenient $ liftIO $ throwM exc+            yield $ return (fi, [toException exc]) 

@@ -2,14 +2,16 @@ {-# LANGUAGE RecordWildCards   #-} module Data.Conduit.Tar.Windows     ( getFileInfo-    , restoreFile+    , restoreFileInternal     ) where  import           Conduit-import           Control.Monad            (when)+import           Control.Monad            (when, unless)+import           Control.Exception.Safe   (tryAny, SomeException, toException) import           Data.Bits import qualified Data.ByteString.Char8    as S8 import           Data.Conduit.Tar.Types+import           Data.Either              (partitionEithers) import           Data.Time.Clock.POSIX import           Foreign.C.Types          (CTime (..)) import qualified System.Directory         as Dir@@ -38,24 +40,38 @@         , 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+++-- | See 'Data.Conduit.Tar.restoreFileWithErrors' for documentation+restoreFileInternal ::+       (MonadResource m)+    => Bool+    -> FileInfo+    -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()+restoreFileInternal lenient fi@FileInfo {..} = do     let fpStr = decodeFilePath filePath+        tryAnyCond action = if lenient then tryAny action else fmap Right action         CTime modTimeEpoch = fileModTime         modTime = posixSecondsToUTCTime (fromIntegral modTimeEpoch)+        restoreTimeAndMode = do+            eExc1 <- tryAnyCond $ Posix.setFileMode fpStr fileMode+            eExc2 <- tryAnyCond $ Dir.setModificationTime fpStr modTime+            return $! fst $ partitionEithers [eExc1, eExc2]     case fileType of         FTDirectory -> do-            liftIO $ Dir.createDirectoryIfMissing False fpStr-            yield $-                (Dir.doesDirectoryExist fpStr >>=-                 (`when` Dir.setModificationTime fpStr modTime))-        FTNormal -> sinkFile fpStr-        ty -> error $ "Unsupported tar entry type: " ++ show ty-    liftIO $ do-        Dir.setModificationTime fpStr modTime-        Posix.setFileMode fpStr fileMode+            excs <- liftIO $ do+                Dir.createDirectoryIfMissing False fpStr+                restoreTimeAndMode+            yield $ do+                eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>=+                                    (`when` Dir.setModificationTime fpStr modTime))+                return (fi, either ((excs ++) . pure) (const excs) eExc)+        FTNormal -> do+            sinkFile fpStr+            excs <- liftIO $ restoreTimeAndMode+            unless (null excs) $ yield $ return (fi, excs)+        ty -> do+            let exc = UnsupportedType ty+            unless lenient $ liftIO $ throwM exc+            yield $ return (fi, [toException exc]) 

@@ -1,5 +1,5 @@ name:                tar-conduit-version:             0.2.3.1+version:             0.2.4 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@@ -21,21 +21,20 @@                      , bytestring                      , conduit                      , conduit-combinators >= 1.0.8.1+                     , directory                      , filepath+                     , safe-exceptions                      , text   default-language:    Haskell2010   ghc-options:         -Wall   if os(windows)       other-modules: Data.Conduit.Tar.Windows-      build-depends: directory-                   , time+      build-depends: time                    , unix-compat       cpp-options:   -DWINDOWS   else       other-modules: Data.Conduit.Tar.Unix-      build-depends: directory-                   , safe-exceptions-                   , unix+      build-depends: unix  test-suite tests   type:                exitcode-stdio-1.0

@@ -13,10 +13,12 @@ import           Data.Conduit.List import           Data.Conduit.Tar import           Data.Int+import           Data.List             (sortOn) import           Data.Monoid import           Prelude               as P import           System.Directory-import           System.FilePath+import qualified System.FilePath as Host+import qualified System.FilePath.Posix as Posix -- always use forward slashes import           System.IO import           System.IO             (BufferMode (LineBuffering),                                         hSetBuffering, stdout)@@ -58,8 +60,8 @@                     finally                         (setCurrentDirectory outDir >> createTarball fpOut testPaths)                         (setCurrentDirectory curDir)-                    tb1 <- readTarball fpIn-                    tb2 <- readTarball fpOut+                    tb1 <- readTarballSorted fpIn+                    tb2 <- readTarballSorted fpOut                     P.length tb1 `shouldBe` P.length tb2                     zipWithM_ shouldBe (fmap fst tb2) (fmap fst tb1)                     zipWithM_ shouldBe (fmap snd tb2) (fmap snd tb1)@@ -111,7 +113,7 @@ instance Arbitrary GnuTarFile where     arbitrary = do         filePathLen <- (`mod` 4090) <$> arbitrary-        filePath <- ("test-" <>) <$> asciiGen filePathLen+        filePath <- ("test-" <>) . S8.filter (/= ('\\')) <$> asciiGen filePathLen         NonNegative fileUserId64 <- arbitrary         let fileUserId = fromIntegral (fileUserId64 :: Int64)         NonNegative fileGroupId64 <- arbitrary@@ -171,7 +173,7 @@         emptyFileInfoExpectation defFileInfo     it "long file name <255" $ do         emptyFileInfoExpectation $-            defFileInfo {filePath = S8.pack (P.replicate 99 'f' </> P.replicate 99 'o')}+            defFileInfo {filePath = S8.pack (P.replicate 99 'f' Posix.</> P.replicate 99 'o')}   gnutarSpec :: Spec@@ -180,19 +182,25 @@         emptyFileInfoExpectation $             defFileInfo             { filePath =-                  S8.pack (P.replicate 100 'f' </> P.replicate 100 'o' </> P.replicate 99 'b')+                  S8.pack (P.replicate 100 'f' Posix.</>+                           P.replicate 100 'o' Posix.</>+                           P.replicate 99 'b')             }     it "LongLink - multiple files with long file names" $ do         fileInfoExpectation             [ ( defFileInfo                 { filePath =-                      S8.pack (P.replicate 100 'f' </> P.replicate 100 'o' </> P.replicate 99 'b')+                      S8.pack (P.replicate 100 'f' Posix.</>+                               P.replicate 100 'o' Posix.</>+                               P.replicate 99 'b')                 , fileSize = 10                 }               , "1234567890")             , ( defFileInfo                 { filePath =-                      S8.pack (P.replicate 1000 'g' </> P.replicate 1000 'o' </> P.replicate 99 'b')+                      S8.pack (P.replicate 1000 'g' Posix.</>+                               P.replicate 1000 'o' Posix.</>+                               P.replicate 99 'b')                 , fileSize = 11                 }               , "abcxdefghij")@@ -221,9 +229,9 @@ 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")+            (fp1, h1) <- openBinaryTempFile tmpDir (Host.addExtension base ".tar")+            let outPath = Host.dropExtension fp1 ++ ".out"+            return (fp1, h1, outPath, Host.addExtension outPath ".tar")         )         (\(fp, h, dirOut, fpOut) -> do              hClose h@@ -232,10 +240,14 @@              doesFileExist fpOut >>= (`when` removeFile fpOut)         ) --readTarball+-- | Collects all of the files and direcotries from the tarball. Then all of them get sorted, since+-- apparently Windows has no guaranteed order the files within a directory will be listed in upon a+-- tarball creation.+readTarballSorted   :: FilePath -> IO [(FileInfo, Maybe ByteString)]-readTarball fp = runConduitRes $ sourceFileBS fp .| untar grabBoth .| sinkList+readTarballSorted fp =+  sortOn (filePath . fst) <$>+  (runConduitRes $ sourceFileBS fp .| untar grabBoth .| sinkList)  readGzipTarball   :: FilePath