    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS_GHC -Wno-orphans #-}
    {-# OPTIONS_HADDOCK hide #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Codec.Archive.Tar.Check.Internal
    -- Copyright   :  (c) 2008-2012 Duncan Coutts
    --                    2011 Max Bolingbroke
    -- License     :  BSD3
    --
    -- Maintainer  :  duncan@community.haskell.org
    -- Portability :  portable
    --
    -- Perform various checks on tar file entries.
    --
    -----------------------------------------------------------------------------
    module Codec.Archive.Tar.Check.Internal (

      -- * Security
      checkSecurity,
      checkEntrySecurity,
      FileNameError(..),

      -- * Tarbombs
      checkTarbomb,
      checkEntryTarbomb,
      TarBombError(..),

      -- * Portability
      checkPortability,
      checkEntryPortability,
      PortabilityError(..),
      PortabilityPlatform,
      ) where

    import Codec.Archive.Tar.LongNames
    import Codec.Archive.Tar.Types
    import Control.Applicative ((<|>))
    import qualified Data.ByteString.Lazy.Char8 as Char8
    import Data.Maybe (fromMaybe)
    import Data.Typeable (Typeable)
    import Control.Exception (Exception(..))
    import qualified System.FilePath as FilePath.Native
             ( splitDirectories, isAbsolute, isValid, (</>), takeDirectory, hasDrive )

    import qualified System.FilePath.Windows as FilePath.Windows
    import qualified System.FilePath.Posix   as FilePath.Posix

    --------------------------
    -- Security
    --

    -- | This function checks a sequence of tar entries for file name security
    -- problems. It checks that:
    --
    -- * file paths are not absolute
    --
    -- * file paths do not refer outside of the archive
    --
    -- * 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
    -- 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.
    --
    -- Whenever possible, consider fusing 'Codec.Archive.Tar.Check.checkSecurity'
    -- with packing / unpacking by using
    -- 'Codec.Archive.Tar.packAndCheck' / 'Codec.Archive.Tar.unpackAndCheck'
    -- with 'Codec.Archive.Tar.Check.checkEntrySecurity'.
    -- Not only it is faster, but also alleviates issues with lazy I/O
    -- such as exhaustion of file handlers.
    checkSecurity
      :: Entries e
      -> GenEntries FilePath FilePath (Either (Either e DecodeLongNamesError) FileNameError)
    checkSecurity :: forall e.
    Entries e
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) FileNameError)
    checkSecurity = (GenEntry FilePath FilePath -> Maybe FileNameError)
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) FileNameError)
    forall tarPath linkTarget e' e.
    (GenEntry tarPath linkTarget -> Maybe e')
    -> GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget (Either e e')
    checkEntries GenEntry FilePath FilePath -> Maybe FileNameError
    checkEntrySecurity (GenEntries FilePath FilePath (Either e DecodeLongNamesError)
     -> GenEntries
          FilePath
          FilePath
          (Either (Either e DecodeLongNamesError) FileNameError))
    -> (Entries e
        -> GenEntries FilePath FilePath (Either e DecodeLongNamesError))
    -> Entries e
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) FileNameError)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    forall e.
    Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    decodeLongNames

    -- | Worker of 'Codec.Archive.Tar.Check.checkSecurity'.
    --
    -- @since 0.6.0.0
    checkEntrySecurity :: GenEntry FilePath FilePath -> Maybe FileNameError
    checkEntrySecurity :: GenEntry FilePath FilePath -> Maybe FileNameError
    checkEntrySecurity GenEntry FilePath FilePath
    e =
      FilePath -> Maybe FileNameError
    check (GenEntry FilePath FilePath -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath FilePath
    e) Maybe FileNameError -> Maybe FileNameError -> Maybe FileNameError
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      case GenEntry FilePath FilePath -> GenEntryContent FilePath
    forall tarPath linkTarget.
    GenEntry tarPath linkTarget -> GenEntryContent linkTarget
    entryContent GenEntry FilePath FilePath
    e of
        HardLink     FilePath
    link ->
          FilePath -> Maybe FileNameError
    check FilePath
    link
        SymbolicLink FilePath
    link ->
          FilePath -> Maybe FileNameError
    check (FilePath -> FilePath
    FilePath.Posix.takeDirectory (GenEntry FilePath FilePath -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath FilePath
    e) FilePath -> FilePath -> FilePath
    FilePath.Posix.</> FilePath
    link)
        GenEntryContent FilePath
    _ -> Maybe FileNameError
    forall a. Maybe a
    Nothing
      where
        checkPosix :: FilePath -> Maybe FileNameError
    checkPosix FilePath
    name
          | FilePath -> Bool
    FilePath.Posix.isAbsolute FilePath
    name
          = FileNameError -> Maybe FileNameError
    forall a. a -> Maybe a
    Just (FileNameError -> Maybe FileNameError)
    -> FileNameError -> Maybe FileNameError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError
    AbsoluteFileName FilePath
    name
          | Bool -> Bool
    not (FilePath -> Bool
    FilePath.Posix.isValid FilePath
    name)
          = FileNameError -> Maybe FileNameError
    forall a. a -> Maybe a
    Just (FileNameError -> Maybe FileNameError)
    -> FileNameError -> Maybe FileNameError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError
    InvalidFileName FilePath
    name
          | Bool -> Bool
    not ([FilePath] -> Bool
    isInsideBaseDir (FilePath -> [FilePath]
    FilePath.Posix.splitDirectories FilePath
    name))
          = FileNameError -> Maybe FileNameError
    forall a. a -> Maybe a
    Just (FileNameError -> Maybe FileNameError)
    -> FileNameError -> Maybe FileNameError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError
    UnsafeLinkTarget FilePath
    name
          | Bool
    otherwise = Maybe FileNameError
    forall a. Maybe a
    Nothing

        checkNative :: FilePath -> Maybe FileNameError
    checkNative (FilePath -> FilePath
    fromFilePathToNative -> FilePath
    name)
          | FilePath -> Bool
    FilePath.Native.isAbsolute FilePath
    name Bool -> Bool -> Bool
    || FilePath -> Bool
    FilePath.Native.hasDrive FilePath
    name
          = FileNameError -> Maybe FileNameError
    forall a. a -> Maybe a
    Just (FileNameError -> Maybe FileNameError)
    -> FileNameError -> Maybe FileNameError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError
    AbsoluteFileName FilePath
    name
          | Bool -> Bool
    not (FilePath -> Bool
    FilePath.Native.isValid FilePath
    name)
          = FileNameError -> Maybe FileNameError
    forall a. a -> Maybe a
    Just (FileNameError -> Maybe FileNameError)
    -> FileNameError -> Maybe FileNameError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError
    InvalidFileName FilePath
    name
          | Bool -> Bool
    not ([FilePath] -> Bool
    isInsideBaseDir (FilePath -> [FilePath]
    FilePath.Native.splitDirectories FilePath
    name))
          = FileNameError -> Maybe FileNameError
    forall a. a -> Maybe a
    Just (FileNameError -> Maybe FileNameError)
    -> FileNameError -> Maybe FileNameError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError
    UnsafeLinkTarget FilePath
    name
          | Bool
    otherwise = Maybe FileNameError
    forall a. Maybe a
    Nothing

        check :: FilePath -> Maybe FileNameError
    check FilePath
    name = FilePath -> Maybe FileNameError
    checkPosix FilePath
    name Maybe FileNameError -> Maybe FileNameError -> Maybe FileNameError
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> FilePath -> Maybe FileNameError
    checkNative (FilePath -> FilePath
    fromFilePathToNative FilePath
    name)

    isInsideBaseDir :: [FilePath] -> Bool
    isInsideBaseDir :: [FilePath] -> Bool
    isInsideBaseDir = Word -> [FilePath] -> Bool
    go Word
    0
      where
        go :: Word -> [FilePath] -> Bool
        go :: Word -> [FilePath] -> Bool
    go !Word
    _ [] = Bool
    True
        go Word
    0 (FilePath
    ".." : [FilePath]
    _) = Bool
    False
        go Word
    lvl (FilePath
    ".." : [FilePath]
    xs) = Word -> [FilePath] -> Bool
    go (Word
    lvl Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    1) [FilePath]
    xs
        go Word
    lvl (FilePath
    "." : [FilePath]
    xs) = Word -> [FilePath] -> Bool
    go Word
    lvl [FilePath]
    xs
        go Word
    lvl (FilePath
    _ : [FilePath]
    xs) = Word -> [FilePath] -> Bool
    go (Word
    lvl Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    1) [FilePath]
    xs

    -- | Errors arising from tar file names being in some way invalid or dangerous
    data FileNameError
      = InvalidFileName FilePath
      | AbsoluteFileName FilePath
      | UnsafeLinkTarget FilePath
      -- ^ @since 0.6.0.0
      deriving (Typeable)

    instance Show FileNameError where
      show :: FileNameError -> FilePath
    show = Maybe FilePath -> FileNameError -> FilePath
    showFileNameError Maybe FilePath
    forall a. Maybe a
    Nothing

    instance Exception FileNameError

    showFileNameError :: Maybe PortabilityPlatform -> FileNameError -> String
    showFileNameError :: Maybe FilePath -> FileNameError -> FilePath
    showFileNameError Maybe FilePath
    mb_plat FileNameError
    err = case FileNameError
    err of
        InvalidFileName  FilePath
    path -> FilePath
    "Invalid"  FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    plat FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " file name in tar archive: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    path
        AbsoluteFileName FilePath
    path -> FilePath
    "Absolute" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    plat FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " file name in tar archive: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    path
        UnsafeLinkTarget FilePath
    path -> FilePath
    "Unsafe"   FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    plat FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " link target in tar archive: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    path
      where plat :: FilePath
    plat = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FilePath
    "" (Char
    ' 'Char -> FilePath -> FilePath
    forall a. a -> [a] -> [a]
    :) Maybe FilePath
    mb_plat

    --------------------------
    -- Tarbombs
    --

    -- | This function checks a sequence of tar entries for being a \"tar bomb\".
    -- This means that the tar file does not follow the standard convention that
    -- all entries are within a single subdirectory, e.g. a file \"foo.tar\" would
    -- usually have all entries within the \"foo/\" subdirectory.
    --
    -- Given the expected subdirectory, this function checks all entries are within
    -- that subdirectroy.
    --
    -- Note: This check must be used in conjunction with 'Codec.Archive.Tar.Check.checkSecurity'
    -- (or 'Codec.Archive.Tar.Check.checkPortability').
    --
    -- Whenever possible, consider fusing 'Codec.Archive.Tar.Check.checkTarbomb'
    -- with packing / unpacking by using
    -- 'Codec.Archive.Tar.packAndCheck' / 'Codec.Archive.Tar.unpackAndCheck'
    -- with 'Codec.Archive.Tar.Check.checkEntryTarbomb'.
    -- Not only it is faster, but also alleviates issues with lazy I/O
    -- such as exhaustion of file handlers.
    checkTarbomb
      :: FilePath
      -> Entries e
      -> GenEntries FilePath FilePath (Either (Either e DecodeLongNamesError) TarBombError)
    checkTarbomb :: forall e.
    FilePath
    -> Entries e
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) TarBombError)
    checkTarbomb FilePath
    expectedTopDir
      = (GenEntry FilePath FilePath -> Maybe TarBombError)
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) TarBombError)
    forall tarPath linkTarget e' e.
    (GenEntry tarPath linkTarget -> Maybe e')
    -> GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget (Either e e')
    checkEntries (FilePath -> GenEntry FilePath FilePath -> Maybe TarBombError
    forall linkTarget.
    FilePath -> GenEntry FilePath linkTarget -> Maybe TarBombError
    checkEntryTarbomb FilePath
    expectedTopDir)
      (GenEntries FilePath FilePath (Either e DecodeLongNamesError)
     -> GenEntries
          FilePath
          FilePath
          (Either (Either e DecodeLongNamesError) TarBombError))
    -> (Entries e
        -> GenEntries FilePath FilePath (Either e DecodeLongNamesError))
    -> Entries e
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) TarBombError)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    forall e.
    Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    decodeLongNames

    -- | Worker of 'checkTarbomb'.
    --
    -- @since 0.6.0.0
    checkEntryTarbomb :: FilePath -> GenEntry FilePath linkTarget -> Maybe TarBombError
    checkEntryTarbomb :: forall linkTarget.
    FilePath -> GenEntry FilePath linkTarget -> Maybe TarBombError
    checkEntryTarbomb FilePath
    expectedTopDir GenEntry FilePath linkTarget
    entry = do
      case GenEntry FilePath linkTarget -> GenEntryContent linkTarget
    forall tarPath linkTarget.
    GenEntry tarPath linkTarget -> GenEntryContent linkTarget
    entryContent GenEntry FilePath linkTarget
    entry of
        -- Global extended header aka XGLTYPE aka pax_global_header
        -- https://pubs.opengroup.org/onlinepubs/9699919799/utilities/pax.html#tag_20_92_13_02
        OtherEntryType Char
    'g' ByteString
    _ FileSize
    _ -> Maybe TarBombError
    forall a. Maybe a
    Nothing
        -- Extended header referring to the next file in the archive aka XHDTYPE
        OtherEntryType Char
    'x' ByteString
    _ FileSize
    _ -> Maybe TarBombError
    forall a. Maybe a
    Nothing
        GenEntryContent linkTarget
    _                      ->
          case FilePath -> [FilePath]
    FilePath.Posix.splitDirectories (GenEntry FilePath linkTarget -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath linkTarget
    entry) of
            (FilePath
    topDir:[FilePath]
    _) | FilePath
    topDir FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    expectedTopDir -> Maybe TarBombError
    forall a. Maybe a
    Nothing
            [FilePath]
    _ -> TarBombError -> Maybe TarBombError
    forall a. a -> Maybe a
    Just (TarBombError -> Maybe TarBombError)
    -> TarBombError -> Maybe TarBombError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> TarBombError
    TarBombError FilePath
    expectedTopDir (GenEntry FilePath linkTarget -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath linkTarget
    entry)

    -- | An error that occurs if a tar file is a \"tar bomb\" that would extract
    -- files outside of the intended directory.
    data TarBombError
      = TarBombError
        FilePath -- ^ Path inside archive.
                 --
                 -- @since 0.6.0.0
        FilePath -- ^ Expected top directory.
      deriving (Typeable)

    instance Exception TarBombError

    instance Show TarBombError where
      show :: TarBombError -> FilePath
    show (TarBombError FilePath
    expectedTopDir FilePath
    tarBombPath)
        = FilePath
    "File in tar archive, " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    tarBombPath FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    ", is not in the expected directory " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    expectedTopDir

    --------------------------
    -- Portability
    --

    -- | This function checks a sequence of tar entries for a number of portability
    -- issues. It will complain if:
    --
    -- * The old \"Unix V7\" or \"gnu\" formats are used. For maximum portability
    --   only the POSIX standard \"ustar\" format should be used.
    --
    -- * A non-portable entry type is used. Only ordinary files, hard links,
    --   symlinks and directories are portable. Device files, pipes and others are
    --   not portable between all common operating systems.
    --
    -- * Non-ASCII characters are used in file names. There is no agreed portable
    --   convention for Unicode or other extended character sets in file names in
    --   tar archives.
    --
    -- * File names that would not be portable to both Unix and Windows. This check
    --   includes characters that are valid in both systems and the \'/\' vs \'\\\'
    --   directory separator conventions.
    --
    -- Whenever possible, consider fusing 'checkPortability' with packing / unpacking by using
    -- 'Codec.Archive.Tar.packAndCheck' / 'Codec.Archive.Tar.unpackAndCheck'
    -- with 'checkEntryPortability'.
    -- Not only it is faster, but also alleviates issues with lazy I/O
    -- such as exhaustion of file handlers.
    checkPortability
      :: Entries e
      -> GenEntries FilePath FilePath (Either (Either e DecodeLongNamesError) PortabilityError)
    checkPortability :: forall e.
    Entries e
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) PortabilityError)
    checkPortability = (GenEntry FilePath FilePath -> Maybe PortabilityError)
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) PortabilityError)
    forall tarPath linkTarget e' e.
    (GenEntry tarPath linkTarget -> Maybe e')
    -> GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget (Either e e')
    checkEntries GenEntry FilePath FilePath -> Maybe PortabilityError
    forall linkTarget.
    GenEntry FilePath linkTarget -> Maybe PortabilityError
    checkEntryPortability (GenEntries FilePath FilePath (Either e DecodeLongNamesError)
     -> GenEntries
          FilePath
          FilePath
          (Either (Either e DecodeLongNamesError) PortabilityError))
    -> (Entries e
        -> GenEntries FilePath FilePath (Either e DecodeLongNamesError))
    -> Entries e
    -> GenEntries
         FilePath
         FilePath
         (Either (Either e DecodeLongNamesError) PortabilityError)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    forall e.
    Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    decodeLongNames

    -- | Worker of 'checkPortability'.
    --
    -- @since 0.6.0.0
    checkEntryPortability :: GenEntry FilePath linkTarget -> Maybe PortabilityError
    checkEntryPortability :: forall linkTarget.
    GenEntry FilePath linkTarget -> Maybe PortabilityError
    checkEntryPortability GenEntry FilePath linkTarget
    entry
      | GenEntry FilePath linkTarget -> Format
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> Format
    entryFormat GenEntry FilePath linkTarget
    entry Format -> [Format] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Format
    V7Format, Format
    GnuFormat]
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ Format -> PortabilityError
    NonPortableFormat (GenEntry FilePath linkTarget -> Format
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> Format
    entryFormat GenEntry FilePath linkTarget
    entry)

      | Bool -> Bool
    not (GenEntryContent linkTarget -> Bool
    forall {linkTarget}. GenEntryContent linkTarget -> Bool
    portableFileType (GenEntry FilePath linkTarget -> GenEntryContent linkTarget
    forall tarPath linkTarget.
    GenEntry tarPath linkTarget -> GenEntryContent linkTarget
    entryContent GenEntry FilePath linkTarget
    entry))
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just PortabilityError
    NonPortableFileType

      | Bool -> Bool
    not ((Char -> Bool) -> FilePath -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    portableChar FilePath
    posixPath)
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> PortabilityError
    NonPortableEntryNameChar FilePath
    posixPath

      | Bool -> Bool
    not (FilePath -> Bool
    FilePath.Posix.isValid FilePath
    posixPath)
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError -> PortabilityError
    NonPortableFileName FilePath
    "unix"    (FilePath -> FileNameError
    InvalidFileName FilePath
    posixPath)
      | Bool -> Bool
    not (FilePath -> Bool
    FilePath.Windows.isValid FilePath
    windowsPath)
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError -> PortabilityError
    NonPortableFileName FilePath
    "windows" (FilePath -> FileNameError
    InvalidFileName FilePath
    windowsPath)

      | FilePath -> Bool
    FilePath.Posix.isAbsolute FilePath
    posixPath
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError -> PortabilityError
    NonPortableFileName FilePath
    "unix"    (FilePath -> FileNameError
    AbsoluteFileName FilePath
    posixPath)
      | FilePath -> Bool
    FilePath.Windows.isAbsolute FilePath
    windowsPath
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError -> PortabilityError
    NonPortableFileName FilePath
    "windows" (FilePath -> FileNameError
    AbsoluteFileName FilePath
    windowsPath)

      | (FilePath -> Bool) -> [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "..") (FilePath -> [FilePath]
    FilePath.Posix.splitDirectories FilePath
    posixPath)
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError -> PortabilityError
    NonPortableFileName FilePath
    "unix"    (FilePath -> FileNameError
    InvalidFileName FilePath
    posixPath)
      | (FilePath -> Bool) -> [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "..") (FilePath -> [FilePath]
    FilePath.Windows.splitDirectories FilePath
    windowsPath)
      = PortabilityError -> Maybe PortabilityError
    forall a. a -> Maybe a
    Just (PortabilityError -> Maybe PortabilityError)
    -> PortabilityError -> Maybe PortabilityError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FileNameError -> PortabilityError
    NonPortableFileName FilePath
    "windows" (FilePath -> FileNameError
    InvalidFileName FilePath
    windowsPath)

      | Bool
    otherwise = Maybe PortabilityError
    forall a. Maybe a
    Nothing

      where
        posixPath :: FilePath
    posixPath   = GenEntry FilePath linkTarget -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath linkTarget
    entry
        windowsPath :: FilePath
    windowsPath = FilePath -> FilePath
    fromFilePathToWindowsPath FilePath
    posixPath

        portableFileType :: GenEntryContent linkTarget -> Bool
    portableFileType GenEntryContent linkTarget
    ftype = case GenEntryContent linkTarget
    ftype of
          NormalFile   {} -> Bool
    True
          HardLink     {} -> Bool
    True
          SymbolicLink {} -> Bool
    True
          GenEntryContent linkTarget
    Directory       -> Bool
    True
          GenEntryContent linkTarget
    _               -> Bool
    False

        portableChar :: Char -> Bool
    portableChar Char
    c = Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '\127'

    -- | Portability problems in a tar archive
    data PortabilityError
      = NonPortableFormat Format
      | NonPortableFileType
      | NonPortableEntryNameChar FilePath
      | NonPortableFileName PortabilityPlatform FileNameError
      deriving (Typeable)

    -- | The name of a platform that portability issues arise from
    type PortabilityPlatform = String

    instance Exception PortabilityError

    instance Show PortabilityError where
      show :: PortabilityError -> FilePath
    show (NonPortableFormat Format
    format) = FilePath
    "Archive is in the " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    fmt FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " format"
        where fmt :: FilePath
    fmt = case Format
    format of Format
    V7Format    -> FilePath
    "old Unix V7 tar"
                                   Format
    UstarFormat -> FilePath
    "ustar" -- I never generate this but a user might
                                   Format
    GnuFormat   -> FilePath
    "GNU tar"
      show PortabilityError
    NonPortableFileType        = FilePath
    "Non-portable file type in archive"
      show (NonPortableEntryNameChar FilePath
    posixPath)
        = FilePath
    "Non-portable character in archive entry name: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    posixPath
      show (NonPortableFileName FilePath
    platform FileNameError
    err)
        = Maybe FilePath -> FileNameError -> FilePath
    showFileNameError (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    platform) FileNameError
    err

    --------------------------
    -- Utils

    checkEntries
      :: (GenEntry tarPath linkTarget -> Maybe e')
      -> GenEntries tarPath linkTarget e
      -> GenEntries tarPath linkTarget (Either e e')
    checkEntries :: forall tarPath linkTarget e' e.
    (GenEntry tarPath linkTarget -> Maybe e')
    -> GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget (Either e e')
    checkEntries GenEntry tarPath linkTarget -> Maybe e'
    checkEntry =
      (GenEntry tarPath linkTarget
     -> Either e' (GenEntry tarPath linkTarget))
    -> GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget (Either e e')
    forall tarPath linkTarget e' e.
    (GenEntry tarPath linkTarget
     -> Either e' (GenEntry tarPath linkTarget))
    -> GenEntries tarPath linkTarget e
    -> GenEntries tarPath linkTarget (Either e e')
    mapEntries (\GenEntry tarPath linkTarget
    entry -> Either e' (GenEntry tarPath linkTarget)
    -> (e' -> Either e' (GenEntry tarPath linkTarget))
    -> Maybe e'
    -> Either e' (GenEntry tarPath linkTarget)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (GenEntry tarPath linkTarget
    -> Either e' (GenEntry tarPath linkTarget)
    forall a b. b -> Either a b
    Right GenEntry tarPath linkTarget
    entry) e' -> Either e' (GenEntry tarPath linkTarget)
    forall a b. a -> Either a b
    Left (GenEntry tarPath linkTarget -> Maybe e'
    checkEntry GenEntry tarPath linkTarget
    entry))