{-# LANGUAGE CPP #-}
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
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
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
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
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)
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