tar-conduit 0.2.5 → 0.3.0

raw patch · 7 files changed

+79/−44 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• src/Data/Conduit/Tar.hs +40/−30
• src/Data/Conduit/Tar/Types.hs +9/−9
• src/Data/Conduit/Tar/Unix.hs +22/−3
• src/Data/Conduit/Tar/Windows.hs +1/−1
• tar-conduit.cabal +1/−1
• tests/Spec.hs +1/−0

@@ -1,3 +1,8 @@+## 0.3.0 - 2018-08-28+ * Support for `FTHardLink` restoration, but not creation yet.+ * Restoring files made even more lenient with creation of full directory path if any parents of+   it are missing.+ ## 0.2.5 - 2018-08-28  * Exported `untarWithExceptions`, `restoreFileIntoLenient` 

@@ -1,6 +1,7 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE BangPatterns        #-} {-# LANGUAGE CPP                 #-}+{-# LANGUAGE LambdaCase          #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -92,7 +93,7 @@     case headerLinkIndicator h of         0  -> FTNormal         48 -> FTNormal-        49 -> FTHardLink+        49 -> FTHardLink (fromShort (headerLinkName h))         50 -> FTSymbolicLink (fromShort (headerLinkName h))         51 -> FTCharacterSpecial         52 -> FTBlockSpecial@@ -257,7 +258,9 @@ {-| This function handles each entry of the tar archive according to the behaviour of the function passed as first argument. -Here is a full example function, that reads a compressed tar archive and for each entry that is a simple file, it prints its file path and SHA256 digest. Note that this function can throw exceptions!+Here is a full example function, that reads a compressed tar archive and for each entry that is a+simple file, it prints its file path and SHA256 digest. Note that this function can throw+exceptions!  > import qualified Crypto.Hash.Conduit as CH > import qualified Data.Conduit.Tar    as CT@@ -284,13 +287,14 @@ The @hashentry@ function handles a single entry, based on its first 'Header' argument. In this example, a 'Consumer' is used to process the whole entry. -Note that the benefits of stream processing are easily lost when working with a 'Consumer'. For example, the following implementation would have used an unbounded amount of memory:+Note that the benefits of stream processing are easily lost when working with a 'Consumer'. For+example, the following implementation would have used an unbounded amount of memory:  >         hashentry hdr = when (CT.headerFileType hdr == CT.FTNormal) $ do >             content <- mconcat <$> sinkList >             yield (CT.headerFilePath hdr, hash content) --- @since 0.1.0+@since 0.1.0 -} withEntries :: MonadThrow m             => (Header -> ConduitM ByteString o m ())@@ -316,20 +320,19 @@ withFileInfo :: MonadThrow m              => (FileInfo -> ConduitM ByteString o m ())              -> ConduitM TarChunk o m ()-withFileInfo inner =-    start+withFileInfo inner = start   where     start = await >>= maybe (return ()) go--    go x = do+    go x =         case x of             ChunkHeader h-                | headerLinkIndicator h >= 55 -> do-                    if (headerMagicVersion h == gnuTarMagicVersion)+                | headerLinkIndicator h >= 55 ->+                    if headerMagicVersion h == gnuTarMagicVersion                         then handleGnuTarHeader h >>= maybe start go-                        else dropWhileC (\x' -> case x' of-                                           ChunkPayload _ _ -> True-                                           _                -> False) >> start+                        else dropWhileC+                                 (\case+                                      ChunkPayload _ _ -> True+                                      _                -> False) >> start             ChunkHeader h -> do                 payloadsConduit .| (inner (fileInfoFromHeader h) <* sinkNull)                 start@@ -337,13 +340,13 @@                 leftover x                 throwM $ UnexpectedPayload offset             ChunkException e -> throwM e-       + -- | Take care of custom GNU tar format. handleGnuTarHeader :: MonadThrow m                    => Header                    -> ConduitM TarChunk o m (Maybe TarChunk)-handleGnuTarHeader h = do+handleGnuTarHeader h =     case headerLinkIndicator h of         76 -> do             let pSize = headerPayloadSize h@@ -359,7 +362,7 @@                 Just (ChunkHeader nh) -> do                     unless (S.isPrefixOf (fromShort (headerFileNameSuffix nh)) longFileName) $                         throwM $-                        FileTypeError (headerPayloadOffset nh) 'L' $+                        FileTypeError (headerPayloadOffset nh) 'L'                         "Long filename doesn't match the original."                     return                         (Just $ ChunkHeader $@@ -454,11 +457,11 @@           }  -headerFromFileInfo :: MonadThrow m =>-                      FileOffset -- ^ Starting offset within the tarball. Must-                      -- be multiple of 512, otherwise error.-                   -> FileInfo -- ^ File info.-                   -> m (Either TarCreateException Header)+headerFromFileInfo ::+       MonadThrow m+    => FileOffset -- ^ Starting offset within the tarball. Must be multiple of 512, otherwise error.+    -> FileInfo -- ^ File info.+    -> m (Either TarCreateException Header) headerFromFileInfo offset fi = do     unless (offset `mod` 512 == 0) $         throwM $@@ -466,12 +469,13 @@         "<headerFromFileInfo>: Offset must always be a multiple of 512 for file: " ++         getFileInfoPath fi     let (prefix, suffix) = splitPathAt 100 $ filePath fi-    if (SS.length prefix > 155 || SS.null suffix)+    if SS.length prefix > 155 || SS.null suffix         then return $ Left $ FileNameTooLong fi         else do             (payloadSize, linkName, linkIndicator) <-                 case fileType fi of                     FTNormal -> return (fileSize fi, SS.empty, 48)+                    FTHardLink ln -> return (0, toShort ln, 49)                     FTSymbolicLink ln -> return (0, toShort ln, 50)                     FTDirectory -> return (0, SS.empty, 53)                     fty ->@@ -575,7 +579,7 @@     encodeDevice magic _ 0     = return (magic, byteString $ S.replicate 8 0)     encodeDevice magic m devid = encodeNumber magic ("device" ++ m) 8 devid     fallbackHex magic (Right enc)       = Right (magic, enc)-    fallbackHex _     (Left (len, val)) = fmap ((,) gnuTarMagicVersion) $ encodeHex len val+    fallbackHex _     (Left (len, val)) = (,) gnuTarMagicVersion <$> encodeHex len val     throwNumberEither _     (Right v)         = return v     throwNumberEither field (Left (len, val)) =         throwM $@@ -834,7 +838,7 @@ createTarball :: FilePath -- ^ File name for the tarball               -> [FilePath] -- ^ List of files and directories to include in the tarball               -> IO ()-createTarball tarfp dirs = do+createTarball tarfp dirs =     runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkFile tarfp  -- | Take a list of files and paths, recursively tar them and write output into supplied handle.@@ -843,7 +847,7 @@ writeTarball :: Handle -- ^ Handle where created tarball will be written to              -> [FilePath] -- ^ List of files and directories to include in the tarball              -> IO ()-writeTarball tarHandle dirs = do+writeTarball tarHandle dirs =     runConduitRes $ yieldMany dirs .| void tarFilePath .| sinkHandle tarHandle  @@ -854,7 +858,7 @@   fileInfoFromHeader :: Header -> FileInfo-fileInfoFromHeader header@(Header {..}) =+fileInfoFromHeader header@Header {..} =     FileInfo     { filePath = headerFilePathBS header     , fileUserId = headerOwnerId@@ -884,8 +888,15 @@   prependDirectory :: FilePath -> FileInfo -> FileInfo-prependDirectory cd fi =-    fi {filePath = encodeFilePath (cd </> makeRelative "/" (getFileInfoPath fi))}+prependDirectory cd fi = fi {filePath = prependDir $ getFileInfoPath fi,+                             fileType = prependDirIfNeeded (fileType fi)}+  where+    -- Hard links need to be interpreted based on `cd`, not just CWD, if relative,+    -- otherwise they may point to some invalid location.+    prependDirIfNeeded (FTHardLink p)+        | isRelative $ decodeFilePath p = FTHardLink (prependDir $ decodeFilePath p)+    prependDirIfNeeded other            = other+    prependDir p                        = encodeFilePath (cd </> makeRelative "/" p)   -- | Restore all files into a folder. Absolute file paths will be turned into@@ -901,7 +912,6 @@ 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.

@@ -1,6 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-}+#if WINDOWS+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+#endif -- | Module contains all the types necessary for tarball processing. module Data.Conduit.Tar.Types     ( Header(..)@@ -25,7 +26,6 @@ import           Control.Exception        (Exception) import           Data.ByteString          (ByteString) import           Data.ByteString.Short    (ShortByteString)-import           Data.Typeable import           Data.Word import           System.Posix.Types import qualified Data.ByteString.Char8         as S8@@ -69,7 +69,7 @@  data FileType     = FTNormal-    | FTHardLink+    | FTHardLink !ByteString     | FTSymbolicLink !ByteString     | FTCharacterSpecial     | FTBlockSpecial@@ -87,9 +87,9 @@     , fileGroupName :: !ByteString  -- ^ Unix group name.     , fileMode      :: !FileMode -- ^ Unix file permissions     , fileSize      :: !FileOffset -- ^ File size-    , fileType      :: !FileType  -- ^ File type. `FTNormal`, `FTSymbolicLink`-                                  -- and `FTDirectory` are the only ones-                                  -- supported for now+    , fileType      :: !FileType  -- ^ File type. `FTNormal`, `FTHardLink` (@since 0.3.0),+                                  -- `FTSymbolicLink` and `FTDirectory` are the only ones supported+                                  -- for now     , fileModTime   :: !EpochTime -- ^ File modification timestamp     } deriving (Show, Eq) @@ -137,14 +137,14 @@     | BadChecksum       !FileOffset     | FileTypeError     !FileOffset !Char !String     | UnsupportedType   !FileType-    deriving (Show, Typeable)+    deriving Show instance Exception TarException   data TarCreateException     = FileNameTooLong   !FileInfo     | TarCreationError  !String-    deriving (Show, Typeable)+    deriving Show instance Exception TarCreateException  -- | Convert `FilePath` into a UTF-8 encoded `ByteString`

@@ -18,7 +18,7 @@ import qualified System.Directory              as Dir import qualified System.Posix.Files            as Posix import qualified System.Posix.User             as Posix-+import qualified System.FilePath.Posix         as Posix  getFileInfo :: FilePath -> IO FileInfo getFileInfo fpStr = do@@ -71,7 +71,7 @@     case fileType of         FTDirectory -> do             excs <- liftIO $ do-                Dir.createDirectoryIfMissing False fpStr+                Dir.createDirectoryIfMissing True fpStr                 restorePermissions             yield $ do                 eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>=@@ -91,13 +91,32 @@ #endif                 return $ fst $ partitionEithers [eExc1, eExc2]             unless (null excs) $ yield (return (fi, excs))+        FTHardLink link -> do+            excs <- liftIO $ do+                let linkedFp = decodeFilePath link+                when lenient $ do+                    linkedFileExists <- Posix.fileExist linkedFp+                    -- If the linked file does not exist (yet), we cannot create a hard link.+                    -- Try to "pre-create" it.+                    unless linkedFileExists $ do+                        Dir.createDirectoryIfMissing True $ Posix.takeDirectory linkedFp+                        writeFile linkedFp ""+                Dir.createDirectoryIfMissing True $ Posix.takeDirectory fpStr+                -- Try to unlink any existing file/hard link+                void $ tryAny $ Posix.removeLink fpStr+                Posix.createLink linkedFp fpStr+                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))         FTNormal -> do             sinkFile fpStr             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))+            unless (null excs) $ yield $ return (fi, excs)         ty -> do             let exc = UnsupportedType ty             unless lenient $ liftIO $ throwM exc

@@ -60,7 +60,7 @@     case fileType of         FTDirectory -> do             excs <- liftIO $ do-                Dir.createDirectoryIfMissing False fpStr+                Dir.createDirectoryIfMissing True fpStr                 restoreTimeAndMode             yield $ do                 eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>=

@@ -1,5 +1,5 @@ name:                tar-conduit-version:             0.2.5+version:             0.3.0 synopsis:            Extract and create tar files using conduit for streaming description:         Please see README.md. This is just filler to avoid warnings. homepage:            https://github.com/snoyberg/tar-conduit#readme

@@ -130,6 +130,7 @@                 [ pure FTNormal                 , pure FTDirectory                 , FTSymbolicLink <$> asciiGen linkNameLen+                , FTHardLink <$> asciiGen linkNameLen                 ]         (fileSize, mContent) <-             case fileType of