{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Distribution.Client.Compat.Tar
( extractTarGzFile
#if MIN_VERSION_tar(0,6,0)
, Tar.Entry
, Tar.Entries
, Tar.GenEntries (..)
, Tar.GenEntryContent (..)
, Tar.entryContent
#else
, Tar.Entries (..)
, Tar.Entry (..)
, Tar.EntryContent (..)
#endif
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Check as Tar
#if MIN_VERSION_tar(0,6,0)
#else
import qualified Codec.Archive.Tar.Entry as Tar
#endif
import qualified Data.ByteString.Lazy as BS
import qualified Distribution.Client.GZipUtils as GZipUtils
instance (Exception a, Exception b) => Exception (Either a b) where
toException :: Either a b -> SomeException
toException (Left a
e) = a -> SomeException
forall e. Exception e => e -> SomeException
toException a
e
toException (Right b
e) = b -> SomeException
forall e. Exception e => e -> SomeException
toException b
e
fromException :: SomeException -> Maybe (Either a b)
fromException SomeException
e =
case SomeException -> Maybe a
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just a
e' -> Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left a
e')
Maybe a
Nothing -> case SomeException -> Maybe b
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just b
e' -> Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right b
e')
Maybe b
Nothing -> Maybe (Either a b)
forall a. Maybe a
Nothing
extractTarGzFile
:: FilePath
-> FilePath
-> FilePath
-> IO ()
String
dir String
expected String
tar =
#if MIN_VERSION_tar(0,6,0)
(GenEntry String String -> Maybe SomeException)
-> String -> Entries FormatError -> IO ()
forall e.
Exception e =>
(GenEntry String String -> Maybe SomeException)
-> String -> Entries e -> IO ()
Tar.unpackAndCheck
( \GenEntry String String
x ->
TarBombError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (TarBombError -> SomeException)
-> Maybe TarBombError -> Maybe SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GenEntry String String -> Maybe TarBombError
forall linkTarget.
String -> GenEntry String linkTarget -> Maybe TarBombError
Tar.checkEntryTarbomb String
expected GenEntry String String
x
Maybe SomeException -> Maybe SomeException -> Maybe SomeException
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileNameError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (FileNameError -> SomeException)
-> Maybe FileNameError -> Maybe SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenEntry String String -> Maybe FileNameError
Tar.checkEntrySecurity GenEntry String String
x
)
String
dir
#else
Tar.unpack dir
. Tar.checkTarbomb expected
#endif
(Entries FormatError -> IO ())
-> (ByteString -> Entries FormatError) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read
(ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZipUtils.maybeDecompress
(ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
tar