{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_HADDOCK hide #-}
{-# HLINT ignore "Use for_" #-}
module Codec.Archive.Tar.Unpack (
unpack,
unpackAndCheck,
) where
import Codec.Archive.Tar.Types
import Codec.Archive.Tar.Check
import Codec.Archive.Tar.LongNames
import Data.Bits
( testBit )
import Data.List (partition, nub)
import Data.Maybe ( fromMaybe )
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as BS
import System.FilePath
( (</>) )
import qualified System.FilePath as FilePath.Native
( takeDirectory )
import System.Directory
( createDirectoryIfMissing,
copyFile,
setPermissions,
listDirectory,
doesDirectoryExist,
createDirectoryLink,
createFileLink,
setModificationTime,
emptyPermissions,
setOwnerReadable,
setOwnerWritable,
setOwnerExecutable,
setOwnerSearchable )
import Control.Exception
( Exception, throwIO, handle )
import System.IO ( stderr, hPutStr )
import System.IO.Error ( ioeGetErrorType, isPermissionError )
import GHC.IO (unsafeInterleaveIO)
import Data.Foldable (traverse_)
import GHC.IO.Exception (IOErrorType(InappropriateType, IllegalOperation, PermissionDenied, InvalidArgument))
import Data.Time.Clock.POSIX
( posixSecondsToUTCTime )
import Control.Exception as Exception
( catch, SomeException(..) )
unpack
:: Exception e
=> FilePath
-> Entries e
-> IO ()
unpack :: forall e. Exception e => FilePath -> Entries e -> IO ()
unpack = (GenEntry FilePath FilePath -> Maybe SomeException)
-> FilePath -> Entries e -> IO ()
forall e.
Exception e =>
(GenEntry FilePath FilePath -> Maybe SomeException)
-> FilePath -> Entries e -> IO ()
unpackAndCheck ((FileNameError -> SomeException)
-> Maybe FileNameError -> Maybe SomeException
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileNameError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Maybe FileNameError -> Maybe SomeException)
-> (GenEntry FilePath FilePath -> Maybe FileNameError)
-> GenEntry FilePath FilePath
-> Maybe SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenEntry FilePath FilePath -> Maybe FileNameError
checkEntrySecurity)
unpackAndCheck
:: Exception e
=> (GenEntry FilePath FilePath -> Maybe SomeException)
-> FilePath
-> Entries e
-> IO ()
unpackAndCheck :: forall e.
Exception e =>
(GenEntry FilePath FilePath -> Maybe SomeException)
-> FilePath -> Entries e -> IO ()
unpackAndCheck GenEntry FilePath FilePath -> Maybe SomeException
secCB FilePath
baseDir Entries e
entries = do
let resolvedEntries :: GenEntries FilePath FilePath (Either e DecodeLongNamesError)
resolvedEntries = Entries e
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
forall e.
Entries e
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
decodeLongNames Entries e
entries
[(FilePath, FilePath, Bool)]
uEntries <- [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [] GenEntries FilePath FilePath (Either e DecodeLongNamesError)
resolvedEntries
let ([(FilePath, FilePath, Bool)]
hardlinks, [(FilePath, FilePath, Bool)]
symlinks) = ((FilePath, FilePath, Bool) -> Bool)
-> [(FilePath, FilePath, Bool)]
-> ([(FilePath, FilePath, Bool)], [(FilePath, FilePath, Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(FilePath
_, FilePath
_, Bool
x) -> Bool
x) [(FilePath, FilePath, Bool)]
uEntries
[(FilePath, FilePath, Bool)] -> IO ()
forall {c}. [(FilePath, FilePath, c)] -> IO ()
handleHardLinks [(FilePath, FilePath, Bool)]
hardlinks
[(FilePath, FilePath, Bool)] -> IO ()
forall {c}. [(FilePath, FilePath, c)] -> IO ()
handleSymlinks [(FilePath, FilePath, Bool)]
symlinks
where
unpackEntries :: Exception e
=> [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries :: forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
_ (Fail Either e DecodeLongNamesError
err) = (e -> IO [(FilePath, FilePath, Bool)])
-> (DecodeLongNamesError -> IO [(FilePath, FilePath, Bool)])
-> Either e DecodeLongNamesError
-> IO [(FilePath, FilePath, Bool)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> IO [(FilePath, FilePath, Bool)]
forall e a. Exception e => e -> IO a
throwIO DecodeLongNamesError -> IO [(FilePath, FilePath, Bool)]
forall e a. Exception e => e -> IO a
throwIO Either e DecodeLongNamesError
err
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
Done = [(FilePath, FilePath, Bool)] -> IO [(FilePath, FilePath, Bool)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath, FilePath, Bool)]
links
unpackEntries [(FilePath, FilePath, Bool)]
links (Next GenEntry FilePath FilePath
entry GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es) = do
case GenEntry FilePath FilePath -> Maybe SomeException
secCB GenEntry FilePath FilePath
entry of
Maybe SomeException
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just SomeException
e -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
e
case GenEntry FilePath FilePath -> GenEntryContent FilePath
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
entryContent GenEntry FilePath FilePath
entry of
NormalFile ByteString
file EpochTime
_ -> do
Permissions -> FilePath -> ByteString -> EpochTime -> IO ()
extractFile (GenEntry FilePath FilePath -> Permissions
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> Permissions
entryPermissions GenEntry FilePath FilePath
entry) (GenEntry FilePath FilePath -> FilePath
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath GenEntry FilePath FilePath
entry) ByteString
file (GenEntry FilePath FilePath -> EpochTime
forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
entryTime GenEntry FilePath FilePath
entry)
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
GenEntryContent FilePath
Directory -> do
FilePath -> EpochTime -> IO ()
extractDir (GenEntry FilePath FilePath -> FilePath
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath GenEntry FilePath FilePath
entry) (GenEntry FilePath FilePath -> EpochTime
forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
entryTime GenEntry FilePath FilePath
entry)
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
HardLink FilePath
link -> do
([(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries ([(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)])
-> [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall a b. (a -> b) -> a -> b
$! Bool
-> FilePath
-> FilePath
-> [(FilePath, FilePath, Bool)]
-> [(FilePath, FilePath, Bool)]
forall {c}.
c
-> FilePath
-> FilePath
-> [(FilePath, FilePath, c)]
-> [(FilePath, FilePath, c)]
saveLink Bool
True (GenEntry FilePath FilePath -> FilePath
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath GenEntry FilePath FilePath
entry) FilePath
link [(FilePath, FilePath, Bool)]
links) GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
SymbolicLink FilePath
link -> do
([(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries ([(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)])
-> [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall a b. (a -> b) -> a -> b
$! Bool
-> FilePath
-> FilePath
-> [(FilePath, FilePath, Bool)]
-> [(FilePath, FilePath, Bool)]
forall {c}.
c
-> FilePath
-> FilePath
-> [(FilePath, FilePath, c)]
-> [(FilePath, FilePath, c)]
saveLink Bool
False (GenEntry FilePath FilePath -> FilePath
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
entryTarPath GenEntry FilePath FilePath
entry) FilePath
link [(FilePath, FilePath, Bool)]
links) GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
OtherEntryType{} ->
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
CharacterDevice{} -> [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
BlockDevice{} -> [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
GenEntryContent FilePath
NamedPipe -> [(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
forall e.
Exception e =>
[(FilePath, FilePath, Bool)]
-> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
-> IO [(FilePath, FilePath, Bool)]
unpackEntries [(FilePath, FilePath, Bool)]
links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
es
extractFile :: Permissions -> FilePath -> ByteString -> EpochTime -> IO ()
extractFile Permissions
permissions (FilePath -> FilePath
fromFilePathToNative -> 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 -> Permissions -> IO ()
setOwnerPermissions FilePath
absPath Permissions
permissions
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 -> FilePath
fromFilePathToNative -> 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 :: c
-> FilePath
-> FilePath
-> [(FilePath, FilePath, c)]
-> [(FilePath, FilePath, c)]
saveLink c
isHardLink (FilePath -> FilePath
fromFilePathToNative -> FilePath
path) (FilePath -> FilePath
fromFilePathToNative -> FilePath
link) [(FilePath, FilePath, c)]
links
= Int -> [(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)]
forall a b. a -> b -> b
seq (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
path)
([(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)])
-> [(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)]
forall a b. (a -> b) -> a -> b
$ Int -> [(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)]
forall a b. a -> b -> b
seq (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
link)
([(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)])
-> [(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)]
forall a b. (a -> b) -> a -> b
$ (FilePath
path, FilePath
link, c
isHardLink)(FilePath, FilePath, c)
-> [(FilePath, FilePath, c)] -> [(FilePath, FilePath, c)]
forall a. a -> [a] -> [a]
:[(FilePath, FilePath, c)]
links
handleHardLinks :: [(FilePath, FilePath, c)] -> IO ()
handleHardLinks = ((FilePath, FilePath, c) -> IO ())
-> [(FilePath, FilePath, c)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((FilePath, FilePath, c) -> IO ())
-> [(FilePath, FilePath, c)] -> IO ())
-> ((FilePath, FilePath, c) -> IO ())
-> [(FilePath, FilePath, c)]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
relPath, FilePath
relLinkTarget, c
_) ->
let absPath :: FilePath
absPath = FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
relPath
absTarget :: FilePath
absTarget = FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
relLinkTarget
in FilePath -> IO Bool
doesDirectoryExist FilePath
absTarget IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive FilePath
absTarget FilePath
absPath
Bool
False -> FilePath -> FilePath -> IO ()
copyFile FilePath
absTarget FilePath
absPath
handleSymlinks :: [(FilePath, FilePath, c)] -> IO ()
handleSymlinks = ((FilePath, FilePath, c) -> IO ())
-> [(FilePath, FilePath, c)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((FilePath, FilePath, c) -> IO ())
-> [(FilePath, FilePath, c)] -> IO ())
-> ((FilePath, FilePath, c) -> IO ())
-> [(FilePath, FilePath, c)]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
relPath, FilePath
relLinkTarget, c
_) ->
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 -> IO Bool
doesDirectoryExist FilePath
absTarget IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> IO () -> IO () -> IO ()
forall {a}. IO a -> IO a -> IO a
handleSymlinkError (FilePath -> FilePath -> IO ()
copyDirectoryRecursive FilePath
absTarget FilePath
absPath)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createDirectoryLink FilePath
relLinkTarget FilePath
absPath
Bool
False -> IO () -> IO () -> IO ()
forall {a}. IO a -> IO a -> IO a
handleSymlinkError (FilePath -> FilePath -> IO ()
copyFile FilePath
absTarget FilePath
absPath)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createFileLink FilePath
relLinkTarget FilePath
absPath
where
handleSymlinkError :: IO a -> IO a -> IO a
handleSymlinkError IO a
action =
(IOError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\IOError
e -> if IOError -> IOErrorType
ioeGetErrorType IOError
e IOErrorType -> [IOErrorType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [IOErrorType
IllegalOperation
,IOErrorType
PermissionDenied
,IOErrorType
InvalidArgument]
then IO a
action
else IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO IOError
e
)
copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
copyDirectoryRecursive FilePath
srcDir FilePath
destDir = do
[FilePath]
srcFiles <- FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
srcDir
(FilePath -> FilePath -> IO ())
-> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith FilePath -> FilePath -> IO ()
copyFile FilePath
destDir [ (FilePath
srcDir, FilePath
f)
| FilePath
f <- [FilePath]
srcFiles ]
where
copyFilesWith :: (FilePath -> FilePath -> IO ())
-> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith :: (FilePath -> FilePath -> IO ())
-> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith FilePath -> FilePath -> IO ()
doCopy FilePath
targetDir [(FilePath, FilePath)]
srcFiles = do
let dirs :: [FilePath]
dirs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
targetDir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
FilePath.Native.takeDirectory (FilePath -> FilePath)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)]
srcFiles
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True) [FilePath]
dirs
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ let src :: FilePath
src = FilePath
srcBase FilePath -> FilePath -> FilePath
</> FilePath
srcFile
dest :: FilePath
dest = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
srcFile
in FilePath -> FilePath -> IO ()
doCopy FilePath
src FilePath
dest
| (FilePath
srcBase, FilePath
srcFile) <- [(FilePath, FilePath)]
srcFiles ]
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
topdir = [FilePath] -> IO [FilePath]
recurseDirectories [FilePath
""]
where
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories [] = [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
recurseDirectories (FilePath
dir:[FilePath]
dirs) = IO [FilePath] -> IO [FilePath]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
([FilePath]
files, [FilePath]
dirs') <- [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect [] [] ([FilePath] -> IO ([FilePath], [FilePath]))
-> IO [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory (FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
dir)
[FilePath]
files' <- [FilePath] -> IO [FilePath]
recurseDirectories ([FilePath]
dirs' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
dirs)
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
files')
where
collect :: [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect [FilePath]
files [FilePath]
dirs' [] = ([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
files
,[FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
dirs')
collect [FilePath]
files [FilePath]
dirs' (FilePath
entry:[FilePath]
entries) = do
let dirEntry :: FilePath
dirEntry = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
entry
Bool
isDirectory <- FilePath -> IO Bool
doesDirectoryExist (FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
dirEntry)
if Bool
isDirectory
then [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect [FilePath]
files (FilePath
dirEntryFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
dirs') [FilePath]
entries
else [FilePath]
-> [FilePath] -> [FilePath] -> IO ([FilePath], [FilePath])
collect (FilePath
dirEntryFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files) [FilePath]
dirs' [FilePath]
entries
setModTime :: FilePath -> EpochTime -> IO ()
setModTime :: FilePath -> EpochTime -> IO ()
setModTime FilePath
path 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` \IOError
e -> case IOError -> IOErrorType
ioeGetErrorType IOError
e of
IOErrorType
PermissionDenied -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IOErrorType
InvalidArgument -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IOErrorType
_ -> IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOError
e
setOwnerPermissions :: FilePath -> Permissions -> IO ()
setOwnerPermissions :: FilePath -> Permissions -> IO ()
setOwnerPermissions FilePath
path Permissions
permissions =
FilePath -> Permissions -> IO ()
setPermissions FilePath
path Permissions
ownerPermissions
where
ownerPermissions :: Permissions
ownerPermissions =
Bool -> Permissions -> Permissions
setOwnerReadable (Permissions -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Permissions
permissions Int
8) (Permissions -> Permissions) -> Permissions -> Permissions
forall a b. (a -> b) -> a -> b
$
Bool -> Permissions -> Permissions
setOwnerWritable (Permissions -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Permissions
permissions Int
7) (Permissions -> Permissions) -> Permissions -> Permissions
forall a b. (a -> b) -> a -> b
$
Bool -> Permissions -> Permissions
setOwnerExecutable (Permissions -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Permissions
permissions Int
6) (Permissions -> Permissions) -> Permissions -> Permissions
forall a b. (a -> b) -> a -> b
$
Bool -> Permissions -> Permissions
setOwnerSearchable (Permissions -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Permissions
permissions Int
6) (Permissions -> Permissions) -> Permissions -> Permissions
forall a b. (a -> b) -> a -> b
$
Permissions
emptyPermissions