LIB: preserve permissions in copyDir

This commit is contained in:
Julian Ospald 2015-12-27 20:39:40 +01:00
parent f2fb4e0be0
commit 8ffbd44ce4
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020

View File

@ -159,7 +159,7 @@ copyDir :: DirCopyMode
-> IO () -> IO ()
copyDir _ AFileInvFN _ = throw InvalidFileName copyDir _ AFileInvFN _ = throw InvalidFileName
copyDir _ _ AFileInvFN = throw InvalidFileName copyDir _ _ AFileInvFN = throw InvalidFileName
copyDir cm from@(_ :/ Dir fromn _) copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
to@(_ :/ Dir {}) to@(_ :/ Dir {})
= do = do
let fromp = fullPath from let fromp = fullPath from
@ -168,7 +168,7 @@ copyDir cm from@(_ :/ Dir fromn _)
throwDestinationInSource fromp destdirp throwDestinationInSource fromp destdirp
throwSameFile fromp destdirp throwSameFile fromp destdirp
createDestdir destdirp createDestdir destdirp fmode
destdir <- Data.DirTree.readFile destdirp destdir <- Data.DirTree.readFile destdirp
contents <- readDirectory' (fullPath from) contents <- readDirectory' (fullPath from)
@ -180,18 +180,18 @@ copyDir cm from@(_ :/ Dir fromn _)
(_ :/ RegFile {}) -> copyFileToDir f destdir (_ :/ RegFile {}) -> copyFileToDir f destdir
_ -> return () _ -> return ()
where where
createDestdir destdir = createDestdir destdir fmode =
case cm of case cm of
Merge -> Merge ->
unlessM (doesDirectoryExist destdir) unlessM (doesDirectoryExist destdir)
(createDirectory destdir newDirPerms) (createDirectory destdir fmode)
Strict -> do Strict -> do
throwDirDoesExist destdir throwDirDoesExist destdir
createDirectory destdir newDirPerms createDirectory destdir fmode
Replace -> do Replace -> do
whenM (doesDirectoryExist destdir) whenM (doesDirectoryExist destdir)
(deleteDirRecursive =<< Data.DirTree.readFile destdir) (deleteDirRecursive =<< Data.DirTree.readFile destdir)
createDirectory destdir newDirPerms createDirectory destdir fmode
recreateSymlink' f destdir = do recreateSymlink' f destdir = do
let destfilep = fullPath destdir </> (name . file $ f) let destfilep = fullPath destdir </> (name . file $ f)
destfile <- Data.DirTree.readFile destfilep destfile <- Data.DirTree.readFile destfilep