{-# 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 :: forall e. Exception e => FilePath -> Entries e -> IO ()
unpack FilePath
baseDir Entries e
entries = forall {a} {b}.
(Exception a, Exception b) =>
[(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries [] (forall e. Entries e -> Entries (Either e FileNameError)
checkSecurity Entries e
entries)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(FilePath, FilePath)] -> IO ()
emulateLinks
where
unpackEntries :: [(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries [(FilePath, FilePath)]
_ (Fail Either a b
err) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall e a. Exception e => e -> IO a
throwIO Either a b
err
unpackEntries [(FilePath, FilePath)]
links Entries (Either a b)
Done = forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath, FilePath)]
links
unpackEntries [(FilePath, FilePath)]
links (Next Entry
entry Entries (Either a b)
es) = case Entry -> EntryContent
entryContent Entry
entry of
NormalFile ByteString
file EpochTime
_ -> FilePath -> ByteString -> EpochTime -> IO ()
extractFile FilePath
path ByteString
file EpochTime
mtime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries [(FilePath, FilePath)]
links Entries (Either a b)
es
EntryContent
Directory -> FilePath -> EpochTime -> IO ()
extractDir FilePath
path EpochTime
mtime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries [(FilePath, FilePath)]
links Entries (Either a b)
es
HardLink LinkTarget
link -> ([(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries forall a b. (a -> b) -> a -> b
$! forall {t :: * -> *} {a}.
Foldable t =>
t a -> LinkTarget -> [(t a, FilePath)] -> [(t a, FilePath)]
saveLink FilePath
path LinkTarget
link [(FilePath, FilePath)]
links) Entries (Either a b)
es
SymbolicLink LinkTarget
link -> ([(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries forall a b. (a -> b) -> a -> b
$! forall {t :: * -> *} {a}.
Foldable t =>
t a -> LinkTarget -> [(t a, FilePath)] -> [(t a, FilePath)]
saveLink FilePath
path LinkTarget
link [(FilePath, FilePath)]
links) Entries (Either a b)
es
EntryContent
_ -> [(FilePath, FilePath)]
-> Entries (Either a b) -> IO [(FilePath, FilePath)]
unpackEntries [(FilePath, FilePath)]
links Entries (Either a b)
es
where
path :: FilePath
path = Entry -> FilePath
entryPath Entry
entry
mtime :: EpochTime
mtime = Entry -> EpochTime
entryTime Entry
entry
extractFile :: FilePath -> ByteString -> EpochTime -> IO ()
extractFile FilePath
path ByteString
content 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 FilePath
path 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 t a
path LinkTarget
link [(t a, FilePath)]
links = seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
path)
forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
link')
forall a b. (a -> b) -> a -> b
$ (t a
path, FilePath
link')forall a. a -> [a] -> [a]
:[(t a, FilePath)]
links
where link' :: FilePath
link' = LinkTarget -> FilePath
fromLinkTarget LinkTarget
link
emulateLinks :: [(FilePath, FilePath)] -> IO ()
emulateLinks = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \(FilePath
relPath, 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 FilePath
path EpochTime
t =
FilePath -> UTCTime -> IO ()
setModificationTime FilePath
path (POSIXTime -> UTCTime
posixSecondsToUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral EpochTime
t))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exception.catch` \IOError
e ->
if IOError -> Bool
isPermissionError IOError
e then forall (m :: * -> *) a. Monad m => a -> m a
return () else forall e a. Exception e => e -> IO a
throwIO IOError
e
#else
setModTime _path _t = return ()
#endif