    {-# LANGUAGE CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Codec.Archive.Tar
    -- Copyright   :  (c) 2007 Bjorn Bringert,
    --                    2008 Andrea Vezzosi,
    --                    2008-2009, 2012, 2016 Duncan Coutts
    -- License     :  BSD3
    --
    -- Maintainer  :  duncan@community.haskell.org
    -- Portability :  portable
    --
    -----------------------------------------------------------------------------
    module Codec.Archive.Tar.Unpack (
      unpack,
      ) where

    import Codec.Archive.Tar.Types
    import Codec.Archive.Tar.Check

    import qualified Data.ByteString.Lazy as BS
    import System.FilePath
             ( (</>) )
    import qualified System.FilePath as FilePath.Native
             ( takeDirectory )
    import System.Directory
             ( createDirectoryIfMissing, copyFile )
    import Control.Exception
             ( Exception, throwIO )
    #if MIN_VERSION_directory(1,2,3)
    import System.Directory
             ( setModificationTime )
    import Data.Time.Clock.POSIX
             ( posixSecondsToUTCTime )
    import Control.Exception as Exception
             ( catch )
    import System.IO.Error
             ( isPermissionError )
    #endif

    -- | Create local files and directories based on the entries of a tar archive.
    --
    -- This is a portable implementation of unpacking suitable for portable
    -- archives. It handles 'NormalFile' and 'Directory' entries and has simulated
    -- support for 'SymbolicLink' and 'HardLink' entries. Links are implemented by
    -- copying the target file. This therefore works on Windows as well as Unix.
    -- All other entry types are ignored, that is they are not unpacked and no
    -- exception is raised.
    --
    -- If the 'Entries' ends in an error then it is raised an an exception. Any
    -- files or directories that have been unpacked before the error was
    -- encountered will not be deleted. For this reason you may want to unpack
    -- into an empty directory so that you can easily clean up if unpacking fails
    -- part-way.
    --
    -- On its own, this function only checks for security (using 'checkSecurity').
    -- You can do other checks by applying checking functions to the 'Entries' that
    -- you pass to this function. For example:
    --
    -- > unpack dir (checkTarbomb expectedDir entries)
    --
    -- If you care about the priority of the reported errors then you may want to
    -- use 'checkSecurity' before 'checkTarbomb' or other checks.
    --
    unpack :: Exception e => FilePath -> Entries e -> IO ()
    unpack :: FilePath -> Entries e -> IO ()
    unpack baseDir :: FilePath
    baseDir entries :: Entries e
    entries = [(FilePath, FilePath)]
    -> Entries (Either e FileNameError) -> IO [(FilePath, FilePath)]
    forall e e.
    (Exception e, Exception e) =>
    [(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries [] (Entries e -> Entries (Either e FileNameError)
    forall e. Entries e -> Entries (Either e FileNameError)
    checkSecurity Entries e
    entries)
                         IO [(FilePath, FilePath)]
    -> ([(FilePath, FilePath)] -> IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [(FilePath, FilePath)] -> IO ()
    emulateLinks

      where
        -- We're relying here on 'checkSecurity' to make sure we're not scribbling
        -- files all over the place.

        unpackEntries :: [(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries _     (Fail err :: Either e e
    err)      = (e -> IO [(FilePath, FilePath)])
    -> (e -> IO [(FilePath, FilePath)])
    -> Either e e
    -> IO [(FilePath, FilePath)]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either e -> IO [(FilePath, FilePath)]
    forall e a. Exception e => e -> IO a
    throwIO e -> IO [(FilePath, FilePath)]
    forall e a. Exception e => e -> IO a
    throwIO Either e e
    err
        unpackEntries links :: [(FilePath, FilePath)]
    links Done            = [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(FilePath, FilePath)]
    links
        unpackEntries links :: [(FilePath, FilePath)]
    links (Next entry :: Entry
    entry es :: Entries (Either e e)
    es) = case Entry -> EntryContent
    entryContent Entry
    entry of
          NormalFile file :: ByteString
    file _ -> FilePath -> ByteString -> EpochTime -> IO ()
    extractFile FilePath
    path ByteString
    file EpochTime
    mtime
                            IO () -> IO [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries [(FilePath, FilePath)]
    links Entries (Either e e)
    es
          Directory         -> FilePath -> EpochTime -> IO ()
    extractDir FilePath
    path EpochTime
    mtime
                            IO () -> IO [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries [(FilePath, FilePath)]
    links Entries (Either e e)
    es
          HardLink     link :: LinkTarget
    link -> ([(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries ([(FilePath, FilePath)]
     -> Entries (Either e e) -> IO [(FilePath, FilePath)])
    -> [(FilePath, FilePath)]
    -> Entries (Either e e)
    -> IO [(FilePath, FilePath)]
    forall a b. (a -> b) -> a -> b
    $! FilePath
    -> LinkTarget -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall (t :: * -> *) a.
    Foldable t =>
    t a -> LinkTarget -> [(t a, FilePath)] -> [(t a, FilePath)]
    saveLink FilePath
    path LinkTarget
    link [(FilePath, FilePath)]
    links) Entries (Either e e)
    es
          SymbolicLink link :: LinkTarget
    link -> ([(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries ([(FilePath, FilePath)]
     -> Entries (Either e e) -> IO [(FilePath, FilePath)])
    -> [(FilePath, FilePath)]
    -> Entries (Either e e)
    -> IO [(FilePath, FilePath)]
    forall a b. (a -> b) -> a -> b
    $! FilePath
    -> LinkTarget -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall (t :: * -> *) a.
    Foldable t =>
    t a -> LinkTarget -> [(t a, FilePath)] -> [(t a, FilePath)]
    saveLink FilePath
    path LinkTarget
    link [(FilePath, FilePath)]
    links) Entries (Either e e)
    es
          _                 -> [(FilePath, FilePath)]
    -> Entries (Either e e) -> IO [(FilePath, FilePath)]
    unpackEntries [(FilePath, FilePath)]
    links Entries (Either e e)
    es --ignore other file types
          where
            path :: FilePath
    path  = Entry -> FilePath
    entryPath Entry
    entry
            mtime :: EpochTime
    mtime = Entry -> EpochTime
    entryTime Entry
    entry

        extractFile :: FilePath -> ByteString -> EpochTime -> IO ()
    extractFile path :: FilePath
    path content :: ByteString
    content mtime :: EpochTime
    mtime = do
          -- 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.
          Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True FilePath
    absDir
          FilePath -> ByteString -> IO ()
    BS.writeFile FilePath
    absPath ByteString
    content
          FilePath -> EpochTime -> IO ()
    setModTime FilePath
    absPath EpochTime
    mtime
          where
            absDir :: FilePath
    absDir  = FilePath
    baseDir FilePath -> FilePath -> FilePath
    </> FilePath -> FilePath
    FilePath.Native.takeDirectory FilePath
    path
            absPath :: FilePath
    absPath = FilePath
    baseDir FilePath -> FilePath -> FilePath
    </> FilePath
    path

        extractDir :: FilePath -> EpochTime -> IO ()
    extractDir path :: FilePath
    path mtime :: EpochTime
    mtime = do
          Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True FilePath
    absPath
          FilePath -> EpochTime -> IO ()
    setModTime FilePath
    absPath EpochTime
    mtime
          where
            absPath :: FilePath
    absPath = FilePath
    baseDir FilePath -> FilePath -> FilePath
    </> FilePath
    path

        saveLink :: t a -> LinkTarget -> [(t a, FilePath)] -> [(t a, FilePath)]
    saveLink path :: t a
    path link :: LinkTarget
    link links :: [(t a, FilePath)]
    links = Int -> [(t a, FilePath)] -> [(t a, FilePath)]
    forall a b. a -> b -> b
    seq (t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    path)
                                 ([(t a, FilePath)] -> [(t a, FilePath)])
    -> [(t a, FilePath)] -> [(t a, FilePath)]
    forall a b. (a -> b) -> a -> b
    $ Int -> [(t a, FilePath)] -> [(t a, FilePath)]
    forall a b. a -> b -> b
    seq (FilePath -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    link')
                                 ([(t a, FilePath)] -> [(t a, FilePath)])
    -> [(t a, FilePath)] -> [(t a, FilePath)]
    forall a b. (a -> b) -> a -> b
    $ (t a
    path, FilePath
    link')(t a, FilePath) -> [(t a, FilePath)] -> [(t a, FilePath)]
    forall a. a -> [a] -> [a]
    :[(t a, FilePath)]
    links
          where link' :: FilePath
    link' = LinkTarget -> FilePath
    fromLinkTarget LinkTarget
    link

        emulateLinks :: [(FilePath, FilePath)] -> IO ()
    emulateLinks = ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (((FilePath, FilePath) -> IO ())
     -> [(FilePath, FilePath)] -> IO ())
    -> ((FilePath, FilePath) -> IO ())
    -> [(FilePath, FilePath)]
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(relPath :: FilePath
    relPath, relLinkTarget :: FilePath
    relLinkTarget) ->
          let absPath :: FilePath
    absPath   = FilePath
    baseDir FilePath -> FilePath -> FilePath
    </> FilePath
    relPath
              absTarget :: FilePath
    absTarget = FilePath -> FilePath
    FilePath.Native.takeDirectory FilePath
    absPath FilePath -> FilePath -> FilePath
    </> FilePath
    relLinkTarget
           in FilePath -> FilePath -> IO ()
    copyFile FilePath
    absTarget FilePath
    absPath

    setModTime :: FilePath -> EpochTime -> IO ()
    #if MIN_VERSION_directory(1,2,3)
    -- functionality only supported as of directory-1.2.3.x
    setModTime :: FilePath -> EpochTime -> IO ()
    setModTime path :: FilePath
    path t :: EpochTime
    t =
        FilePath -> UTCTime -> IO ()
    setModificationTime FilePath
    path (POSIXTime -> UTCTime
    posixSecondsToUTCTime (EpochTime -> POSIXTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral EpochTime
    t))
          IO () -> (IOError -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `Exception.catch` \e :: IOError
    e ->
            if IOError -> Bool
    isPermissionError IOError
    e then () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () else IOError -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO IOError
    e
    #else
    setModTime _path _t = return ()
    #endif